Cod sursa(job #244218)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 14 ianuarie 2009 18:30:29
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
var a:array[1..100000] of longint;
    i,n,q,m,b,o,l:longint;
function caut(x,s,d:longint):longint;
    var mij:longint;
    begin
      while s<d do
         begin
           mij:=(s+d) div 2;
           if x>a[mij] then s:=mij+1
              else d:=mij;
         end;
      if (s<=n)and(a[s]=x)  then caut:=s
            else
         begin
           o:=s;
           caut:=-1;
         end;
    end;
begin
assign(input,'cautbin.in'); reset(input);
assign(output,'cautbin.out'); rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
readln(m);
for i:=1 to m do
  begin
    readln(q,b);
    if q=0 then writeln(caut(b,1,n))
           else if q=1 then begin l:=caut(b,1,n);
                              if l=-1 then
                                       begin
                                         if a[o]<=b then writeln(o)
                                           else writeln(o-1);
                                       end
                                         else writeln(l);end
                       else begin l:=caut(b,1,n);if l=-1 then writeln(o) else writeln(l); end;
  end;
close(input); close(output);
end.