Cod sursa(job #226927)

Utilizator johnyJohny Deep johny Data 3 decembrie 2008 09:13:29
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.4 kb
var k,x,i,n,m,t:longint;
    a:array[1..100001] of longint;

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

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

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


begin
 assign(input,'cautbin.in');
 reset(input);
 assign(output,'cautbin.out');
 rewrite(output);
 read(n);
 for i:=1 to n do read(a[i]);
 readln(m);
 for i:=1 to m do
  begin
   read(k,x);
   if k=0 then
    begin
     t:=caut1(x);
     writeln(t);
    end
   else
   if k=1 then
    begin
     t:=caut2(x);
     writeln(t);
    end
   else
    begin
     t:=caut3(x);
     writeln(t);
    end;
 end;
 close(input);
 close(output);
end.