Update all new Tasks

Task/Fibonacci-word/00DESCRIPTION

@@ -0,0 +1,12 @@
+The Fibonacci Word may be created in a manner analogous to the Fibonacci Sequence [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf as described here]:
+
+: Define F_Word<sub>1</sub> as 1;
+: Define F_Word<sub>2</sub> as 0;
+: Form F_Word<sub>3</sub> as F_Word<sub>2</sub> concatenated with F_Word<sub>1</sub> i.e "01"
+: Form F_Word<sub>n</sub> as F_Word<sub>n-1</sub> concatenated with F_word<sub>n-2</sub>
+
+For this task we shall do this for n = 37. You may display the first few but not the larger values of n, doing so will get me 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]].

Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg

@@ -0,0 +1,118 @@
+# calculate some details of "Fibonacci Words"               #
+
+# fibonacci word 1 = "1"                                    #
+# fibonacci word 2 = "0"                                    #
+#                3 = word 2 cat word 1 = "01"               #
+#                n = word n-1 cat word n-2                  #
+
+# note the words contain only the characters "0" and "1"    #
+# also                                                      #
+#    C(word n) = C(word n-1) + C(word n-2)                  #
+#           where C(x) = the number of characters in x      #
+# Similarly,                                                #
+#      C0(word n) = C0(word n-1) + C0(word n-2)             #
+# and  C1(word n) = C1(word n-1) + C1(word n-2)             #
+#      where C0(x) = the number of "0"s in x and            #
+#            C1(x) = the number of "1"s in x                #
+
+# we therefore don't have to calculate the words themselves #
+
+
+# prints the statistics for the fibonacci words from 1 to max number #
+PROC print fibonacci word stats = ( INT max number )VOID:
+BEGIN
+
+
+    # prints some statistics for a fibonacci word:                   #
+    #        the word number, its length and its entropy             #
+    PROC print one words stats = ( INT word
+                                 , INT zeros
+                                 , INT ones
+                                 )VOID:
+    BEGIN
+
+        REAL probability := 0;
+        REAL entropy     := 0;
+        INT  word length  = zeros + ones;
+
+        IF zeros > 0
+        THEN
+            # the word contains some zeros #
+            probability := zeros / word length;
+            entropy    -:= probability * log( probability )
+        FI;
+
+        IF ones > 0
+        THEN
+            # the word contains some ones #
+            probability := ones  / word length;
+            entropy    -:= probability * log( probability )
+        FI;
+
+        # we want entropy in bits so convert to log base 2 #
+        entropy /:= log( 2 );
+
+        print( ( ( whole( word,         -5 )
+                 + " "
+                 + whole( word length, -12 )
+                 + " "
+                 + fixed( entropy, -8, 4 )
+                 )
+               , newline
+               )
+             )
+
+
+    END; # print one words stats #
+
+
+    INT zeros one     = 0; # number of zeros in word 1 #
+    INT ones  one     = 1; # number of ones  in word 1 #
+    INT zeros two     = 1; # number of zeros in word 2 #
+    INT ones  two     = 0; # number of ones  in word 2 #
+
+    print( ( " word       length  entropy", newline ) );
+
+    IF max number > 0
+    THEN
+        # we want at least one number's statistics #
+        print one words stats( 1, zeros one, ones one );
+
+        IF max number > 1
+        THEN
+            # we want at least 2 number's statistics #
+            print one words stats( 2, zeros two, ones two );
+
+            IF max number > 2
+            THEN
+                # we want more statistics #
+
+                INT zeros n minus 1 := zeros two;
+                INT ones  n minus 1 := ones  two;
+                INT zeros n minus 2 := zeros one;
+                INT ones  n minus 2 := ones  one;
+
+                FOR word FROM 3 TO max number DO
+
+                    INT zeros n := zeros n minus 1 + zeros n minus 2;
+                    INT ones  n := ones  n minus 1 + ones  n minus 2;
+
+                    print one words stats( word, zeros n, ones n );
+
+                    zeros n minus 2 := zeros n minus 1;
+                    ones  n minus 2 := ones  n minus 1;
+                    zeros n minus 1 := zeros n;
+                    ones  n minus 1 := ones  n
+                OD
+            FI
+        FI
+    FI
+
+END; # print fibonacci word stats #
+
+
+main:
+(
+    # print the statistics for the first 37 fibonacci words #
+    print fibonacci word stats( 37 )
+)

Task/Fibonacci-word/Ada/fibonacci-word.ada

@@ -0,0 +1,56 @@
+with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,
+  Ada.Strings.Unbounded.Text_IO, Ada.Numerics.Long_Elementary_Functions,
+  Ada.Long_Float_Text_IO;
+use  Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,
+  Ada.Strings.Unbounded.Text_IO, Ada.Numerics.Long_Elementary_Functions,
+  Ada.Long_Float_Text_IO;
+
+procedure Fibonacci_Words is
+
+   function Entropy (S : Unbounded_String) return Long_Float is
+      CF    : array (Character) of Natural := (others => 0);
+      Len   : constant Natural             := Length (S);
+      H     : Long_Float                   := 0.0;
+      Ratio : Long_Float;
+   begin
+      for I in 1 .. Len loop
+         CF (Element (S, I)) := CF (Element (S, I)) + 1;
+      end loop;
+      for C in Character loop
+         Ratio := Long_Float (CF (C)) / Long_Float (Len);
+         if Ratio /= 0.0 then
+            H := H - Ratio * Log (Ratio, 2.0);
+         end if;
+      end loop;
+      return H;
+   end Entropy;
+
+   procedure Print_Line (Word : Unbounded_String; Number : Integer) is
+   begin
+      Put (Number, 4);
+      Put (Length (Word), 10);
+      Put (Entropy (Word), 2, 15, 0);
+      if Length (Word) < 35 then
+         Put ("  " & Word);
+      end if;
+      New_Line;
+   end Print_Line;
+
+   First, Second, Result : Unbounded_String;
+
+begin
+   Set_Col (4);  Put ("N");
+   Set_Col (9);  Put ("Length");
+   Set_Col (16); Put ("Entropy");
+   Set_Col (35); Put_Line ("Word");
+   First := To_Unbounded_String ("1");
+   Print_Line (First, 1);
+   Second := To_Unbounded_String ("0");
+   Print_Line (Second, 2);
+   for N in 3 .. 37 loop
+      Result := Second & First;
+      Print_Line (Result, N);
+      First  := Second;
+      Second := Result;
+   end loop;
+end Fibonacci_Words;

Task/Fibonacci-word/AutoHotkey/fibonacci-word.ahk

@@ -0,0 +1,28 @@
+SetFormat, FloatFast, 0.15
+SetBatchLines, -1
+OutPut := "N`tLength`t`tEntropy`n"
+        . "1`t" 1 "`t`t" Entropy(FW1 := "1") "`n"
+        . "2`t" 1 "`t`t" Entropy(FW2 := "0") "`n"
+Loop, 35
+{
+    FW3 := FW2 FW1, FW1 := FW2, FW2 := FW3
+    Output .= A_Index + 2 "`t" StrLen(FW3) (A_Index > 33 ? "" : "`t") "`t" Entropy(FW3) "`n"
+}
+MsgBox, % Output
+
+Entropy(n)
+{
+    a := [], len:= StrLen(n), m := n
+    while StrLen(m)
+    {
+        s := SubStr(m, 1, 1)
+        m := RegExReplace(m, s, "", c)
+        a[s] := c
+    }
+    for key, val in a
+    {
+        m := Log(p := val / len)
+        e -= p * m / Log(2)
+    }
+    return, e
+}

Task/Fibonacci-word/C++/fibonacci-word.cpp

@@ -0,0 +1,53 @@
+#include <string>
+#include <map>
+#include <iostream>
+#include <algorithm>
+#include <cmath>
+#include <iomanip>
+
+double log2( double number ) {
+   return ( log( number ) / log( 2 ) ) ;
+}
+
+double find_entropy( std::string & fiboword ) {
+   std::map<char , int> frequencies ;
+   std::for_each( fiboword.begin( ) , fiboword.end( ) ,
+	 [ & frequencies ]( char c ) { frequencies[ c ]++ ; } ) ;
+   int numlen = fiboword.length( ) ;
+   double infocontent = 0 ;
+   for ( std::pair<char , int> p : frequencies ) {
+      double freq = static_cast<double>( p.second ) / numlen ;
+      infocontent += freq * log2( freq ) ;
+   }
+   infocontent *= -1 ;
+   return infocontent ;
+}
+
+void printLine( std::string &fiboword , int n ) {
+   std::cout << std::setw( 5 ) << std::left << n ;
+   std::cout << std::setw( 12 ) << std::right << fiboword.size( ) ;
+   std::cout << "  " << std::setw( 16 ) << std::setprecision( 13 )
+      << std::left << find_entropy( fiboword ) ;
+   std::cout << "\n" ;
+}
+
+int main( ) {
+   std::cout << std::setw( 5 ) << std::left << "N" ;
+   std::cout << std::setw( 12 ) << std::right << "length" ;
+   std::cout << "  " << std::setw( 16 ) << std::left << "entropy" ;
+   std::cout << "\n" ;
+   std::string firststring ( "1" ) ;
+   int n = 1 ;
+   printLine( firststring , n ) ;
+   std::string secondstring( "0" ) ;
+   n++ ;
+   printLine( secondstring , n ) ;
+   while ( n < 37 ) {
+      std::string resultstring = firststring + secondstring ;
+      firststring.assign( secondstring ) ;
+      secondstring.assign( resultstring ) ;
+      n++ ;
+      printLine( resultstring , n ) ;
+   }
+   return 0 ;
+}

Task/Fibonacci-word/C/fibonacci-word.c

@@ -0,0 +1,97 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+
+void print_headings()
+{
+	printf("%2s", "N");
+	printf(" %10s", "Length");
+	printf(" %-20s", "Entropy");
+	printf(" %-40s", "Word");
+	printf("\n");
+}
+
+double calculate_entropy(int ones, int zeros)
+{
+	double result = 0;
+	
+	int total = ones + zeros;
+	result -= (double) ones / total * log2((double) ones / total);
+	result -= (double) zeros / total * log2((double) zeros / total);
+	
+	if (result != result) { // NAN
+		result = 0;
+	}
+	
+	return result;
+}
+
+void print_entropy(char *word)
+{
+	int ones = 0;
+	int zeros = 0;
+	
+	int i;
+	for (i = 0; word[i]; i++) {
+		char c = word[i];
+		
+		switch (c) {
+			case '0':
+				zeros++;
+				break;
+			case '1':
+				ones++;
+				break;
+		}
+	}
+	
+	double entropy = calculate_entropy(ones, zeros);
+	printf(" %-20.18f", entropy);
+}
+
+void print_word(int n, char *word)
+{
+	printf("%2d", n);
+	
+	printf(" %10ld", strlen(word));
+	
+	print_entropy(word);
+	
+	if (n < 10) {
+		printf(" %-40s", word);
+	} else {
+		printf(" %-40s", "...");
+	}
+	
+	printf("\n");
+}
+
+int main(int argc, char *argv[])
+{
+	print_headings();
+	
+	char *last_word = malloc(2);
+	strcpy(last_word, "1");
+	
+	char *current_word = malloc(2);
+	strcpy(current_word, "0");
+	
+	print_word(1, last_word);
+	int i;
+	for (i = 2; i <= 37; i++) {
+		print_word(i, current_word);
+		
+		char *next_word = malloc(strlen(current_word) + strlen(last_word) + 1);
+		strcpy(next_word, current_word);
+		strcat(next_word, last_word);
+		
+		free(last_word);
+		last_word = current_word;
+		current_word = next_word;
+	}
+	
+	free(last_word);
+	free(current_word);
+	return 0;
+}

Task/Fibonacci-word/Clojure/fibonacci-word.clj

@@ -0,0 +1,18 @@
+(defn entropy [s]
+  (let [len (count s), log-2 (Math/log 2)]
+    (->> (frequencies s)
+         (map (fn [[_ v]]
+                (let [rf (/ v len)]
+                  (-> (Math/log rf) (/ log-2) (* rf) Math/abs))))
+         (reduce +))))
+
+(defn fibonacci [cat a b]
+  (lazy-seq
+    (cons a (fibonacci b (cat a b)))))
+
+; you could also say (fibonacci + 0 1) or (fibonacci concat '(0) '(1))
+
+(printf "%2s %10s %17s %s%n" "N" "Length" "Entropy" "Fibword")
+(doseq [i (range 1 38)
+        w (take 37 (fibonacci str "1" "0"))]
+  (printf "%2d %10d %.15f %s%n" i (count w) (entropy w) (if (<= i 8) w "..."))))

Task/Fibonacci-word/D/fibonacci-word.d

@@ -0,0 +1,23 @@
+import std.stdio, std.algorithm, std.math, std.string, std.range;
+
+real entropy(T)(T[] s) pure nothrow
+if (__traits(compiles, s.sort())) {
+    immutable sLen = s.length;
+    return s
+           .sort()
+           .group
+           .map!(g => g[1] / real(sLen))
+           .map!(p => -p * p.log2)
+           .sum;
+}
+
+void main() {
+    enum uint nMax = 37;
+
+    "  N     Length               Entropy Fibword".writeln;
+    uint n = 1;
+    foreach (s; recurrence!q{a[n - 1] ~ a[n - 2]}("1", "0").take(nMax))
+        writefln("%3d %10d %2.19f %s", n++, s.length,
+                 s.dup.representation.entropy.abs,
+                 s.length < 25 ? s : "<too long>");
+}

Task/Fibonacci-word/Go/fibonacci-word.go

@@ -0,0 +1,61 @@
+package main
+
+import (
+	"fmt"
+	"math"
+)
+
+// From http://rosettacode.org/wiki/Entropy#Go
+func entropy(s string) float64 {
+	m := map[rune]float64{}
+	for _, r := range s {
+		m[r]++
+	}
+	hm := 0.
+	for _, c := range m {
+		hm += c * math.Log2(c)
+	}
+	l := float64(len(s))
+	return math.Log2(l) - hm/l
+}
+
+const F_Word1 = "1"
+const F_Word2 = "0"
+
+func FibonacciWord(n int) string {
+	a, b := F_Word1, F_Word2
+	for ; n > 1; n-- {
+		a, b = b, b+a
+	}
+	return a
+}
+
+func FibonacciWordGen() <-chan string {
+	ch := make(chan string)
+	go func() {
+		a, b := F_Word1, F_Word2
+		for {
+			ch <- a
+			a, b = b, b+a
+		}
+	}()
+	return ch
+}
+
+func main() {
+	fibWords := FibonacciWordGen()
+	fmt.Printf("%3s %9s  %-18s  %s\n", "N", "Length", "Entropy", "Word")
+	n := 1
+	for ; n < 10; n++ {
+		s := <-fibWords
+		// Just to show the function and generator do the same thing:
+		if s2 := FibonacciWord(n); s != s2 {
+			fmt.Printf("For %d, generator produced %q, function produced %q\n", n, s, s2)
+		}
+		fmt.Printf("%3d %9d  %.16f  %s\n", n, len(s), entropy(s), s)
+	}
+	for ; n <= 37; n++ {
+		s := <-fibWords
+		fmt.Printf("%3d %9d  %.16f\n", n, len(s), entropy(s))
+	}
+}

Task/Fibonacci-word/Haskell/fibonacci-word.hs

@@ -0,0 +1,25 @@
+module Main where
+
+import Control.Monad
+import Data.List
+import Data.Monoid
+import Text.Printf
+
+entropy :: (Ord a) => [a] -> Double
+entropy = sum
+        . map (\c -> (c *) . logBase 2 $ 1.0 / c)
+        . (\cs -> let { sc = sum cs } in map (/ sc) cs)
+        . map (fromIntegral . length)
+        . group
+        . sort
+
+fibonacci :: (Monoid m) => m -> m -> [m]
+fibonacci a b = unfoldr (\(a,b) -> Just (a, (b, a <> b))) (a,b)
+
+main :: IO ()
+main = do
+    printf "%2s %10s %17s %s\n" "N" "length" "entropy" "word"
+    zipWithM_ (\i v -> let { l = length v } in printf "%2d %10d %.15f %s\n"
+                   i l (entropy v) (if l > 40 then "..." else v))
+              [1..38::Int]
+              (take 37 $ fibonacci "1" "0")

Task/Fibonacci-word/Icon/fibonacci-word.icon

@@ -0,0 +1,27 @@
+procedure main(A)
+    n := integer(A[1]) | 37
+    write(right("N",4)," ",right("length",15)," ",left("Entrophy",15)," ",
+          " Fibword")
+    every w := fword(i := 1 to n) do {
+        writes(right(i,4)," ",right(*w,15)," ",left(H(w),15))
+        if i <= 8 then write(": ",w) else write()
+        }
+end
+
+procedure fword(n)
+    static fcache
+    initial fcache := table()
+    /fcache[n] := case n of {
+                     1: "1"
+                     2: "0"
+                     default: fword(n-1)||fword(n-2)
+                     }
+    return fcache[n]
+end
+
+procedure H(s)
+    P := table(0.0)
+    every P[!s] +:= 1.0/*s
+    every (h := 0.0) -:= P[c := key(P)] * log(P[c],2)
+    return h
+end

Task/Fibonacci-word/J/fibonacci-word-1.j

@@ -0,0 +1 @@
+F_Words=: (,<@;@:{~&_1 _2)@]^:(2-~[)&('1';'0')

Task/Fibonacci-word/J/fibonacci-word-2.j

@@ -0,0 +1 @@
+entropy=:  +/@:-@(* 2&^.)@(#/.~ % #)

Task/Fibonacci-word/J/fibonacci-word-3.j

@@ -0,0 +1,38 @@
+   (,.~#\)(#,entropy)@> F_Words 37
+ 1         1        0
+ 2         1        0
+ 3         2        1
+ 4         3 0.918296
+ 5         5 0.970951
+ 6         8 0.954434
+ 7        13 0.961237
+ 8        21 0.958712
+ 9        34 0.959687
+10        55 0.959316
+11        89 0.959458
+12       144 0.959404
+13       233 0.959424
+14       377 0.959417
+15       610  0.95942
+16       987 0.959418
+17      1597 0.959419
+18      2584 0.959419
+19      4181 0.959419
+20      6765 0.959419
+21     10946 0.959419
+22     17711 0.959419
+23     28657 0.959419
+24     46368 0.959419
+25     75025 0.959419
+26    121393 0.959419
+27    196418 0.959419
+28    317811 0.959419
+29    514229 0.959419
+30    832040 0.959419
+31 1.34627e6 0.959419
+32 2.17831e6 0.959419
+33 3.52458e6 0.959419
+34 5.70289e6 0.959419
+35 9.22747e6 0.959419
+36 1.49304e7 0.959419
+37 2.41578e7 0.959419

Task/Fibonacci-word/Java/fibonacci-word.java

@@ -0,0 +1,50 @@
+import java.util.*;
+
+public class FWord {
+    private /*v*/ String fWord0 = "";
+    private /*v*/ String fWord1 = "";
+
+    private String nextFWord () {
+        final String result;
+
+        if ( "".equals ( fWord1 ) )      result = "1";
+        else if ( "".equals ( fWord0 ) ) result = "0";
+        else                             result = fWord1 + fWord0;
+
+        fWord0 = fWord1;
+        fWord1 = result;
+
+        return result;
+    }
+
+    public static double entropy ( final String source ) {
+        final int                        length = source.length ();
+        final Map < Character, Integer > counts = new HashMap < Character, Integer > ();
+        /*v*/ double                     result = 0.0;
+
+        for ( int i = 0; i < length; i++ ) {
+            final char c = source.charAt ( i );
+
+            if ( counts.containsKey ( c ) ) counts.put ( c, counts.get ( c ) + 1 );
+            else                            counts.put ( c, 1 );
+        }
+
+        for ( final int count : counts.values () ) {
+            final double proportion = ( double ) count / length;
+
+            result -= proportion * ( Math.log ( proportion ) / Math.log ( 2 ) );
+        }
+
+        return result;
+    }
+
+    public static void main ( final String [] args ) {
+        final FWord fWord = new FWord ();
+
+        for ( int i = 0; i < 37;  ) {
+            final String word = fWord.nextFWord ();
+
+            System.out.printf ( "%3d %10d %s %n", ++i, word.length (), entropy ( word ) );
+        }
+    }
+}

Task/Fibonacci-word/Mathematica/fibonacci-word.math

@@ -0,0 +1,7 @@
+entropy = (p - 1) Log[2, 1 - p] - p Log[2, p];
+
+TableForm[
+ Table[{k, Fibonacci[k],
+   Quiet@Check[N[entropy /. {p -> Fibonacci[k - 1]/Fibonacci[k]}, 15],
+      0]}, {k, 37}],
+ TableHeadings -> {None, {"N", "Length", "Entropy"}}]

Task/Fibonacci-word/PARI-GP/fibonacci-word.pari

@@ -0,0 +1,4 @@
+ent(a,b)=[a,b]=[a,b]/(a+b);(a*log(if(a,a,1))+b*log(if(b,b,1)))/log(1/2)
+allocatemem(75<<20) \\ Allocate 75 MB stack space
+F=vector(37);F[1]="1";F[2]="0";for(n=3,37,F[n]=Str(F[n-1],F[n-2]))
+for(n=1,37,print(n" "fibonacci(n)" "ent(fibonacci(n-1),fibonacci(n-2))))

Task/Fibonacci-word/PL-I/fibonacci-word.pli

@@ -0,0 +1,24 @@
+fibword: procedure options (main);  /* 9 October 2013 */
+   declare (fn, fnp1, fibword) bit (32000) varying;
+   declare (i, ln, lnp1, lfibword) fixed binary(31);
+
+   fn = '1'b; fnp1 = '0'b; ln, lnp1 = 1;
+   put skip edit (1, length(fn), fn)     (f(2), f(10), x(1), b);
+   put skip edit (2, length(fnp1), fnp1) (f(2), f(10), x(1), b);
+   do i = 3 to 37;
+      lfibword = lnp1 + ln;
+      ln = lnp1;
+      lnp1 = lfibword;
+      if i <= 10 then
+         do;
+            fibword = fnp1 || fn;
+            put skip edit (i, length(fibword), fibword) (f(2), f(10), x(1), b);
+            fn = fnp1; fnp1 = fibword;
+         end;
+      else
+         do;
+            put skip edit (i, lfibword) (f(2), f(10));
+         end;
+   end;
+
+end fibword;

Task/Fibonacci-word/Pascal/fibonacci-word.pascal

@@ -0,0 +1,109 @@
+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.

Task/Fibonacci-word/Perl-6/fibonacci-word-1.pl6

@@ -0,0 +1,11 @@
+constant @fib-word = 1, 0, { $^b ~ $^a } ... *;
+
+sub entropy {
+    -log(2) R/
+        [+] map -> \p { p * log p },
+            $^string.comb.Bag.values »/» $string.chars
+}
+for @fib-word[^37] {
+    printf "%5d\t%10d\t%.8e\t%s\n",
+    (state $n)++, .chars, .&entropy, $n > 10 ?? '' !! $_;
+}

Task/Fibonacci-word/Perl-6/fibonacci-word-2.pl6

@@ -0,0 +1,19 @@
+constant @fib-word = '1', '0', { $^b ~ $^a } ... *;
+constant @fib-ones = 1, 0, * + * ... *;
+constant @fib-chrs = 1, 1, * + * ... *;
+
+multi entropy(0) { 0 }
+multi entropy(1) { 0 }
+multi entropy($n) {
+    my $chars = @fib-chrs[$n];
+    my $ones  = @fib-ones[$n];
+    my $zeros = $chars - $ones;
+    -log(2) R/
+        [+] map -> \p { p * log p },
+            $ones / $chars, $zeros / $chars
+}
+
+for 0..100 -> $n {
+    printf "%5d\t%21d\t%.15e\t%s\n",
+	    $n, @fib-chrs[$n], entropy($n), $n > 9 ?? '' !! @fib-word[$n];
+}

Task/Fibonacci-word/Perl/fibonacci-word.pl

@@ -0,0 +1,31 @@
+sub fiboword;
+{
+    my ($a, $b, $count) = (1, 0, 0);
+    sub fiboword {
+        $count++;
+        return $a if $count == 1;
+        return $b if $count == 2;
+        ($a, $b) = ($b, "$b$a");
+        return $b;
+    }
+}
+sub entropy {
+    my %c;
+    $c{$_}++ for split //, my $str = shift;
+    my $e = 0;
+    for (values %c) {
+        my $p = $_ / length $str;
+        $e -= $p * log $p;
+    }
+    return $e / log 2;
+}
+
+my $count;
+while ($count++ < 37) {
+    my $word = fiboword;
+    printf "%5d\t%10d\t%.8e\t%s\n",
+    $count,
+    length($word),
+    entropy($word),
+    $count > 9 ? '' : $word
+}

Task/Fibonacci-word/Python/fibonacci-word.py

@@ -0,0 +1,58 @@
+>>> import math
+>>> from collections import Counter
+>>>
+>>> def entropy(s):
+...     p, lns = Counter(s), float(len(s))
+...     return -sum( count/lns * math.log(count/lns, 2) for count in p.values())
+...
+>>>
+>>> def fibword(nmax=37):
+...     fwords = ['1', '0']
+...     print('%-3s %10s %-10s %s' % tuple('N Length Entropy Fibword'.split()))
+...     def pr(n, fwords):
+...         while len(fwords) < n:
+...             fwords += [''.join(fwords[-2:][::-1])]
+...         v = fwords[n-1]
+...         print('%3i %10i %10.7g %s' % (n, len(v), entropy(v), v if len(v) < 20 else '<too long>'))
+...     for n in range(1, nmax+1): pr(n, fwords)
+...
+>>> fibword()
+N       Length Entropy    Fibword
+  1          1         -0 1
+  2          1         -0 0
+  3          2          1 01
+  4          3  0.9182958 010
+  5          5  0.9709506 01001
+  6          8   0.954434 01001010
+  7         13  0.9612366 0100101001001
+  8         21  0.9587119 <too long>
+  9         34  0.9596869 <too long>
+ 10         55   0.959316 <too long>
+ 11         89  0.9594579 <too long>
+ 12        144  0.9594038 <too long>
+ 13        233  0.9594244 <too long>
+ 14        377  0.9594165 <too long>
+ 15        610  0.9594196 <too long>
+ 16        987  0.9594184 <too long>
+ 17       1597  0.9594188 <too long>
+ 18       2584  0.9594187 <too long>
+ 19       4181  0.9594187 <too long>
+ 20       6765  0.9594187 <too long>
+ 21      10946  0.9594187 <too long>
+ 22      17711  0.9594187 <too long>
+ 23      28657  0.9594187 <too long>
+ 24      46368  0.9594187 <too long>
+ 25      75025  0.9594187 <too long>
+ 26     121393  0.9594187 <too long>
+ 27     196418  0.9594187 <too long>
+ 28     317811  0.9594187 <too long>
+ 29     514229  0.9594187 <too long>
+ 30     832040  0.9594187 <too long>
+ 31    1346269  0.9594187 <too long>
+ 32    2178309  0.9594187 <too long>
+ 33    3524578  0.9594187 <too long>
+ 34    5702887  0.9594187 <too long>
+ 35    9227465  0.9594187 <too long>
+ 36   14930352  0.9594187 <too long>
+ 37   24157817  0.9594187 <too long>
+>>>

Task/Fibonacci-word/R/fibonacci-word.r

@@ -0,0 +1,31 @@
+entropy <- function(s)
+{
+  if (length(s) > 1)
+    return(sapply(s, entropy))
+
+  freq <- prop.table(table(strsplit(s, '')[1]))
+  ret <- -sum(freq * log(freq, base=2))
+
+  return(ret)
+}
+
+fibwords <- function(n)
+{
+  if (n == 1)
+    fibwords <- "1"
+  else
+    fibwords <- c("1", "0")
+
+  if (n > 2)
+  {
+    for (i in 3:n)
+      fibwords <- c(fibwords, paste(fibwords[i-1L], fibwords[i-2L], sep=""))
+  }
+
+  str <- if (n > 7) replicate(n-7, "too long") else NULL
+  fibwords.print <- c(fibwords[1:min(n, 7)], str)
+
+  ret <- data.frame(Length=nchar(fibwords), Entropy=entropy(fibwords), Fibwords=fibwords.print)
+  rownames(ret) <- NULL
+  return(ret)
+}

Task/Fibonacci-word/README

@@ -0,0 +1 @@
+Data source: http://rosettacode.org/wiki/Fibonacci_word

Task/Fibonacci-word/REXX/fibonacci-word.rexx

@@ -0,0 +1,36 @@
+/*REXX program lists # of chars in a fibonacci word, the word's entropy.*/
+numeric digits 20                      /*use more precision,  default=9.*/
+parse arg N !.1 !.2 .                  /*get optional args from the C.L.*/
+if   N==''  then   N=37                /*Not specified? Then use default*/
+if !.1==''  then !.1=1                 /* "      "        "   "     "   */
+if !.2==''  then !.2=0                 /* "      "        "   "     "   */
+say center('N',5) center('length',12) center('entropy',digits()+6) center('Fib word',35)
+say copies('─',5) copies('─'     ,12) copies('─'      ,digits()+6) copies('─'       ,35)
+
+      do j=1  for N;  j1=j-1;  j2=j-2  /*display  N  fibonacci words.   */
+      if j>2  then !.j=!.j1 || !.j2    /*calculate FIBword if we need to*/
+      if length(!.j)<35  then Fw= !.j
+                         else Fw= '{the word is too wide to display}'
+      say  right(j,4)   right(length(!.j),12)  '  '   entropy(!.j) '  ' Fw
+      end   /*j*/
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────ENTROPY subroutine──────────────────*/
+entropy: procedure;  parse arg $;      L=length($);     d=digits()
+if L==1  then return left(0,d+2)       /*handle special case of one char*/
+@.0=L-length(space(translate($,,0),0)) /*fast way to count zeroes.      */
+@.1=L-@.0                              /*and figure the number of ones. */
+S=0                                    /* [↓] calc entropy for each char*/
+      do i=1  for 2;  _=i-1            /*construct a chr from the ether.*/
+      S = S - @._/L * log2(@._/L)      /*add (negatively) the entropies.*/
+      end   /*i*/
+if S=1  then return left(1,d+2)        /*return a left-justified  "1".  */
+return format(S,,d)                    /*normalize the number (sum or S).    */
+/*──────────────────────────────────LOG2 subroutine───────────────────────────*/
+log2: procedure; parse arg x 1 xx;  ig= x>1.5;  is=1-2*(ig\==1);  ii=0
+numeric digits digits()+5      /* [↓] precision of E must be > digits().*/
+e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
+  do  while  ig & xx>1.5 | \ig&xx<.5;   _=e;       do j=-1;  iz=xx* _**-is
+  if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave;  _=_*_;  izz=iz;  end  /*j*/
+  xx=izz;  ii=ii+is*2**j;  end /*while*/;       x=x* e**-ii-1;  z=0;  _=-1;  p=z
+    do k=1;  _=-_*x;  z=z+_/k;  if z=p  then leave;  p=z;  end  /*k*/
+  r=z+ii;  if arg()==2  then return r;  return r/log2(2,0)

Task/Fibonacci-word/Racket/fibonacci-word-1.rkt

@@ -0,0 +1,62 @@
+#lang racket
+(provide F-Word gen-F-Word (struct-out f-word) f-word-max-length)
+(require "entropy.rkt") ; save Entropy task implementation as "entropy.rkt"
+
+(define f-word-max-length (make-parameter 80))
+(define-struct f-word (str length count-0 count-1))
+(define (string->f-word str)
+  (apply f-word str
+         (call-with-values
+          (λ ()
+            (for/fold
+                ((l 0) (zeros 0) (ones 0))
+              ((c str))
+              (match c
+                (#\0 (values (add1 l) (add1 zeros) ones))
+                (#\1 (values (add1 l) zeros (add1 ones))))))
+          list)))
+(define F-Word# (make-hash))
+
+(define (gen-F-Word n #:key-id key-id #:word-1 word-1 #:word-2 word-2 #:merge-fn merge-fn)
+  (define sub-F-Word (match-lambda (1 word-1) (2 word-2) ((? number? n) (merge-fn n))))
+  (hash-ref! F-Word# (list key-id (f-word-max-length) n) (λ () (sub-F-Word n))))
+
+(define (F-Word n)
+  (define f-word-1 (string->f-word "1"))
+  (define f-word-2 (string->f-word "0"))
+  (define (f-word-merge>2 n)
+    (define f-1 (F-Word (- n 1)))
+    (define f-2 (F-Word (- n 2)))
+    (define length+  (+ (f-word-length f-1) (f-word-length f-2)))
+    (define count-0+ (+ (f-word-count-0 f-1) (f-word-count-0 f-2)))
+    (define count-1+ (+ (f-word-count-1 f-1) (f-word-count-1 f-2)))
+    (define str+
+      (if (and (f-word-max-length)
+               (> length+ (f-word-max-length)))
+          (format "<string too long (~a)>" length+)
+          (string-append (f-word-str f-1) (f-word-str f-2))))
+    (f-word str+ length+ count-0+ count-1+))
+
+  (gen-F-Word n
+              #:key-id 'words
+              #:word-1 f-word-1
+              #:word-2 f-word-2
+              #:merge-fn f-word-merge>2))
+
+(module+ main
+  (parameterize ((f-word-max-length 80))
+    (for ((n (sequence-map add1 (in-range 37))))
+      (define W (F-Word n))
+      (define e (hash-entropy (hash 0 (f-word-count-0 W)
+                                    1 (f-word-count-1 W))))
+      (printf "~a ~a ~a ~a~%"
+              (~a n #:width 3 #:align 'right)
+              (~a (f-word-length W) #:width 9 #:align 'right)
+              (real->decimal-string e 12)
+              (~a (f-word-str W))))))
+
+(module+ test
+  (require rackunit)
+  (check-match (F-Word 4) (f-word "010" _ _ _))
+  (check-match (F-Word 5) (f-word "01001" _ _ _))
+  (check-match (F-Word 8) (f-word "010010100100101001010" _ _ _)))

Task/Fibonacci-word/Racket/fibonacci-word-2.rkt

@@ -0,0 +1,32 @@
+#lang racket
+
+(define f-word-max-length (make-parameter 80))
+(define-struct f-word (str length count-0 count-1))
+
+(define F-Word# (make-hash))
+(define (F-Word n)
+  (hash-ref!
+   F-Word#
+   (list (f-word-max-length) n)
+   (λ ()
+     (match n
+      (1 (f-word "1" 1 0 1))
+      (2 (f-word "0" 1 1 0))
+      ((? number? n)
+       (define f-1 (F-Word (- n 1)))
+       (define f-2 (F-Word (- n 2)))
+       (define length+  (+ (f-word-length f-1) (f-word-length f-2)))
+       (define count-0+ (+ (f-word-count-0 f-1) (f-word-count-0 f-2)))
+       (define count-1+ (+ (f-word-count-1 f-1) (f-word-count-1 f-2)))
+       (define str+
+         (if (and (f-word-max-length)
+                  (> length+ (f-word-max-length)))
+             (format "<string too long (~a)>" length+)
+             (string-append (f-word-str f-1) (f-word-str f-2))))
+       (f-word str+ length+ count-0+ count-1+))))))
+
+(module+ test
+  (require rackunit)
+  (check-match (F-Word 4) (f-word "010" _ _ _))
+  (check-match (F-Word 5) (f-word "01001" _ _ _))
+  (check-match (F-Word 8) (f-word "010010100100101001010" _ _ _)))

Task/Fibonacci-word/Ruby/fibonacci-word.rb

@@ -0,0 +1,23 @@
+#encoding: ASCII-8BIT
+
+def entropy(s)
+  counts = Hash.new(0)
+  s.each_char { |c| counts[c] += 1 }
+
+  counts.values.reduce(0) do |entropy, count|
+    freq = count / s.length.to_f
+    entropy - freq * Math.log2(freq)
+  end
+end
+
+n_max = 37
+words = ['1', '0']
+
+for n in words.length ... n_max
+  words << words[-1] + words[-2]
+end
+
+puts '%3s %10s %15s  %s' % %w[N Length Entropy Fibword]
+words.each.with_index(1) do |word, i|
+  puts '%3i %10i %15.12f  %s' % [i, word.length, entropy(word), word.length<30 ? word : '<too long>']
+end

Task/Fibonacci-word/Scala/fibonacci-word.scala

@@ -0,0 +1,17 @@
+//word iterator
+def fibIt = Iterator.iterate(("1","0")){case (f1,f2) => (f2,f1+f2)}.map(_._1)
+
+//entropy calculator
+def entropy(src: String): Double = {
+  val xs = src.groupBy(identity).map(_._2.length)
+  var result = 0.0
+  xs.foreach{c =>
+    val p = c.toDouble / src.length
+    result -= p * (Math.log(p) / Math.log(2))
+  }
+  result
+}
+
+//printing (spaces inserted to get the tabs align properly)
+val it = fibIt.zipWithIndex.map(w => (w._2, w._1.length, entropy(w._1)))
+println(it.take(37).map{case (n,l,e) => s"$n).\t$l       \t$e"}.mkString("\n"))

Task/Fibonacci-word/Seed7/fibonacci-word.seed7

@@ -0,0 +1,53 @@
+$ include "seed7_05.s7i";
+  include "float.s7i";
+  include "math.s7i";
+
+const func float: entropy (in string: stri) is func
+  result
+    var float: entropy is 0.0;
+  local
+    var hash [char] integer: count is (hash [char] integer).value;
+    var char: ch is ' ';
+    var float: p is 0.0;
+  begin
+    for ch range stri do
+      if ch in count then
+        incr(count[ch]);
+      else
+        count @:= [ch] 1;
+      end if;
+    end for;
+    for key ch range count do
+      p := flt(count[ch]) / flt(length(stri));
+      entropy -:= p * log(p) / log(2.0);
+    end for;
+  end func ;
+
+const func string: fibWord (in integer: number) is func
+  result
+    var string: fibWord is "1";
+  local
+    var integer: i is 0;
+    var string: a is "1";
+    var string: c is "";
+  begin
+    if number >= 2 then
+      fibWord := "0";
+      for i range 3 to number do
+        c := a;
+        a := fibWord;
+        fibWord &:= c;
+      end for;
+    end if;
+  end func;
+
+const proc: main is func
+  local
+    var integer: index is 0;
+    var string: fibWord is "";
+  begin
+    for index range 1 to 37 do
+      fibWord := fibWord(index);
+      writeln(index lpad 2 <& length(fibWord) lpad 10 <& " " <& entropy(fibWord) digits 15);
+    end for;
+  end func;

Task/Fibonacci-word/Tcl/fibonacci-word.tcl

@@ -0,0 +1,28 @@
+proc fibwords {n} {
+    set fw {1 0}
+    while {[llength $fw] < $n} {
+	lappend fw [lindex $fw end][lindex $fw end-1]
+    }
+    return $fw
+}
+
+proc fibwordinfo {num word} {
+    # Entropy calculator from Tcl solution of that task
+    set log2 [expr log(2)]
+    set len [string length $word]
+    foreach char [split $word ""] {dict incr counts $char}
+    set entropy 0.0
+    foreach count [dict values $counts] {
+	set freq [expr {$count / double($len)}]
+	set entropy [expr {$entropy - $freq * log($freq)/$log2}]
+    }
+    # Output formatting from Clojure solution
+    puts [format "%2d %10d %.15f %s" $num $len $entropy \
+	    [if {$len < 35} {set word} {subst "<too long>"}]]
+}
+
+# Output formatting from Clojure solution
+puts [format "%2s %10s %17s %s" N Length Entropy Fibword]
+foreach word [fibwords 37] {
+    fibwordinfo [incr i] $word
+}