Cod sursa(job #1037826)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 20 noiembrie 2013 19:34:43
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 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,aux:longint;
begin
     while p<=u do begin
        mid:=p+((u-p) div 2);
        if a[mid]>x then u:=mid-1
                     else p:=mid+1;
     end;
     if a[u]=x then bs0:=u
     else if a[p]=x then bs0:=p
     else bs0:=-1;
end;
function bs1(p,u:longint):longint;
var mid,aux:longint;
begin
      while p<=u do begin
        mid:=p+((u-p) div 2);
        if a[mid]>x then u:=mid-1
                     else p:=mid+1;
     end;
     if a[u]<=x then bs1:=u
     else if a[p]<=x then bs1:=p
end;
function bs2(p,u:longint):longint;
var mid,aux:longint;
begin
     while p<u do begin
        mid:=p+((u-p) div 2);
       if x>a[mid] then p:=mid+1
                    else u:=mid;
     end;
     if a[u]<=x then bs2:=u
     else if a[p]<=x then bs2:=p;
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.