Cod sursa(job #1032497)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 15 noiembrie 2013 19:34:54
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
Program binary;
var a:array[1..100001] of longint;
    n,m,i,j,x,aux,y:longint;
    f,q:text;
function bs0(p,u:longint):longint;
var mid:longint;
begin
      if a[u]=x then aux:=u
      else begin
      while p<u do
      begin
        mid:=p+((u-p) div 2);
        if a[mid]>x then u:=mid
        else if a[mid]<x then p:=mid+1
        else if a[mid]=x then begin aux:=mid; p:=mid+1; end;
      end;
      end;
      bs0:=aux;
end;
function bs1(p,u:longint):longint;
var mid:longint;
begin
        if a[u]=x then aux:=u
        else begin
        while p<u do
        begin
                mid:=p+((u-p) div 2);
                if a[mid]>x then u:=mid
                else if a[mid]<=x then begin aux:=mid; p:=mid+1;  end;
        end;
        end;
        bs1:=aux;
end;
function bs2(p,u:longint):longint;
var mid:longint;
begin
         if a[u]=x then aux:=u
         else begin
         while p<u do
         begin
                mid:=p+((u-p) div 2);
                if a[mid]<x then p:=mid+1
                else if a[mid]>=x then begin aux:=mid; u:=mid; end;
         end;
         end;
         if aux=0 then aux:=u;
         bs2:=aux;
end;
begin
assign(f,'cautbin.in');
reset(f);
assign(q,'cautbin.out');
rewrite(q);
readln(f,n);
for i:=1 to n do read(f,a[i]);
readln(f,m);

for j:=1 to m do
begin
readln(f,y,x);
aux:=0;
i:=1;
if y=0 then writeln(q,bs0(i,n))
else if y=1 then writeln(q,bs1(i,n))
else if y=2 then writeln(q,bs2(i,n));
end;
close(f);
close(q);

end.