Cod sursa(job #493663)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 18 octombrie 2010 22:42:35
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 kb
program cautbin;
const MAX =100001;
type date=0..MAX;
var f,g:text; i,j,n,m,q,r,p:date; v:array[1..MAX] of longint; x:longint;
procedure cb(st,dr:date);
var m:date;
begin
Repeat
m:=st+(dr-st) div 2;
If v[m]>x then
          dr:=m
          else
          st:=m+1;
If v[m]=x then
 begin
 r:=m;
 exit;
 end;
Until st=dr;
m:=st+(dr-st) div 2;
r:=m;
If v[m]<>x then p:=1;
end;
begin
Assign(f,'cautbin.in'); Reset(f);
Assign(g,'cautbin.out');Rewrite(g);
Readln(f,n);
For i:=1 to n do Read(f,v[i]);
Readln(f);
Readln(f,m);
For j:=1 to m do
 begin
 Readln(f,q,x);
 p:=0;
 cb(1,n);
 case q of
 0: If p=1 then Writeln(g,-1)
           else
           begin
           i:=r;
           While (i+1<=n)and(v[i+1]=x) do inc(i);
           Writeln(g,i);
           end;
 1: begin
    i:=r;
    If (i-1>=1)and(v[i]>x) then dec(i);
    While (i+1<=n)and(v[i+1]<=x) do inc(i);
    Writeln(g,i);
    end;
 2: begin
    i:=r;
    While (i-1>=1)and(v[i-1]>=x) do dec(i);
    Writeln(g,i);
    end;
  end;
 end;
Close(f); Close(g);
end.