Cod sursa(job #1129736)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 28 februarie 2014 08:43:06
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
Program binary_search;
var a:array[1..100001] of longint;
    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+ ((ls+ld) div 2);
                while (ls<ld) do
                begin
                        if a[m]=x then
                        begin
                                while a[m+1]=x do m:=m+1;
                                bs:=m;
                                ls:=ld+1;
                        end
                        else if a[m]<x then ls:=m+1
                        else if a[m]>x then ld:=m-1;
                         m:=ls+ ((ls+ld) div 2);
                end;

        end;
end;
function bsmax(ls,ld:longint):longint;
var m:longint;
begin
       m:=ls+ ((ls+ld) div 2);
      while ls<ld do
      begin
                if a[m]<=x then begin ls:=m+1; bsmax:=m; end
                else if a[m]>x then  ld:=m-1; end;
                 m:=ls+ ((ls+ld) div 2);
      end;
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.