Бинарный поиск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.