Cod sursa(job #1694873)

Utilizator RobushekDivine Spirit Robushek Data 26 aprilie 2016 10:09:02
Problema Cautare binara Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
Program CautBin;
    uses dos;
  type Intro=1..100001;
  var n,m,i,b:Intro;
      o:0..2;
      fi,fo:text;
      a:array[Intro] of longword;
Procedure Caut0(key:Intro);
 var st,dr,pivot:Intro;
begin
    st:=1;
    dr:= n;
    while (st <= dr)  do
    begin
        pivot:= st + (dr - st) div 2;
        if (a[pivot] <= key) then st:= pivot + 1
                             else dr:= pivot - 1;
    end;
    if (a[dr]=key) then Writeln(fo,dr)
                   else Writeln(fo,-1);
end;

Procedure Caut1(key:Intro);
  var st,dr,pivot:Intro;
begin
  st:=1;dr:=n;
    while (st <= dr) do begin

        pivot:=st + (dr - st) div 2;
        if(a[pivot] <= key) then st:= pivot + 1
                            else dr:= pivot - 1;
                        end;
    Writeln(fo,dr);
end;

Procedure Caut2(key:Intro);
  var st,dr,pivot:Intro;
begin
    st:= 1;
    dr:= n;
    while(st <= dr) do begin

        pivot:=st + (dr - st) div 2;
        if(a[pivot] >= key) then dr:= pivot - 1
                          else st:= pivot + 1;
                       end;
    Writeln(fo,st);
end;

begin
   assign(fi,'cautbin.in');
   assign(fo,'cautbin.out');
   reset(fi);rewrite(fo);
   Readln(fi,n);
    for i:=1 to n do Read(fi,a[i]);
    Readln(fi,m);
    for i:=1 to m do begin
        o:=0;
        Read(fi,o);Read(fi,b);

        if (o = 0) then caut0(b);
        if (o = 1) then caut1(b);
        if (o = 2) then caut2(b);
                      end;

    close(fi);close(fo);
end.