Cod sursa(job #324638)

Utilizator marius21Petcu Marius marius21 Data 16 iunie 2009 16:51:24
Problema Cautare binara Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
var f,g:text;
n,i,x,p,u,m,op:longint;
a:array[1..100000] of longint;
//bufin:array[0..2097152] of byte;
begin
assign(f,'cautbin.in');
assign(g,'cautbin.out');
reset(f);
rewrite(g);
//settextbuf(f,bufin);
read(f,n);
for i:=1 to n do
        read(f,a[i]);
read(f,m);
for i:=1 to m do begin
        read(f,op,x);
        p:=1;
        u:=n;
        if op=0 then
        while p<=u do begin
                m:=p+((u-p) shr 1);
                if (a[m]=x) and (a[m+1]<>x) then
                        break;
                if a[m]>x then
                        u:=m-1
                        else
                        p:=m+1;
                end
        else
        while p<=u do begin
                m:=(p+u) shr 1;
                if (a[m]=x) then
                        break
                        else
                if a[m]>x then
                        u:=m-1
                        else
                        p:=m+1;
                end;
        case op of
                0:
                if p<=u then
                        writeln(g,m)
                        else
                        writeln(g,-1);

                1:
                if a[m]=x then
                        writeln(g,m)
                        else
                        writeln(g,u);

                2:if a[m]=x then
                        writeln(g,m)
                        else
                        writeln(g,p);
                end;
        end;
close(f);
close(g);
end.