Cod sursa(job #226824)

Utilizator johnyJohny Deep johny Data 2 decembrie 2008 21:24:46
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 kb
program cautabin;
var A:array[1..100000] of longint;
n,m: longint;
k,x: longint;
i: longint;

function cbin(s,d,k,x:longint):longint;
var m: longint;
begin
  if s>=d then
     if A[s]=x then
     begin
      if k=0 then
      begin
        while (A[s]=x)and(s<n) do inc(s);
        cbin:=s-1;
      end;
      cbin:=d;
     end
     else
     case k of
     0: cbin:=-1;
     1: cbin:=s-1;
     2: cbin:=s;
     end
  else
  begin
    m:=(s+d) div 2;
    if A[m]>x then cbin:=cbin(s,m-1,k,x)
    else
    if A[m]<x then cbin:=cbin(m+1,d,k,x)
    else
    begin
      if k=0 then
      begin
       while (A[m]=x)and(m<n) do inc(m);
       cbin:=m-1;
      end
      else
      cbin:=m;
    end;
  end;
end;

begin
  assign(input,'cautbin.in');
  reset(input);
  assign(output,'cautbin.out');
  rewrite(output);
  readln(n);
  for i:=1 to n do
   read(A[i]);
  readln;
  readln(m);
  for i:=1 to m do
  begin
    readln(k,x);
    writeln(cbin(1,n,k,x));
  end;
  close(input);
  close(output);
end.