Cod sursa(job #555901)

Utilizator lakat_tLakatos Tamas lakat_t Data 15 martie 2011 20:38:43
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.08 kb
var
 f,g:text;
 v:array[1..100000]of longint;
 n,m,i,a,b,p:longint;

function binker(bal,jobb,mit:longint):longint;
var
 kozep:longint;
begin
 if bal>jobb
  then binker:=-1
  else begin
        kozep:=(bal+jobb) div 2;
        if mit=v[kozep]
         then binker:=kozep
         else if mit<v[kozep]
               then binker:=binker(bal,kozep-1,mit)
               else binker:=binker(kozep+1,jobb,mit);
       end;
end;

function also(mit:longint):longint;
var
 i:longint;
begin
 i:=binker(1,n,mit);
 while v[i]=mit do dec(i);
 also:=i+1;
end;

function felso(mit:longint):longint;
var
 i:longint;
begin
 i:=binker(1,n,mit);
 while v[i]=mit do inc(i);
 felso:=i-1;
end;

begin
 assign(f, 'cautbin.in');
 reset(f);
 assign(g, 'cautbin.out');
 rewrite(g);
 readln(f, n);
 for i:=1 to n do
  read(f, v[i]);
 readln(f);
 readln(f, m);
 for i:=1 to m do
  begin
   readln(f, a,b);
   if a=0
    then writeln(g,binker(1,n,b))
    else if a=2
          then writeln(g, also(b))
          else writeln(g, felso(b));
  end;
 close(f);
 close(g);
end.