Cod sursa(job #493686)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 18 octombrie 2010 23:53:51
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.02 kb
program cautbin;
const MAX =100011;
type date=0..MAX;
var f,g:text; i,j,n,m,q:date; v:array[0..MAX] of longint; x:longint;
procedure cb(st,dr:date);
var m:date;
begin
m:=st+(dr-st) div 2;
If v[m]=x then i:=m
  else
  If st=dr then
   begin
   i:=m;
   exit;
   end;
If v[m]<x then cb(m+1,dr);
If v[m]>x then cb(st,m);
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);
 cb(1,n);
 If q=0 then
   begin
   If v[i]<>x then Writeln(g,-1)
           else
           begin

           While (i+1<=n)and(v[i+1]=x) do inc(i);
           Writeln(g,i);
           end;
   end;
 If q=1 then
  begin

    If (v[i]>x)and(i>1) then dec(i);
    While (i+1<=n)and(v[i+1]<=x) do inc(i);
    Writeln(g,i);
  end;
 If q=2 then
  begin

    If (v[i]<x)and(i<n) then inc(i);
    While (i-1>=1)and(v[i-1]>=x) do dec(i);
    Writeln(g,i);
  end;
 end;
Close(f); Close(g);
end.