Cod sursa(job #493673)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 18 octombrie 2010 23:14:37
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
program cautbin;
const MAX =100011;
type date=0..MAX;
var f,g:text; i,j,n,m,q,p,r: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 r:=m
  else
  If st=dr then
   begin
   r:=m;
   p:=1;
   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);
 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;
    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.