Cod sursa(job #610397)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 26 august 2011 23:03:51
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
Program cautbin;
 var a:array [0..100010] of longint;
     b1,b2:array [1..1 shl 15] of char;
    i,j,n,nr,x,m,pos,st,dr,k:longint;
    fi,fo:text;
procedure cauta(i,sf:longint);
 var mid,j:longint;
begin
st:=i; dr:=sf;
if i<=sf then begin
 mid:=(i+sf) div 2;
 if a[mid]>x then cauta(i,mid-1)
 else if a[mid]<x then cauta(mid+1,sf);
 if a[mid]=x then pos:=mid;
                end;
end;
begin
 assign(fi,'cautbin.in');
  assign(fo,'cautbin.out');
 settextbuf(fi,b1);
  settextbuf(fo,b2);
 reset(fi);
  rewrite(fo);
 readln(fi,n);
 for i:=1 to n do read(fi,a[i]);
 readln(fi);
 readln(fi,m);
 for i:=1 to m do begin
                   readln(fi,nr,x);
                   pos:=0;
                    cauta(1,n);
                   if nr=0 then
                    if pos=0 then writeln(fo,'-1')
                     else begin
                           while a[pos]=x do inc(pos);
                           writeln(fo,pos-1);
                           end;
                   if nr=1 then
                    if pos=0 then writeln(fo,dr)
                     else begin
                           while a[pos]=x do inc(pos);
                           writeln(fo,pos-1);
                           end;
                   if nr=2 then
                   if pos=0 then writeln(fo,st)
                    else  begin
                           while a[pos]=x do dec(pos);
                           writeln(fo,pos+1);
                           end;
                    end;
 close(fo);
end.