Cod sursa(job #269564)

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

procedure citire;
  var s:string;
  begin
    assign(f,'cautbin.in');
    reset(f);
    readln(f,n);
    x:=0;
    y:=0;
    while not eoln(f) do begin
      read(f,s);
      i:=1;
      while i<=length(s) do begin
        if s[i]=' ' then begin
          y:=y+1;
          a[y]:=x;
          x:=0;
        end else begin
        val(s[i],m,q);
        x:=x*10+m;
        end;
        i:=i+1;
      end;
    end;
    readln(f);
    assign(g,'cautbin.out');
    rewrite(g);
  end;

function caut(x,st,dr:longint):longint;
  begin
    while st<=dr do begin
    m:=(st+dr) div 2;
    if (x=a[m]) and ((x<>a[m+1]) or (m+1=n)) then begin caut:=m; exit; end
      else if x>=a[m+1] then st:=m+1
        else if x<a[m+1] then dr:=m-1;
    end;
  end;

function caut1(x,st,dr:longint):longint;
  begin
    while st<=dr do begin
      m:=(st+dr) div 2;
      if x<a[m] then dr:=m-1
        else begin caut1:=m; st:=m+1; end;
    end;
  end;

function caut2(x,st,dr:longint):longint;
  begin
    while st<=dr do begin
      m:=(st+dr) div 2;
      if x<=a[m] then begin caut2:=m; dr:=m-1; end
        else begin st:=m+1; end;
    end;
  end;

procedure rasp;
  begin
    readln(f,m);
    for i:=1 to m do begin
      readln(f,q,x);

      case q of
        0: begin y:=caut(x,1,n); if x=a[y] then writeln(g,y)
        else writeln(g,-1); end;
        1: writeln(g,caut1(x,1,n));
        2: writeln(g,caut2(x,1,n));
      end;
    end;
    close(g);
  end;

begin
  citire;
  rasp;
end.