Cod sursa(job #195666)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 20 iunie 2008 16:00:17
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.99 kb
program caut;
var f,g:text;
    v:array[1..100000]of longint;
    n,m,i,elem,rasp:longint;
    int:byte;
procedure zero(elem:longint;var rasp:longint);
var st,dr:longint;
    ok:boolean;
begin
ok:=false;
st:=1;dr:=n;
while st<dr do begin
      m:=(st+dr) div 2;
      if elem=v[m] then begin while v[st]=elem do st:=st+1;
                               ok:=true;
                               end
      else begin
      if elem>v[m] then st:=m+1
                    else dr:=m-1;
                    end;
end;
if not ok then if elem<v[m] then m:=st-1
                            else m:=st;
case int of
0:if elem=v[m] then rasp:=m
                else rasp:=-1;
1:rasp:=m;
else begin while v[m]=elem do m:=m-1;
        rasp:=m+1;
end;end;end;
begin
assign(f,'cautbin.in');
assign(g,'cautbin.out');
reset(f);rewrite(g);
readln(f,n);
for i:=1 to n do read(f,v[i]);
readln(f);
readln(f,m);
for i:=1 to m do begin
    readln(f,int,elem); zero(elem,rasp); writeln(g,rasp);
end;end.