Cod sursa(job #1117970)
Utilizator | Data | 23 februarie 2014 21:39:28 | |
---|---|---|---|
Problema | Cautare binara | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva educationala | Marime | 2.85 kb |
program binar;
type
vector=array[1..100000] of word;
var
n,m,i,j,x,k,li,ls:integer;
a:vector;
f,g:text;
b:0..2;
af:boolean;
begin
assign(f,'cautbin.in');
reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
readln(f,m);
assign(g,'cautbin.out');
rewrite(g);
for j:=1 to m do
begin
readln(f,b,x);
li:=1;
ls:=n;
case b of
0:begin
af:=false;
while (af=false) do
begin
k:=(ls+li) div 2;
if ((a[k]=x)and(a[k+1]>x)) then
begin
af:=true;
writeln(g,k);
end
else if (a[k]<=x) then li:=k+1
else ls:=k-1;
if ((ls=li) and (a[k]<>x)) then
begin
writeln(g,-1);
af:=true;
end;
end;
end;
1:begin
af:=false;
while (af=false) do
begin
k:=(li+ls) div 2;
if ((a[k]<=x) and (a[k+1]>x)) then begin
writeln(g,k);
af:=true;
end;
if (a[k]<=x) then li:=k+1
else if (a[k]>x) then ls:=k-1;
end;
end;
2: begin
af:=false;
while(af=false) do
begin
k:=(ls+li) div 2;
if ((a[k]>=x) and (a[k-1]<x)) then begin
writeln(g,k);
af:=true;
end;
if (a[k]<x) then li:=k+1
else ls:=k-1;
end;
end;
end;
end;
close(f);
close(g);
end.