Cod sursa(job #429958)

Utilizator gramatovici_paulGramatovici Paul gramatovici_paul Data 30 martie 2010 17:23:35
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.73 kb
var n,i,j,k,x,y:longint;
    f,g:text;
    s:string[32];
    v:array[1..100000] of longint;
function caut0(x:longint):longint;
var i,pas:longint;
begin
    i:=0;
    pas:=1 shl 16;
    while pas<>0 do
       begin
         if (i+pas<=n) and (v[i+pas]<=x) then
            i:=i+pas;
         pas:=pas shr 1;
       end;
    if (i=0) or (v[i]<>x) then
        caut0:=-1
    else
        caut0:=i;
end;
function caut1(x:longint):longint;
var i,pas:longint;
begin
    i:=0;
    pas:=1 shl 16;
    while pas<>0 do
       begin
         if (i+pas<=n) and (v[i+pas]<=x) then
            i:=i+pas;
         pas:=pas shr 1;
       end;
    caut1:=i
end;
function caut2(x:longint):longint;
var i,pas:longint;
begin
    i:=0;
    pas:=1 shl 16;
    while pas<>0 do
       begin
         if (i+pas<=n) and (v[i+pas]<x) then
            i:=i+pas;
         pas:=pas shr 1;
       end;
    caut2:=1+i
end;
begin
    assign(f,'cautbin.in');
    assign(g,'cautbin.out');
    reset(f);
    rewrite(g);
    readln(f,n);
    for i:=1 to n do read(f,v[i]);
    readln(f,k);
    for i:=1 to k do
        begin
            read(f,s);
            x:=0;
            y:=0;
            j:=1;
            while s[j]<>' ' do
                begin
                    x:=x*10+ord(s[j])-48;
                    inc(j);
                end;
            inc(j);
            while j<=length(s) do
                begin
                    y:=y*10+ord(s[j])-48;
                    inc(j);
                end;
            case x of
              0:writeln(g,caut0(y));
              1:writeln(g,caut1(y));
              2:writeln(g,caut2(y));
            end;
            readln(f,s);
        end;
    close(f);
    close(g);
end.