Бинарный поиск1 / bin_s

Uses Dos,crt;
const nMax = 2048;
      nMax1= 2049;
type index=1..nMax;
    index0=0..nMax;
    index1=1..nMax1;
    DimVec=index;
     ElemT=Integer;
      Vec =array [index] of ElemT;
      BinS_proc = procedure ( {in} n: DimVec; var a: Vec; x: ElemT;
                              {out} var q: Boolean; var L: index0  );
{--------------------------------------------------------------------}
procedure BinSearch1 ( n : DimVec; var a : Vec; x : ElemT;
                     var q : Boolean; var L : index0    );
{  аЈ : n, a, x;         १ : q, L                   }
{ Pred:   (ALL i : 1<=i<n : a[i]<a[i+1])
  Post:   (1<=L<=n+1) & (a[L-1]<x<=a[L]) &
                 (q = (1<=L<=n)&(a[L]=x))             }
var R : index1; M : index;
begin
 L := 1;
 R := n+1;
            { inv: (1<=L<=R<=n+1) & (a[L-1]<x<=a[R]) }
 while L<>R do
 begin
   M := (L+R) div 2;
   if a[M]<x then L := M+1 else R := M
 end {while};
             { (1<=L<=n+1) & (a[L-1]<x<=a[L])}
if L<>n+1 then q :=(x=a[L]) else q := False
end {BinSearch1};
{--------------------------------------------------------------------}
procedure BinSearch2 ( n : DimVec; var a : Vec; x : ElemT;
                     var q : Boolean; var L : index0    );
{  аЈ :	n, a, x;   १ : q, L                  }
{ Pred:	(ALL i : 1<=i<n : a[i]<a[i+1])
 Post:	(0<=L<=n) & (a[L]<x<=a[L+1]) &
	(q = (0<=L<=n-1)&(a[L+1]=x) )          }
var R :	index1;
    M : index;
begin
  L := 0;
  R := n+1;   {a[L]<x<=a[R]}
  while L+1<>R do
  begin  {(0<=L<R-1<=n) & (a[L]<x<=a[R])}
    M := (L+R) div 2;
    if a[M]<x then L := M  else R := M
  end {while};
{ (0<=L<=n) & (a[L]<x<=a[L+1])}
if L<>n then q :=(x=a[L+1]) else q := False
end  {BinSearch2};
{--------------------------------------------------------------------}
procedure BinSearch3 ( n : DimVec; var a : Vec; x : ElemT;
                      var q : Boolean; var L : index0    );
{  аЈ :    a, x;   १ : q, L
 Pred: (n=1000) & (ALL i : 1<=i<n : a[i]<a[i+1])
 Post: (0<=L<=n) & (a[L]<x<=a[L+1]) &
       (q = (0<=L<=n-1)&(a[L+1]=x) )}
{const n = 1000;	 !}
var  i : 1..512;
     M : index;
begin
  i := 512;
  if a[i]<x then L := n-i+1 else L := 0;
  {(a[L]<x<=a[L+i]) & (i=512=2^j) & (j=9) & (L=L0)}
  while i<>1 do
  begin
    i := i div 2;
    M := L+i;
    if a[M]<x  then L := M  else  ;
    {(i=2^j) & (0<=j<9) & (a[L]<x<=a[L+i]) & (L0<=L<=L0+511)
	& (L+i<=n+1)}
end { while} ; {  Bound : j=log2(i)}
{ (0<=L<=n) & (a[L]<x<=a[L+1])}
if L<>n then q :=(x=a[L+1]) else q := False
end  {BinSearch3};
{--------------------------------------------------------------------}
procedure BinSearch4 ( n : DimVec; var a : Vec; x : ElemT;
                       var q : Boolean; var L : index0    );
{  аЈ :    a, x;  १ : q, L
 Pred: (n=1000) & (ALL i : 1<=i<n : a[i]<a[i+1])
 Post: (0<=L<=n) & (a[L]<x<=a[L+1]) &
       (q = (0<=L<=n-1)&(a[L+1]=x) )}
{const n = 1000;    	!}
begin L := 0;
if a[512]<x then L := n-512+1; {  a[L]<x<=a[L+512]}
if a[L+256]<x then L := L+256; {  a[L]<x<=a[L+256] }
if a[L+128]<x then L := L+128;
if a[L+ 64]<x then L := L+ 64;
if a[L+ 32]<x then L := L+ 32;
if a[L+ 16]<x then L := L+ 16;
if a[L+  8]<x then L := L+  8;
if a[L+  4]<x then L := L+  4;
if a[L+  2]<x then L := L+  2;
if a[L+  1]<x then L := L+  1;
{ (0<=L<=n) &  (a[L]<x<=a[L+  1])}
if L<>n then q :=(x=a[L+1]) else q := False
end  {BinSearch4};
{--------------------------------------------------------------------}

procedure BinSearch5 ( n : DimVec; var a : Vec; x : ElemT;
                       var q : Boolean; var L : index0    );
{  аЈ :    a, x;  १ : q, L
 Pred: (n=1000) & (ALL i : 1<=i<n : a[i]<a[i+1])
 Post: (0<=L<=n) & (a[L]<x<=a[L+1]) &
       (q = (0<=L<=n-1)&(a[L+1]=x) )}
{const n = 1000;    	!}
    var M : index;
begin L := 0;
if a[512]<x then L := n-512+1; {  a[L]<x<=a[L+512]}
M:= L+256; if a[M]<x then L :=M; {  a[L]<x<=a[L+256] }
M:= L+128; if a[M]<x then L :=M;
M:= L+ 64; if a[M]<x then L :=M;
M:= L+ 32; if a[M]<x then L :=M;
M:= L+ 16; if a[M]<x then L :=M;
M:= L+  8; if a[M]<x then L :=M;
M:= L+  4; if a[M]<x then L :=M;
M:= L+  2; if a[M]<x then L :=M;
M:= L+  1; if a[M]<x then L :=M;
{ (0<=L<=n) &  (a[L]<x<=a[L+  1])}
if L<>n then q :=(x=a[L+1]) else q := False
end  {BinSearch5};
{--------------------------------------------------------------------}
 procedure MyGetTime ( var t : LongInt );
   {ўл¤ Ґв ўаҐ¬п ў б®вле ¤®«пе ᥪ㭤л}
    var h, m, s , hund : Word;
   begin
    GetTime( h, m , s, hund);
    t:= s + 60 * m;
    t:= hund + 100 * t
   end{ MyGetTime };
{--------------------------------------------------------------------}
   procedure MyUnPackTime ( t: LongInt; var m, s, hund : Word );
   {ЇҐаҐў®¤Ёв ўаҐ¬п t (ў б®вле ¤®«пе ᥪ㭤л)
    ў ¬Ё­гвл m, ᥪ㭤л s, б®влҐ hund       }
   begin
    hund:= t mod 100;
    t:= t div 100; {ў ᥪ㭠е}
    s:= t mod 60;
    m:= t div 60
   end{ MyUnPackTime };
{--------------------------------------------------------------------}
var   fout:text; {ўл室­®© д ©«}
      t, t1,t2 : LongInt;
      min, sec, s100 : Word;

var a: Vec;
    i, n, n1 : index1;
    L: index0;

    q : Boolean;
    x : ElemT;
    j, nProgon, iv : Word;
{--------------------------------------------------------------------}
Procedure Computation ( BinS: BinS_proc);
begin
 WriteLn('BinSearch',iv:1,':');
 Write(fout,'BinSearch',iv:1,':  ');
 MyGetTime(t1);
 {Calculation:}
 for j:=1 to nProgon do {Їа®Ј®­л ¤«п 㢥«ЁзҐ­Ёп Ё§¬Ґа塞®Ј® ўаҐ¬Ґ­Ё}
 for i:=1 to n1 do
 {жЁЄ« Ї® а §­л¬ ў аЁ ­в ¬ ЇаҐ¤кпў«Ґ­Ёп н«Ґ¬Ґ­в  x (Ї® ўбҐ¬ Ёб室 ¬)}
 begin
    x:=i;
    BinS ( n, a, x, q, L );
 end;
 MyGetTime(t2);
 t := t2 - t1; MyUnPackTime( t, min, sec, s100);
 if(s100<10)
  then WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.0', s100,' ᥪ')
  else WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.', s100,' ᥪ');
end {Computation};
{--------------------------------------------------------------------}
begin
   clrscr;
   Assign(fout,'BinS5.DAT');
   Rewrite(fout);
   n:=1000; n1:=n+1; nProgon:=100;
   WriteLn(fout,'ђ §¬Ґа ¬ ббЁў  = ',n:5);
   WriteLn(fout,'—Ёб«® Їа®Ј®­®ў = ',nProgon:5,' * ',n1);
   WriteLn(fout,'€§¬ҐаҐ­ЁҐ ўаҐ¬Ґ­Ё а Ў®вл :');

 {ЈҐ­Ґа жЁп ¬ ббЁў :}
 for i:=1 to n do a[i]:=i;

 iv:=1;     Computation ( BinSearch1);
 Inc(iv);   Computation ( BinSearch2);
 Inc(iv);   Computation ( BinSearch3);
 Inc(iv);   Computation ( BinSearch4);
 Inc(iv);   Computation ( BinSearch5);

 Close (fout)
end.