Cod sursa(job #195670)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 20 iunie 2008 16:18:47
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1 kb
program caut;
var f,g:text;
    v:array[1..100000]of longint;
    n,m,i,elem:longint;
    int:byte;
function zero(elem:longint):longint;
var st,dr,m: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[m]=elem do m:=m+1;
                               m:=m-1;
                               ok:=true;
                               end
      else
      if elem>v[m] then st:=m+1
                    else dr:=m-1;
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 zero:=m
                else zero:=-1;
1:zero:=m;
else begin while v[m]=elem do m:=m-1;
        zero:=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,m);
for i:=1 to m do begin
    readln(f,int,elem);writeln(g,zero(elem));
    writeln(rasp);
end;
close(f);close(g);
end.