Cod sursa(job #294850)
Utilizator | Data | 2 aprilie 2009 20:02:09 | |
---|---|---|---|
Problema | Cautare binara | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva educationala | Marime | 1.68 kb |
var f,g:Text;
n,c,x,m,i:longint;
a:array[1..10000]of longint;
procedure caut_bin;
var s,d,mij,k:longint;
begin
s:=1;d:=n;k:=0;
while (s<=d) do
begin
mij:=(s+d)div 2;
if (c=0)and(a[mij]=x)then begin
writeln(g,mij);
break;
end
else if (c=1)and(a[mij]<x)then begin
writeln(g,mij);
break;
end
else if (c=2)and(a[mij]>x)then begin
writeln(g,mij);
break;
end
else if c=0 then begin
if a[mij]<x then s:=mij+1
else d:=mij-1;
end
else if c=1 then begin
d:=mij-1;
end
else if c=2 then begin
s:=mij+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,c,x);
caut_bin;
end;
close(g);
end.