Cod sursa(job #340228)

Utilizator ScriamTertiuc Afanasie Scriam Data 13 august 2009 18:49:36
Problema Cautare binara Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.91 kb
Program P1;
var a : array[1..100001] of longint;
    y,u,v,n,m,i,k,x : longint;
    f,g : text;
    buf : array[1..10001] of byte;

Procedure solve0;
begin
u:=1; v:=n;
while u<=v do
begin
m:=(u+v) shr 1;
if y<a[m] then v:=m-1
else
u:=m+1;
end;
if a[v]=y then writeln(g,v) else writeln(g,-1);
end;

Procedure solve1;
begin
u:=1; v:=n;
while u<=v do
begin
m:=(u+v) shr 1;
if a[m]>y then v:=m-1 else u:=m+1;
end;
writeln(g,v);
end;


Procedure solve2;
begin
u:=1; v:=n;
while u<=v do
begin
m:=(v+u) shr 1;
if a[m]<y then u:=m+1 else v:=m-1;
end;
writeln(g,u);
end;



begin
assign(f,'cautbin.in');    assign(g,'cautbin.out');
reset(f);                  rewrite(g);
settextbuf(f,buf);
readln(f,n);
for i:=1 to n do
read(f,a[i]);
readln(f);
readln(f,k);
for i:=1 to k do
begin
readln(f,x,y);
case x of
0 : solve0;
1 : solve1;
2 : solve2;
end;
end;
close(f);
close(g);
end.