Cod sursa(job #1032224)

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