Cod sursa(job #429930)

Utilizator gramatovici_paulGramatovici Paul gramatovici_paul Data 30 martie 2010 17:03:42
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.31 kb
var n,i,k,x,y:longint;
    f,g:text;
    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,x,y);
            case x of
              0:writeln(g,caut0(y));
              1:writeln(g,caut1(y));
              2:writeln(g,caut2(y));
            end;
        end;
    close(g);
end.