Cod sursa(job #549002)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 8 martie 2011 01:34:37
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.3 kb
var     n,m,x,c,k,i:longint;
        f1,f2:text;
        a:array[0..100000]of longint;

function poz(i,j,x:longint):longint;
var r:longint;
begin
  r:=(i+j) div 2;
  if a[r]=x then poz:=r
  else if i=j then poz:=r
  else if a[r]>x then poz:=poz(i,r,x)
  else poz:=poz(r+1,j,x);
end;

begin
  assign(f1,'cautbin.in');
  reset(f1);
  assign(f2,'cautbin.out');
  rewrite(f2);
  readln(f1,n);
  for i:=1 to n do
    read(f1,a[i]);
  readln(f1,m);
  for i:=1 to m do
    begin
      readln(f1,c,x);
      k:=poz(1,n,x);
      if c=0 then
        begin
          if a[k]<>x then writeln(f2,-1) else
            begin
              while a[k+1]=x do inc(k);
              writeln(f2,k);
            end;
        end else
      if c=1 then
        begin
          if a[k]=x then
            begin
              while a[k+1]=x do inc(k);
              writeln(f2,k);
            end
          else if a[k]<x then writeln(f2,k) else
            begin
              while a[k]>x do dec(k);
              writeln(f2,k);
            end
        end else
      if c=2 then
        begin
          if a[k]>x then writeln(f2,k) else
            begin
              while a[k-1]=x do dec(k);
              writeln(f2,k);
            end
        end;
    end;
  close(f1);
  close(f2);
end.