Cod sursa(job #195499)

Utilizator RobybrasovRobert Hangu Robybrasov Data 18 iunie 2008 23:41:50
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
var v:array[1..100000] of longint;
    nr,n,m,i:longint;
    k:byte;
    f,g:text;

function bs(a,b:longint):longint;
var m:longint; ok:boolean;
begin
  ok:=false;
  while a<b do
    begin
      m:=(a+b) div 2;
      if nr=v[m] then begin while nr=v[m] do inc(m); dec(m); ok:=true; break; end
      else
        if nr<v[m] then b:=m-1
                   else a:=m+1;
    end;
  if not ok then
    if nr<v[a] then m:=a-1
               else m:=a;
  case k of
    0:if v[m]=nr then bs:=m
                 else bs:=-1;
    1:bs:=m;
    2:begin while v[m]=nr do dec(m); bs:=m+1; end;
  end;
end;


begin
  assign(f,'cautbin.in');
  reset(f);
  assign(g,'cautbin.out');
  rewrite(g);
  readln(f,n);
  for i:=1 to n do read(f,v[i]);
  readln(f,m);
  for i:=1 to m do
    begin
      readln(f,k,nr);
      writeln(g,bs(1,n));
    end;
  close(f);
  close(g);
end.