Cod sursa(job #582267)

Utilizator rendorzegAndrei Pavel rendorzeg Data 15 aprilie 2011 09:50:31
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.07 kb
type vector=array [1..100000] of longint;
var a:vector;
    nr,n,m,i:longint;
    k:byte;
    f,g:text;

function cautb(st,dr:longint):longint;
var m:longint;
    ok:boolean;
begin
  ok:=false;
  while st<dr do
    begin
      m:=(st+dr) div 2;

      if nr=a[m] then begin
                     if nr<a[m+1] then
		 begin
                       ok:=true;
                       break;
                       end;
		
      {else}

        if nr<a[m] then dr:=m-1
                   else st:=m+1;
    end;
  if not ok then
    if nr<a[st] then m:=st-1
               else m:=st;
  case k of
    0:if a[m]=nr then cautb:=m
                 else cautb:=-1;
    1:cautb:=m;
    2:begin
       while a[m]=nr do m:=m-1;
       cautb:=m+1;
       end;
  end;
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
      read(f,k);
      read(f,nr);
      writeln(g,cautb(1,n));
    end;
  close(f);
  close(g);
end.