Cod sursa(job #388515)

Utilizator mimarcelMoldovan Marcel mimarcel Data 30 ianuarie 2010 12:49:38
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
const maxn=100001;
type vector=array[0..maxn]of longint;
var n,i,m,x:longint;
    v:vector;
    tip:byte;
    p,q,r,s:longint;

procedure caut0;
begin
p:=1;
q:=n;
repeat
r:=(p+q)div 2;
s:=v[r];
if(s=x)and((v[r+1]<>x)or(r=n))then break
                              else if x<s then q:=r-1
                                          else p:=r+1;
until p>q;
if p>q then writeln('-1')
       else writeln(r);
end;

procedure caut1;
begin
p:=1;
q:=n;
repeat
r:=(p+q)div 2;
s:=v[r];
if(s<=x)and(x>=v[r-1])and((x<v[r+1])or(r=n))then break
                                            else if x<s then q:=r-1
                                                        else p:=r+1;
until p>q;
if p>q then writeln('-1')
       else writeln(r);
end;

procedure caut2;
begin
p:=1;
q:=n;
repeat
r:=(p+q)div 2;
s:=v[r];
if(s>=x)and(x>v[r-1])and((x<=v[r+1])or(r=n))then break
                                            else if x<=s then q:=r-1
                                                         else p:=r+1;
until p>q;
if p>q then writeln('-1')
       else writeln(r);
end;

begin
assign(input,'cautbin.in');
reset(input);
assign(output,'cautbin.out');
rewrite(output);
read(n);
v[0]:=0;
for i:=1 to n do read(v[i]);
v[n+1]:=maxlongint;
read(m);
for i:=1 to m do
  begin
  read(tip,x);
  case tip of
    0:caut0;
    1:caut1;
    2:caut2;
    end;
  end;
close(output);
close(input);
end.