Cod sursa(job #393013)

Utilizator arnold23Arnold Tempfli arnold23 Data 8 februarie 2010 19:00:51
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
var f,g:text;
    a:array[1..100000] of longint;
    n,m,i,k,x:longint;

procedure keresbin1(mit:longint);
var b,j,k:longint;
begin
 b:=1;
 j:=n;
 k:=b+((j-b) div 2);
 while b<>j do begin
  k:=b+((j-b) div 2);
  if a[k]=mit then b:=j else
  if a[k]<mit then b:=k-1 else
  j:=k+1;
 end;

 if a[k]=mit then begin
  while a[k]=mit do inc(k);
  writeln(g,k-1);
 end
 else writeln(g,'-1');
end;

procedure keresbin2(mit:longint);
var b,j,k:longint;
begin
 b:=1;
 j:=n;
 k:=b+((j-b) div 2);
 while b<>j do begin
  k:=b+((j-b) div 2);
  if a[k]=mit then b:=j else
  if a[k]<mit then b:=k-1 else
  j:=k+1;
 end;

 while a[k]<=mit do inc(k);
 writeln(g,k-1);
end;

procedure keresbin3(mit:longint);
var b,j,k:longint;
begin
 b:=1;
 j:=n;
 k:=b+((j-b) div 2);
 while b<>j do begin
  k:=b+((j-b) div 2);
  if a[k]=mit then b:=j else
  if a[k]<mit then b:=k-1 else
  j:=k+1;
 end;

  while a[k]>=mit do dec(k);
  writeln(g,k+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,a[i]);
 readln(f,m);
 for i:=1 to m do begin
   readln(f,k,x);
   if k=0 then keresbin1(x) else
   if k=1 then keresbin2(x) else
   keresbin3(x);
 end;
 close(f);
 close(g);

end.