Cod sursa(job #1117992)

Utilizator VandheerManPopescu Alin VandheerMan Data 23 februarie 2014 21:52:22
Problema Cautare binara Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.1 kb
program binar;

type
vector=array[1..100000] of word;
function c0(a:vector;n,i,x,k,li,ls:integer;af:boolean):integer;
           begin
            af:=false;
                       while (af=false) do
                       begin
                         k:=(ls+li) div 2;
                         if ((a[k]=x)and(a[k+1]>x)) then
                                          begin
                                          af:=true;
                                          c0:=k;
                                          end
                                     else if (a[k]<=x) then li:=k+1
                                          else ls:=k-1;
                         if ((ls=li) and (a[k]<>x)) then
                                                     begin
                                                     c0:=-1;
                                                     af:=true;
                                                     end;
                         end;
           end;
function c1(a:vector;n,i,x,k,li,ls:integer;af:boolean):integer;
             begin
                         af:=false;
                         while (af=false) do
                                begin
                                k:=(li+ls) div 2;
                                if ((a[k]<=x) and (a[k+1]>x)) then begin
                                                                      c1:=k;
                                                                      af:=true;
                                                                   end;
                                if (a[k]<=x) then li:=k+1
                                                 else if (a[k]>x) then ls:=k-1;
                                end;
                         end;
function c2(a:vector;n,i,x,k,li,ls:integer;af:boolean):integer;
          begin
                         af:=false;
                         while(af=false) do
                                       begin
                                       k:=(ls+li) div 2;
                                       if ((a[k]>=x) and (a[k-1]<x)) then begin
                                                                           c2:=k;
                                                                           af:=true;
                                                                           end;
                                       if (a[k]<x) then li:=k+1
                                                   else ls:=k-1;
                                       end;
                         end;
var
n,m,i,j,x,k,li,ls:integer;
a:vector;
f,g:text;
b:0..2;
af:boolean;
begin

assign(f,'cautbin.in');
reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
readln(f,m);
assign(g,'cautbin.out');
rewrite(g);
for j:=1 to m do
              begin
              readln(f,b,x);
              li:=1;
              ls:=n;
              if b=0 then writeln(g,c0(a,n,i,x,k,li,ls,af))
                 else if b=1 then writeln(g,c1(a,n,i,x,k,li,ls,af))
                      else writeln(g,c2(a,n,i,x,k,li,ls,af));

              end;

close(f);
close(g);
end.