Cod sursa(job #221886)

Utilizator punkistBarbulescu Dan punkist Data 18 noiembrie 2008 18:54:01
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.64 kb
var c,loc,i,n,m,b:longint;
    vec:array[1..100001] of longint;
    f,f2:text;
    a:byte;

function caut0(x:longint):longint;
 var st,dr,med,ret:longint;
 begin
  st:=1;dr:=n;
  ret:=-1;
  while (st<=dr) do
  begin
   med:=(st+dr) div 2;
   if (vec[med]=x) and (vec[med+1]<>x) then
    begin
     ret:=med;
     st:=dr+1;
    end
   else
    begin
     if vec[med]>x then dr:=med-1
     else st:=med+1;
    end;
  end;
 caut0:=ret;
 end;

function caut1(x:longint):longint;
 var st,dr,med,ret:longint;
 begin
  st:=1;dr:=n;
  ret:=-1;
  while (st<=dr) do
  begin
   med:=(st+dr) div 2;
   if (vec[med]=x) and (vec[med+1]<>x) then
    begin
     ret:=med;
     st:=dr+1;
    end
   else
    begin
     if vec[med]>x then dr:=med-1
     else st:=med+1;
    end;
  end;
 if (ret<>-1) then caut1:=ret
 else
  begin
   caut1:=med-1;
  end;
 end;

 function caut2(x:longint):longint;
 var st,dr,med,ret:longint;
 begin
  st:=1;dr:=n;
  ret:=-1;
  while (st<=dr) do
  begin
   med:=(st+dr) div 2;
   if (vec[med]=x) and (vec[med+1]<>x) then
    begin
     ret:=med;
     st:=dr+1;
    end
   else
    begin
     if vec[med]>x then dr:=med-1
     else st:=med+1;
    end;
  end;
 if (ret<>-1) then caut2:=ret
 else
  begin
   caut2:=med;
  end;
 end;


begin
 assign(f,'cautbin.in');
 assign(f2,'cautbin.out');
 reset(f);
 rewrite(f2);
 readln(f,n);
 for i:=1 to n do read(f,vec[i]);
 readln(f,m);
 for i:=1 to m do
  begin
   read(f,a,b);
   if a=0 then writeln(f2,caut0(b));
   if a=1 then writeln(f2,caut1(b));
   if a=2 then writeln(f2,caut2(b));
  end;
 close(f);
 close(f2);
end.