Cod sursa(job #254045)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 6 februarie 2009 16:58:01
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
var a:array[1..100000] of longint;
    n,x,y,o,m,i,b,t:longint;
    f,g:text;
function cb(t,b:longint):longint;
var p:longint;
begin
     x:=1; y:=n;
     while x<=y do
     begin
          p:=(x+y)div 2;
          if b>a[p] then x:=p+1;
          if b<a[p] then y:=p-1;
          if b=a[p] then
          begin
               cb:=p;      exit; end;
          if (b>=a[x])and(b<=a[y])and(y-x<=1) then
          begin
               cb:=x;        break; 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,a[i]);
     readln(f,m);
     for i:=1 to m do
     begin
          readln(f,t,b);
          o:=cb(t,b);
          if t=0 then
          begin
               while (a[o]<=b)and(o<=n) do inc(o);
               dec(o);
          end;
          if t=2 then inc(o);
          writeln(g,o);
     end;
     close(g);
end.