Бинарный поиск1 / bin_s
.rtfUses 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;
procedure BinSearch1 ( n : DimVec; var a : Vec; x : ElemT;
var q : Boolean; var l : index1 );
{ арг : 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;
{ a[l-1]<x<=a[r]}
while l<>r do
begin {(1<=l<r<=n+1) & (a[l-1]<x<=a[r])}
m := (l+r) div 2;
if a[m]<x then l := m+1 else r := m
{(1<=l<=r<=n+1) & (a[l-1]<x<=a[r])}
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=l)}
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]) & (L<=l<=L+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, l1 : index1;
l2, l3, l4, l5: index0;
q : Boolean;
x : ElemT;
j : Word;
begin
clrscr;
Assign(fout,'BinS3.DAT');
Rewrite(fout);
n:=1000;
WriteLn(fout,'Size of array = ',n:5);
WriteLn(fout,'Измерение времени работы :');
{генерация массива:}
for i:=1 to n do a[i]:=i;
WriteLn('BinSearch1:');
WriteLn(fout,'BinSearch1:');
MyGetTime(t1);
{Calculation:}
for j:=1 to 100 do
for i:=1 to 1001 do
begin
x:=i;
BinSearch1 ( n, a, x, q, l1 );
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Write(fout,'1: ');
if(s100<10)
then WriteLn(fout,'время = ', min,' мин ', sec,'.0', s100,' сек')
else WriteLn(fout,'время = ', min,' мин ', sec,'.', s100,' сек');
WriteLn('BinSearch2:');
WriteLn(fout,'BinSearch2:');
MyGetTime(t1);
{Calculation:}
for j:=1 to 100 do
for i:=1 to 1001 do
begin
x:=i;
BinSearch2 ( n, a, x, q, l2 );
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Write(fout,'2: ');
if(s100<10)
then WriteLn(fout,'время = ', min,' мин ', sec,'.0', s100,' сек')
else WriteLn(fout,'время = ', min,' мин ', sec,'.', s100,' сек');
WriteLn('BinSearch3:');
WriteLn(fout,'BinSearch3:');
MyGetTime(t1);
{Calculation:}
for j:=1 to 100 do
for i:=1 to 1001 do
begin
x:=i;
BinSearch3 ( n, a, x, q, l3 );
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Write(fout,'3: ');
if(s100<10)
then WriteLn(fout,'время = ', min,' мин ', sec,'.0', s100,' сек')
else WriteLn(fout,'время = ', min,' мин ', sec,'.', s100,' сек');
WriteLn('BinSearch4:');
WriteLn(fout,'BinSearch4:');
MyGetTime(t1);
{Calculation:}
for j:=1 to 100 do
for i:=1 to 1001 do
begin
x:=i;
BinSearch4 ( n, a, x, q, l4 );
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Write(fout,'4: ');
if(s100<10)
then WriteLn(fout,'время = ', min,' мин ', sec,'.0', s100,' сек')
else WriteLn(fout,'время = ', min,' мин ', sec,'.', s100,' сек');
WriteLn('BinSearch5:');
WriteLn(fout,'BinSearch5:');
MyGetTime(t1);
{Calculation:}
for j:=1 to 100 do
for i:=1 to 1001 do
begin
x:=i;
BinSearch5 ( n, a, x, q, l5 );
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Write(fout,'5: ');
if(s100<10)
then WriteLn(fout,'время = ', min,' мин ', sec,'.0', s100,' сек')
else WriteLn(fout,'время = ', min,' мин ', sec,'.', s100,' сек');
Close (fout)
end.