Cod sursa(job #254054)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 6 februarie 2009 17:27:04
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.74 kb
var a:array[1..100001] of longint;
    n,x,y,o,m,i,b,t:longint;
    f,g:text;
function cb0(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 else
          if b<a[p] then y:=p-1 else
          if b=a[p] then
          begin
               while (b=a[p])and(p<=n) do inc(p);
               cb0:=p-1;
               exit;
          end;
     end;
end;
function cb1(b:longint):longint;
var p:longint;
begin
     x:=1; y:=n;
     while x<=y do
     begin
          p:=(x+y)div 2;
          if (b>a[x])and(b<a[y])and(y-x<=1) then
          begin
               cb1:=x;
               exit;
          end else
          if b>a[p] then x:=p else
          if b<a[p] then y:=p else
          if b=a[p] then
          begin
               cb1:=p;
               exit;
          end;
     end;
end;
function cb2(b:longint):longint;
var p,z:longint;
begin
     x:=1; y:=n;
     while x<=y do
     begin
          p:=(x+y)div 2;
          if (b>a[x])and(b<a[y])and(y-x<=1) then
          begin
               z:=y;
               break;
          end else
          if b>a[p] then x:=p else
          if b<a[p] then y:=p else
          if b=a[p] then
          begin
               z:=p;
               break;
          end;
     end;
     cb2:=z;
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);
          if t=0 then writeln(g,cb0(b));
          if t=1 then writeln(g,cb1(b));
          if t=2 then writeln(g,cb2(b));
     end;
     close(g);
end.