Cod sursa(job #389083)

Utilizator mimarcelMoldovan Marcel mimarcel Data 31 ianuarie 2010 19:55:32
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.73 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;

function caut0:longint;
begin
p:=1;
q:=n;
repeat
r:=(p+q)div 2;
s:=v[r];
if(s=x)and(v[r+1]<>x)then begin
                          caut0:=r;
                          exit;
                          end
                     else if x<s then q:=r-1
                                 else p:=r+1;
until p>q;
caut0:=-1;
end;

function caut1:longint;
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])then begin
                                        caut1:=r;
                                        exit;
                                        end
                                   else if x<s then q:=r-1
                                               else p:=r+1;
until p>q;
caut1:=-1;
end;

function caut2:longint;
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])then begin
                                        caut2:=r;
                                        exit;
                                        end
                                   else if x<=s then q:=r-1
                                                else p:=r+1;
until p>q;
caut2:=-1;
end;

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