Cod sursa(job #1117785)

Utilizator VandheerManPopescu Alin VandheerMan Data 23 februarie 2014 20:08:57
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.49 kb
program binar;

type
vector=array[1..100000] of longint;
var
n,m,i,j,x,k,li,ls:longint;
a:vector;
f,g:text;
b:0..2;
af:boolean;
begin

assign(f,'cautbin.in');
reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
readln(f,m);
assign(g,'cautbin.out');
rewrite(g);
for j:=1 to m do
              begin
              readln(f,b,x);
              li:=1;
              ls:=n;
              af:=false;
              repeat
              k:=(li+ls) div 2;
              case b of
                     0: begin
                        if (a[k]<x) then li:=k+1;
                        if (a[k]>x) then ls:=k-1;
                        if ((a[k]=x) and (a[k+1]<>x)) then
                                         begin
                                         af:=true;
                                         writeln(g,k);
                                         end
                        else li:=k+1;
                        if (((a[k]>x) and (k=1)) or ((a[k]<x) and (k=n))) then
                                                                          begin
                                                                          writeln(g,-1);
                                                                          af:=true;
                                                                          end;
                        write(0,' ');
                        end;
                     1: begin
                        if ((a[k]>x) and (a[k-1]>x)) then ls:=k-1;
                        if ((a[k]<=x) and (a[k+1]<=x)) then li:=k+1;
                        if ((a[k]<=x) and (a[k+1]>x)) then begin
                                                           writeln(g,k);
                                                           af:=true;
                                                           end;
                        write(k,' ');
                        end;
                     2: begin
                        if ((a[k]>=x) and (a[k-1]>=x)) then ls:=k-1;
                        if ((a[k]<x) and (a[k+1]<=x)) then li:=k+1;
                        if ((a[k]>=x) and (a[k-1]<x)) then begin
                                                           writeln(g,k);
                                                           af:=true;
                                                           end;
                        write(k,' ');

                        end;
              end;
              until af;
              end;




close(f);
close(g);
end.