110 lines
1.9 KiB
Plaintext
110 lines
1.9 KiB
Plaintext
program FibWord;
|
|
{$IFDEF DELPHI}
|
|
{$APPTYPE CONSOLE}
|
|
{$ENDIF}
|
|
const
|
|
FibSMaxLen = 35;
|
|
type
|
|
tFibString = string[2*FibSMaxLen];//Ansistring;
|
|
tFibCnt = longWord;
|
|
tFib = record
|
|
ZeroCnt,
|
|
OneCnt : tFibCnt;
|
|
// fibS : tFibString;//didn't work :-(
|
|
end;
|
|
var
|
|
FibSCheck : boolean;
|
|
Fib0,Fib1 : tFib;
|
|
FibS0,FibS1: tFibString;
|
|
|
|
procedure FibInit;
|
|
Begin
|
|
with Fib0 do
|
|
begin
|
|
ZeroCnt := 1;
|
|
OneCnt := 0;
|
|
end;
|
|
|
|
with Fib1 do
|
|
begin
|
|
ZeroCnt := 0;
|
|
OneCnt := 1;
|
|
end;
|
|
FibS0 := '1';
|
|
FibS1 := '0';
|
|
FibSCheck := true;
|
|
end;
|
|
|
|
Function FibLength(const F:Tfib):tFibCnt;
|
|
begin
|
|
FibLength := F.ZeroCnt+F.OneCnt;
|
|
end;
|
|
|
|
function FibEntropy(const F:Tfib):extended;
|
|
const
|
|
rcpLn2 = 1.0/ln(2);
|
|
var
|
|
entrp,
|
|
ratio: extended;
|
|
begin
|
|
entrp := 0.0;
|
|
ratio := F.ZeroCnt/FibLength(F);
|
|
if Ratio <> 0.0 then
|
|
entrp := -ratio*ln(ratio)*rcpLn2;
|
|
ratio := F.OneCnt/FibLength(F);
|
|
if Ratio <> 0.0 then
|
|
entrp := entrp-ratio*ln(ratio)*rcpLn2;
|
|
FibEntropy:=entrp
|
|
end;
|
|
|
|
procedure FibSExtend;
|
|
var
|
|
tmpS : tFibString;
|
|
begin
|
|
IF FibSCheck then
|
|
begin
|
|
tmpS := FibS0+FibS1;
|
|
FibS0 := FibS1;
|
|
FibS1 := tmpS;
|
|
FibSCheck := (length(FibS1) < FibSMaxLen);
|
|
end;
|
|
end;
|
|
|
|
procedure FibNext;
|
|
var
|
|
tmpFib : tFib;
|
|
Begin
|
|
tmpFib.ZeroCnt := Fib0.ZeroCnt+Fib1.ZeroCnt;
|
|
tmpFib.OneCnt := Fib0.OneCnt +Fib1.OneCnt;
|
|
Fib0 := Fib1;
|
|
Fib1 := tmpFib;
|
|
IF FibSCheck then
|
|
FibSExtend;
|
|
end;
|
|
|
|
procedure FibWrite(const F:Tfib);
|
|
begin
|
|
// With F do
|
|
// write(ZeroCnt:10,OneCnt:10,FibLength(F):10,FibEntropy(f):17:14);
|
|
write(FibLength(F):10,FibEntropy(F):17:14);
|
|
IF FibSCheck then
|
|
writeln(' ',FibS1)
|
|
else
|
|
writeln(' ....');
|
|
end;
|
|
|
|
var
|
|
i : integer;
|
|
BEGIN
|
|
FibInit;
|
|
writeln('No. Length Entropy Word');
|
|
write(1:4);FibWrite(Fib0);
|
|
write(2:4);FibWrite(Fib1);
|
|
For i := 3 to 37 do
|
|
begin
|
|
FibNext;
|
|
write(i:4);
|
|
FibWrite(Fib1);
|
|
end;
|
|
END.
|