Cod sursa(job #195447)

Utilizator RobybrasovRobert Hangu Robybrasov Data 18 iunie 2008 16:59:36
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.9 kb
var v:array[1..100000] of longint;
    val,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 val=v[m] then begin while val=v[m] do inc(m); dec(m); ok:=true; break; end
      else
        if val<v[m] then b:=m-1
                    else a:=m+1;
    end;
  if not ok then
    if v[a]>val then m:=a-1
                else m:=a;
  case k of
    0:if v[m]=val then bs:=m
                  else bs:=-1;
    1:bs:=m;
    2:if v[m]=val then bs:=m
                  else bs:=m+1;
  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,val);
      writeln(g,bs(1,n));
    end;
  close(f);
  close(g);
end.