Cod sursa(job #1129725)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 28 februarie 2014 08:33:50
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.71 kb
Program binary_search;
var a:array[1..100001] of int64;
    n,m,i:longint;
    y:byte;
    x:int64;
    f,q:text;
function bs(ls,ld:longint):longint;
var m:longint;
begin
        if (a[ls]>x) or (a[ld]<x) then bs:=-1
        else begin
                m:=(ls+ld) div 2;
                while (ls<ld) do
                begin
                        if a[m]=x then begin bs:=m; ls:=m+1; end
                        else if a[m]<x then ls:=m+1
                        else if a[m]>x then ld:=m-1;
                        m:=(ls+ld) div 2;
                end;

                if (ls=ld) and (a[ls]=x) then bs:=ls;
        end;
end;
function bsmax(ls,ld:longint):longint;
var m:longint;
begin
      m:=(ls+ld) div 2;
      while ls<ld do
      begin
                if a[m]<=x then begin bsmax:=m; ls:=m+1; end
                else if a[m]>x then begin bsmax:=m;ld:=m-1; end;
                m:=(ls+ld) div 2;
      end;
      if (ls=ld) and (bsmax<ls) and (a[ls]<=x) then bsmax:=ls;
end;
function bsmin(ls,ld:longint):longint;
var m:longint;
begin
        m:=(ls+ld) div 2;
        while ls<ld do
        begin
                if a[m]<x  then ls:=m+1
                else if a[m]>=x then begin bsmin:=m; ld:=m-1; end;
                m:=(ls+ld) div 2;
        end;
        if (ls=ld) and (bsmin>ld) and (a[ld]>=x) then bsmin:=ld;
end;



begin
assign(f,'cautbin.in');
reset(f);
assign(q,'cautbin.out');
rewrite(q);
readln(f,n);
for i:=1 to n do read(f,a[i]);
read(f,m);
for i:=1 to m do
begin
        read(f,y,x);
        if y=0 then writeln(q,bs(1,n))
        else if y=1 then writeln(q,bsmax(1,n))
        else if y=2 then writeln(q,bsmin(1,n));
end;
close(f);
close(q);
end.