The   Fibonacci Word   may be created in a manner analogous to the   Fibonacci Sequence   as described here:

    Define   F_Word1   as   1
    Define   F_Word2   as   0
    Form     F_Word3   as   F_Word2     concatenated with   F_Word1    i.e.:   01
    Form     F_Wordn   as   F_Wordn-1   concatenated with   F_wordn-2



Task

Perform the above steps for     n = 37.

You may display the first few but not the larger values of   n.

{Doing so will get the task's author into trouble with them what be (again!).} 

Instead, create a table for   F_Words   1   to   37   which shows:

   The number of characters in the word
   The word's Entropy


Related tasks
 
   Fibonacci word/fractal
   Entropy
   Entropy/Narcissist


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.
 