Cod sursa(job #196640)

Utilizator theratmantheratman theratman Data 27 iunie 2008 17:04:38
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.82 kb
var f,g:text;
    a:array[1..100000] of int64;
    i:longint;
    n,l,st,dr,m,op,x,poz:int64;
begin
assign(f,'cautbin.in');reset(f);
assign(g,'cautbin.out');rewrite(g);
read(f,n);
for i:=1 to n do read(f,a[i]);
read(f,l);
for i:=1 to l do begin
 read(f,op,x);
 st:=1;
 dr:=n;
 poz:=0;
 while (st<=dr)and(poz=0) do begin
  m:=(st+dr) div 2;
  if a[m]=x then poz:=m;
  if a[m]<x then st:=m+1;
  if a[m]>x then dr:=m-1;
 end;
 if poz<>0 then begin
  if op=0 then begin
   while x=a[poz+1] do inc(poz);
   writeln(g,poz);
  end;
  if op=1 then writeln(g,poz);
  if op=2 then writeln(g,poz);
 end;
 if poz=0 then begin
  if op=0 then writeln(g,'-1');
  if op=1 then writeln(g,m);
  if op=2 then begin
   poz:=m;
   while a[poz]=x do dec(poz);
   writeln(g,poz);
  end;
 end;
end;
close(f);
close(g);
end.