Cod sursa(job #203295)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 15 august 2008 00:21:26
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
{$s-}
program caut;
var f,g:text;
    v:array[1..100000]of longint;
    n,m,i,elem:longint;
    int:byte;
function zero(elem:longint):longint;
var a,b,c:longint;
    ok:boolean;
begin
ok:=false;
a:=1;b:=n;
while a<>b do begin
      c:=(a+b) div 2;
      if elem=v[c] then begin
                        ok:=true;
                        break;
                        end
      else
      if v[c]<elem then a:=c+1
                   else b:=c;
end;
if ok then begin
      while v[c]=elem do inc(c);
      dec(c);
      if (int=0) then zero:=c;
      if (int=2)then zero:=c+1;
      if (int=1) then begin
                       while v[c]=elem do dec(c);
                       zero:=c;
                       end
      end
     else begin
     if int=0 then zero:=-1;
     if int=2 then if v[m]>elem then zero:=c
                                else zero:=c+1;
     if int=1 then if v[m]<elem then zero:=c
                                else c:=c-1;
     end;
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,m);
for i:=1 to m do begin
    readln(f,int,elem);
    writeln(g,zero(elem));
end;
close(f);close(g);
end.