Cod sursa(job #602914)

Utilizator andreii1Ilie Andrei andreii1 Data 13 iulie 2011 18:29:11
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.79 kb
var i,m,n,o,x,mij,st,dr,rez:longint;
    a:array[1..100000] of longint;
    f,g:text;
    ok:boolean;
begin
assign(f,'cautbin.in');
reset(f);
assign(g,'cautbin.out');
rewrite(g);
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,o,x);
        ok:=false;
        st:=1;
        dr:=n;
        if (o=0) or (o=1) then
                begin
                while (not ok) and (st<=dr) do
                        begin
                        mij:=(st+dr) div 2;
                        if a[mij]=x then
                                begin
                                rez:=mij;
                                if a[mij]<>a[mij+1] then ok:=true
                                        else st:=mij+1;
                                end
                        else
                        if x<a[mij] then dr:=mij-1
                        else
                        if x>a[mij] then st:=mij+1;
                        end;
if o=0 then
        if ok then writeln(g,rez)
        else writeln(g,-1)
else writeln(g,rez);

                end
        else
                begin
                while (not ok) and (st<=dr) do
                        begin
                        mij:=(st+dr) div 2;
                        if a[mij]=x then
                                begin
                                rez:=mij;
                                if a[mij]<>a[mij-1] then ok:=true
                                        else dr:=mij-1;
                                end
                        else
                        if x<a[mij] then dr:=mij-1
                        else
                        if x>a[mij] then st:=mij+1;
                        end;

writeln(g,rez);
end;
end;

close(f);
close(g);
end.