Cod sursa(job #194625)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 12 iunie 2008 13:33:11
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.19 kb
var n,m,x,y:longint;
v:array[1..100001] of longint;
f,g:text;

//x este 0
procedure cautare0(a,b,c:longint);
begin
while a<=b do begin
c:=(a+b) div 2;
if v[c]=y then begin
               writeln(g,c);
               exit;
               end
           else if v[c]<y then a:=c+1
                          else b:=c-1;
               end;
if v[c]=y then writeln(g,c)
          else writeln(g,-1);
end;

//x este 1
procedure cautare1(a,b,c:longint);
begin
while a<b do begin
c:=(a+b) div 2;
if v[c]<y then a:=c+1
          else b:=c;
end;
c:=(a+b) div 2;
if v[c]>y then dec(c);
writeln(g,c)
end;

//x este 2
procedure cautare2(a,b,c:longint);
begin
while a<b do begin
c:=(a+b) div 2;
if v[c]<y then a:=c+1
          else b:=c;
end;
c:=(a+b) div 2;
if v[c]<y then inc(c);
writeln(g,c)
end;

procedure citire;
var i:longint;
begin
assign(f,'cautbin.in');reset(f);
assign(g,'cautbin.out');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
read(f,x,y);
if x=0 then cautare0(1,n,y)
       else if x=1 then cautare1(1,n,y)
                   else cautare2(1,n,y);
end;
close(f);
close(g);
end;

begin
citire;
end.