Cod sursa(job #583500)

Utilizator vendettaSalajan Razvan vendetta Data 20 aprilie 2011 16:51:31
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.63 kb
var
    f,g:Text;
    v:array[1..100000] of longint;
    y,x,n,i,j,m:longint;
    buf:array[1..1 shl 17] of char;

function caut(p,u,key:longint):longint;
    var
        mij:longint;
    begin
        while p<=u do
            begin
            mij:=(p+u) div 2;
            if v[mij]<=key then p:=mij+1
                            else u:=mij-1;
            end;
        mij:=(p+u) div 2;
        if v[mij]>key then mij:=mij-1;
        if v[mij]=key then caut:=mij
                      else caut:=-1;
    end;

function caut1(p,u,key:longint):longint;
    var
        mij:longint;
    begin
        while p<u do
            begin
            mij:=(p+u) div 2;
            if v[mij]<=key then p:=mij+1
                           else u:=mij;
            end;
        mij:=(p+u) div 2;
        if v[mij]>key then mij:=mij-1;
        caut1:=mij;
    end;

function caut2(p,u,key:longint):longint;
    var
        mij:longint;
    begin
        while p<u do
            begin
            mij:=(p+u) div 2;
            if v[mij]<key then p:=mij+1
                           else u:=mij;
            end;
        mij:=(p+u) div 2;
        if v[mij]<key then mij:=mij+1;
        caut2:=mij;
    end;

begin
    assign(f,'cautbin.in');reset(f);
    assign(g,'cautbin.out');rewrite(g);
    settextbuf(f,buf);
    readln(f,n);
    for i:=1 to n do read(f,v[i]);
    readln(f,m);
    for i:=1 to m do
        begin
        readln(f,y,x);
        if y=0 then writeln(g,caut(1,n,x));
        if y=1 then writeln(g,caut1(1,n,x));
        if y=2 then writeln(g,caut2(1,n,x));
        end;
    close(F);close(g);
end.