Cod sursa(job #226928)

Utilizator johnyJohny Deep johny Data 3 decembrie 2008 09:17:27
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.53 kb
var i,n,m,t,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-st) div 2;
   if (x<vec[med]) then dr:=med-1
   else
     if (vec[med]<x) then st:=med+1
     else
     begin
      st:=dr+1;
      ret:=med;
     end;
  end;
  caut0:=ret;
 end;

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

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


begin
 assign(f,'cautbin.in');
 assign(f2,'cautbin.out');
 reset(f);
 rewrite(f2);
 read(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);
   read(f,b);
   if a=0 then
    begin
     t:=caut0(b);
     write(f2,t);
     writeln(f2);
    end
   else
   if a=1 then
    begin
     t:=caut1(b);
     write(f2,t);
     writeln(f2)
    end
   else
   if a=2 then
    begin
     t:=caut2(b);
     write(f2,t);
     writeln(f2);
    end;
 end;
 close(f);
 close(f2);
end.