Cod sursa(job #269185)

Utilizator philipPhilip philip Data 2 martie 2009 17:09:59
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.02 kb
var f,g:text;
    n,m,i,x,q,y:longint;
    a:array[0..100001] of longint;

procedure citire;
  begin
    assign(f,'cautbin.in');
    reset(f);
    readln(f,n);
    for i:=1 to n do read(f,a[i]);
    readln(f);
    assign(g,'cautbin.out');
    rewrite(g);
  end;

function caut(x,st,dr:longint):longint;
  begin
    m:=(st+dr) div 2;
    if (x=a[m]) or (st>=dr) then caut:=m
      else if x>a[m] then caut:=caut(x,m+1,dr)
        else caut:=caut(x,st,m);
  end;

procedure rasp;
  begin
    readln(f,m);
    for i:=1 to m do begin
      readln(f,q,x);
      y:=caut(x,1,n);
      case q of
        0: if x=a[y] then begin while a[y+1]=x do inc(y); writeln(g,y); end
        else writeln(g,-1);
        1: if a[y]<=x then begin while a[y+1]=x do inc(y); writeln(g,y); end
            else writeln(g,y-1);
        2: if a[y]>=x then begin while a[y-1]=x do dec(y); writeln(g,y); end
                else begin write(g,y+1); end;
      end;
    end;
  end;

begin
  citire;
  rasp;
  close(g);
end.