aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Fibonacci-word/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Fibonacci_word

25
Task/Fibonacci-word/00-TASK.txt Normal file
View file

@ -0,0 +1,25 @@
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 &nbsp; F_Word<sub>1</sub> &nbsp; as &nbsp; '''1'''
Define &nbsp; F_Word<sub>2</sub> &nbsp; as &nbsp; '''0'''
Form &nbsp; &nbsp; F_Word<sub>3</sub> &nbsp; as &nbsp; F_Word<sub>2</sub> &nbsp; &nbsp; concatenated with &nbsp; F_Word<sub>1</sub> &nbsp; i.e.: &nbsp; '''01'''
Form &nbsp; &nbsp; F_Word<sub>n</sub> &nbsp; as &nbsp; F_Word<sub>n-1</sub> &nbsp; concatenated with &nbsp; F_word<sub>n-2</sub>
;Task:
Perform the above steps for &nbsp; &nbsp; n = 37.
You may display the first few but not the larger values of &nbsp; n.
<br><small>{Doing so will get the task's author into trouble with them what be (again!).} </small>
Instead, create a table for &nbsp; F_Words &nbsp; '''1''' &nbsp; to &nbsp; '''37''' &nbsp; which shows:
::* &nbsp; The number of characters in the word
::* &nbsp; The word's [[Entropy]]
;Related tasks:
* &nbsp; [[Fibonacci_word/fractal|Fibonacci word/fractal]]
* &nbsp; [[Entropy]]
* &nbsp; [[Entropy/Narcissist]]
<br><br>

14
Task/Fibonacci-word/11l/fibonacci-word.11l Normal file
View file

@ -0,0 +1,14 @@
F entropy(s)
I s.len <= 1
R 0.0
V lns = Float(s.len)
V count0 = s.count(‘0’)
R -sum((count0, s.len - count0).map(count -> count / @lns * log(count / @lns, 2)))
V fwords = [String(‘1’), ‘0’]
print(‘#<3 #10 #<10 #.’.format(‘N’, ‘Length’, ‘Entropy’, ‘Fibword’))
L(n) 1..37
L fwords.len < n
fwords [+]= reversed(fwords[(len)-2..]).join(‘’)
V v = fwords[n - 1]
print(‘#3.0 #10.0 #2.7 #.’.format(n, v.len, entropy(v), I v.len < 56 {v} E ‘<too long>’))

118
Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg Normal file
View file

@ -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 )
)

3
Task/Fibonacci-word/APL/fibonacci-word.apl Normal file
View file

@ -0,0 +1,3 @@
F_WORD←{{⍵,,/⌽¯2↑⍵}⍣(0⌈⍺-2),¨⍵}
ENTROPY←{-+/R×2⍟R←(+⌿⍵∘.=∪⍵)÷⍴⍵}
FORMAT←{'N' 'LENGTH' 'ENTROPY'⍪(⍳⍵),↑{(⍴⍵),ENTROPY ⍵}¨⍵ F_WORD 1 0}

56
Task/Fibonacci-word/Ada/fibonacci-word.ada Normal file
View file

@ -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;

44
Task/Fibonacci-word/Aime/fibonacci-word.aime Normal file
View file

@ -0,0 +1,44 @@
real
entropy(data b)
{
integer count, i;
real ones, zeros;
ones = zeros = 0;
i = -(count = ~b);
while (i) {
if (b[i] == '0') {
zeros += 1;
} else {
ones += 1;
}
i += 1;
}
return -(ones /= count) * log2(ones) - (zeros /= count) * log2(zeros);
}
integer
main(void)
{
data a, b;
integer i;
a = "1";
b = "0";
o_form("%2d %9d /w12p10d10/ ~\n", 1, ~a, 0r, a);
o_form("%2d %9d /w12p10d10/ ~\n", 2, ~b, 0r, b);
i = 3;
while (i <= 37) {
bu_copy(a, 0, b);
o_form("%2d %9d /w12p10d10/ ~\n", i, ~a, entropy(a),
i < 10 ? a.string : "");
i += 1;
b.swap(a);
}
return 0;
}

32
Task/Fibonacci-word/Arturo/fibonacci-word.arturo Normal file
View file

@ -0,0 +1,32 @@
entropy: function [s][
if 1 >= size s -> return 0.0
strlen: to :floating size s
count0: to :floating size match s "0"
count1: strlen - count0
return neg add (count0/strlen) * log count0/strlen 2 (count1/strlen) * log count1/strlen 2
]
fibwords: function [n][
x: 0
a: "1"
b: "0"
result: @[a b]
while [x<n][
a: b ++ a
tmp: b
b: a
a: tmp
result: result ++ b
x: x+1
]
return result
]
loop.with:'i fibwords 37 'w [
print [
pad to :string i+1 4
pad to :string size w 10
pad to :string entropy w 20
]
]

28
Task/Fibonacci-word/AutoHotkey/fibonacci-word.ahk Normal file
View file

@ -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
}

53
Task/Fibonacci-word/C++/fibonacci-word.cpp Normal file
View file

@ -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 ;
}

71
Task/Fibonacci-word/C-sharp/fibonacci-word.cs Normal file
View file

@ -0,0 +1,71 @@
using SYS = System;
using SCG = System.Collections.Generic;
//
// Basically a port of the C++ solution as posted
// 2017-11-12.
//
namespace FibonacciWord
{
class Program
{
static void Main( string[] args )
{
PrintHeading();
string firstString = "1";
int n = 1;
PrintLine( n, firstString );
string secondString = "0";
++n;
PrintLine( n, secondString );
while ( n < 37 )
{
string resultString = firstString + secondString;
firstString = secondString;
secondString = resultString;
++n;
PrintLine( n, resultString );
}
}
private static void PrintLine( int n, string result )
{
SYS.Console.Write( "{0,-5}", n );
SYS.Console.Write( "{0,12}", result.Length );
SYS.Console.WriteLine( " {0,-16}", GetEntropy( result ) );
}
private static double GetEntropy( string result )
{
SCG.Dictionary<char, int> frequencies = new SCG.Dictionary<char, int>();
foreach ( char c in result )
{
if ( frequencies.ContainsKey( c ) )
{
++frequencies[c];
}
else
{
frequencies[c] = 1;
}
}
int length = result.Length;
double entropy = 0;
foreach ( var keyValue in frequencies )
{
double freq = (double)keyValue.Value / length;
entropy += freq * SYS.Math.Log( freq, 2 );
}
return -entropy;
}
private static void PrintHeading()
{
SYS.Console.Write( "{0,-5}", "N" );
SYS.Console.Write( "{0,12}", "Length" );
SYS.Console.WriteLine( " {0,-16}", "Entropy" );
}
}
}

97
Task/Fibonacci-word/C/fibonacci-word.c Normal file
View file

@ -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;
}

44
Task/Fibonacci-word/CLU/fibonacci-word.clu Normal file
View file

@ -0,0 +1,44 @@
% NOTE: when compiling with Portable CLU,
% this program needs to be merged with 'useful.lib' to get log()
%
% pclu -merge $CLUHOME/lib/useful.lib -compile fib_words.clu
% Yield pairs of (zeroes, ones) for each Fibonacci word
% We don't generate the whole words, as that would take too much
% memory.
fib_words = iter () yields (int,int)
az: int := 0 ao: int := 1
bz: int := 1 bo: int := 0
while true do
yield(az, ao)
az, ao, bz, bo := bz, bo, az+bz, ao+bo
end
end fib_words
fib_entropy = proc (zeroes, ones: int) returns (real)
rsize: real := real$i2r(zeroes + ones)
zeroes_frac: real := real$i2r(zeroes)/rsize
ones_frac: real := real$i2r(ones)/rsize
return(-zeroes_frac*log(zeroes_frac)/log(2.0)
-ones_frac*log(ones_frac)/log(2.0))
except when undefined: return(0.0) end
end fib_entropy
start_up = proc ()
max = 37
po: stream := stream$primary_output()
stream$putl(po, " # Length Entropy")
num: int := 0
for zeroes, ones: int in fib_words() do
num := num + 1
stream$putright(po, int$unparse(num), 2)
stream$putright(po, int$unparse(zeroes+ones), 10)
stream$putright(po, f_form(fib_entropy(zeroes, ones), 1, 6), 10)
stream$putl(po, "")
if num=max then break end
end
end start_up

18
Task/Fibonacci-word/Clojure/fibonacci-word.clj Normal file
View file

@ -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 "..."))))

32
Task/Fibonacci-word/Common-Lisp/fibonacci-word.lisp Normal file
View file

@ -0,0 +1,32 @@
(defun make-fibwords (array)
(loop for i from 0 below 37
for j = "0" then (concatenate 'string j k)
and k = "1" then j
do (setf (aref array i) k))
array)
(defvar *fib* (make-fibwords (make-array 37)))
(defun entropy (string)
(let ((table (make-hash-table :test 'eql))
(entropy 0d0)
(n (length string)))
(mapc (lambda (c)
(setf (gethash c table) (+ (gethash c table 0) 1)))
(coerce string 'list))
(maphash (lambda (k v)
(declare (ignore k))
(decf entropy (* (/ v n) (log (/ v n) 2))))
table)
entropy))
(defun string-or-dots (string)
(if (> (length string) 40)
"..."
string))
(format t "~2A ~10A ~17A ~A~%" "N" "Length" "Entropy" "Fibword")
(loop for i below 37
for n = (aref *fib* i) do
(format t "~2D ~10D ~17,15F ~A~%"
(1+ i) (length n) (entropy n) (string-or-dots n)))

23
Task/Fibonacci-word/D/fibonacci-word.d Normal file
View file

@ -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>");
}

26
Task/Fibonacci-word/EchoLisp/fibonacci-word.l Normal file
View file

@ -0,0 +1,26 @@
(lib 'struct)
(struct FW ( count0 count1 length string)) ;; a fibonacci word
(define (F-word n) ;; generator
(define a (F-word (1- n)))
(define b (F-word (- n 2)))
(FW
(+ (FW-count0 a) (FW-count0 b))
(+ (FW-count1 a) (FW-count1 b))
(+ (FW-length a) (FW-length b))
(if (> n 9) "..." (string-append (FW-string a) (FW-string b)))))
(remember 'F-word (vector 0 (FW 0 1 1 "1") (FW 1 0 1 "0")))
(define (entropy fw)
(define p (// (FW-count0 fw) (FW-length fw)))
(cond
((= p 0) 0)
((= p 1) 0)
(else (- 0 (* p (log2 p)) (* (- 1 p) (log2 (- 1 p)))))))
(define (task (n 38) (fw))
(for ((i (in-range 1 n)))
(set! fw (F-word i))
(printf "%3d %10d %24d %a"
i (FW-length fw) (entropy fw) (FW-string fw))))

22
Task/Fibonacci-word/Elixir/fibonacci-word.elixir Normal file
View file

@ -0,0 +1,22 @@
defmodule RC do
def entropy(str) do
leng = String.length(str)
String.to_charlist(str)
|> Enum.reduce(Map.new, fn c,acc -> Map.update(acc, c, 1, &(&1+1)) end)
|> Map.values
|> Enum.reduce(0, fn count, entropy ->
freq = count / leng
entropy - freq * :math.log2(freq) # log2 was added with Erlang/OTP 18
end)
end
end
fibonacci_word = Stream.unfold({"1","0"}, fn{a,b} -> {a, {b, b<>a}} end)
IO.puts " N Length Entropy Fibword"
fibonacci_word |> Enum.take(37) |> Enum.with_index
|> Enum.each(fn {word,i} ->
len = String.length(word)
str = if len < 60, do: word, else: "<too long>"
:io.format "~3w ~8w ~17.15f ~s~n", [i+1, len, RC.entropy(word), str]
end)

11
Task/Fibonacci-word/F-Sharp/fibonacci-word.fs Normal file
View file

@ -0,0 +1,11 @@
// include the code from /wiki/Entropy#F.23 for the entropy function
let fiboword =
Seq.unfold
(fun (state : string * string) ->
Some (fst state, (snd state, (snd state) + (fst state)))) ("1", "0")
printfn "%3s %10s %10s %s" "#" "Length" "Entropy" "Word (if length < 40)"
Seq.iteri (fun i (s : string) ->
printfn "%3i %10i %10.7g %s" (i+1) s.Length (entropy s) (if s.Length < 40 then s else ""))
(Seq.take 37 fiboword)

36
Task/Fibonacci-word/Factor/fibonacci-word.factor Normal file
View file

@ -0,0 +1,36 @@
USING: assocs combinators formatting kernel math math.functions
math.ranges math.statistics namespaces pair-rocket sequences ;
IN: rosetta-code.fibonacci-word
SYMBOL: 37th-fib-word
: fib ( n -- m )
{
1 => [ 1 ]
2 => [ 1 ]
[ [ 1 - fib ] [ 2 - fib ] bi + ]
} case ;
: fib-word ( n -- seq )
{
1 => [ "1" ]
2 => [ "0" ]
[ [ 1 - fib-word ] [ 2 - fib-word ] bi append ]
} case ;
: nth-fib-word ( n -- seq )
dup 1 =
[ drop "1" ] [ 37th-fib-word get swap fib head ] if ;
: entropy ( seq -- entropy )
[ length ] [ histogram >alist [ second ] map ] bi
[ swap / ] with map
[ dup log 2 log / * ] map-sum
dup 0. = [ neg ] unless ;
37 fib-word 37th-fib-word set
"N" "Length" "Entropy" "%2s %8s %10s\n" printf
37 [1,b] [
dup nth-fib-word [ length ] [ entropy ] bi
"%2d %8d %.8f\n" printf
] each

61
Task/Fibonacci-word/FreeBASIC/fibonacci-word.basic Normal file
View file

@ -0,0 +1,61 @@
' version 25-06-2015
' compile with: fbc -s console
Function calc_entropy(source As String, base_ As Integer) As Double
Dim As Integer i, sourcelen = Len(source), totalchar(255)
Dim As Double prop, entropy
For i = 0 To sourcelen -1
totalchar(source[i]) += 1
Next
For i = 0 To 255
If totalchar(i) = 0 Then Continue For
prop = totalchar(i) / sourcelen
entropy = entropy - (prop * Log (prop) / Log(base_))
Next
Return entropy
End Function
' ------=< MAIN >=------
Dim As String fw1 = "1" , fw2 = "0", fw3
Dim As Integer i, n
Print" N Length Entropy Word"
n = 1
Print Using " ###";n; : Print Using " ###########"; Len(fw1);
Print Using " ##.############### "; calc_entropy(fw1,2);
Print fw1
n = 2
Print Using " ###";n ;: Print Using " ###########"; Len(fw2);
Print Using " ##.############### "; calc_entropy(fw2,2);
Print fw2
For n = 1 To 35
fw1 = "1" : fw2 = "0" ' construct string
For i = 1 To n
fw3 = fw2 + fw1
Swap fw1, fw2 ' swap pointers of fw1 and fw2
Swap fw2, fw3 ' swap pointers of fw2 and fw3
Next
fw1 = "" : fw3 = "" ' free up memory
Print Using " ### ########### ##.############### "; n +2; Len(fw2);_
calc_entropy(fw2, 2);
If Len(fw2) < 55 Then Print fw2 Else Print
Next
Print
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

61
Task/Fibonacci-word/Go/fibonacci-word.go Normal file
View file

@ -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))
}
}

25
Task/Fibonacci-word/Haskell/fibonacci-word.hs Normal file
View file

@ -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")

27
Task/Fibonacci-word/Icon/fibonacci-word.icon Normal file
View file

@ -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

1
Task/Fibonacci-word/J/fibonacci-word-1.j Normal file
View file

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

1
Task/Fibonacci-word/J/fibonacci-word-2.j Normal file
View file

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

38
Task/Fibonacci-word/J/fibonacci-word-3.j Normal file
View file

@ -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

50
Task/Fibonacci-word/Java/fibonacci-word.java Normal file
View file

@ -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 ) );
}
}
}

101
Task/Fibonacci-word/JavaScript/fibonacci-word.js Normal file
View file

@ -0,0 +1,101 @@
//makes outputting a table possible in environments
//that don't support console.table()
function console_table(xs) {
function pad(n,s) {
var res = s;
for (var i = s.length; i < n; i++)
res += " ";
return res;
}
if (xs.length === 0)
console.log("No data");
else {
var widths = [];
var cells = [];
for (var i = 0; i <= xs.length; i++)
cells.push([]);
for (var s in xs[0]) {
var len = s.length;
cells[0].push(s);
for (var i = 0; i < xs.length; i++) {
var ss = "" + xs[i][s];
len = Math.max(len, ss.length);
cells[i+1].push(ss);
}
widths.push(len);
}
var s = "";
for (var x = 0; x < cells.length; x++) {
for (var y = 0; y < widths.length; y++)
s += "|" + pad(widths[y], cells[x][y]);
s += "|\n";
}
console.log(s);
}
}
//returns the entropy of a string as a number
function entropy(s) {
//create an object containing each individual char
//and the amount of iterations per char
function prob(s) {
var h = Object.create(null);
s.split('').forEach(function(c) {
h[c] && h[c]++ || (h[c] = 1);
});
return h;
}
s = s.toString(); //just in case
var e = 0, l = s.length, h = prob(s);
for (var i in h ) {
var p = h[i]/l;
e -= p * Math.log(p) / Math.log(2);
}
return e;
}
//creates Fibonacci Word to n as described on Rosetta Code
//see rosettacode.org/wiki/Fibonacci_word
function fibWord(n) {
var wOne = "1", wTwo = "0", wNth = [wOne, wTwo], w = "", o = [];
for (var i = 0; i < n; i++) {
if (i === 0 || i === 1) {
w = wNth[i];
} else {
w = wNth[i - 1] + wNth[i - 2];
wNth.push(w);
}
var l = w.length;
var e = entropy(w);
if (l <= 21) {
o.push({
N: i + 1,
Length: l,
Entropy: e,
Word: w
});
} else {
o.push({
N: i + 1,
Length: l,
Entropy: e,
Word: "..."
});
}
}
try {
console.table(o);
} catch (err) {
console_table(o);
}
}
fibWord(37);

10
Task/Fibonacci-word/Jq/fibonacci-word-1.jq Normal file
View file

@ -0,0 +1,10 @@
# Input: an array of strings.
# Output: an object with the strings as keys,
# the values of which are the corresponding frequencies.
def counter:
reduce .[] as $item ( {}; .[$item] += 1 ) ;
# entropy in bits of the input string
def entropy:
(explode | map( [.] | implode ) | counter | [ .[] | . * log ] | add) as $sum
| ((length|log) - ($sum / length)) / (2|log) ;

18
Task/Fibonacci-word/Jq/fibonacci-word-2.jq Normal file
View file

@ -0,0 +1,18 @@
# truncate n places after the decimal point;
# return a string since it can readily be converted back to a number
def precision(n):
tostring as $s | $s | index(".")
| if . then $s[0:.+n+1] else $s end ;
# Right-justify but do not truncate
def rjustify(n):
tostring | length as $length
| if n <= $length then . else " " * (n-$length) + . end;
# Attempt to align decimals so integer part is in a field of width n
def align(n):
tostring | index(".") as $ix
| if n < $ix then .
elif $ix then (.[0:$ix]|rjustify(n)) +.[$ix:]
else rjustify(n)
end ;

22
Task/Fibonacci-word/Jq/fibonacci-word-3.jq Normal file
View file

@ -0,0 +1,22 @@
def enumerate(s): foreach s as $x (-1; .+1; [., $x]);
def fibonacci_words:
"1",
(["0","1"]
| recurse([add, .[0]])
| .[0]);
# Generate the first n terms of the Fibonacci word sequence
# as a stream of arrays of the form [index, word] starting with [0,1]
def fibonacci_words($n):
enumerate(limit($n; fibonacci_words));
def task(n):
fibonacci_words(n)
| .[0] as $i
| (.[1]|length) as $len
| (.[1]|entropy) as $e
| "\($i|rjustify(3)) \($len|rjustify(10)) \($e|precision(6))"
;
task(37)

27
Task/Fibonacci-word/Julia/fibonacci-word.julia Normal file
View file

@ -0,0 +1,27 @@
using DataStructures
entropy(s::AbstractString) = -sum(x -> x / length(s) * log2(x / length(s)), values(counter(s)))
function fibboword(n::Int64)
# Initialize the result
r = Array{String}(n)
# First element
r[1] = "0"
# If more than 2, set the second element
if n ≥ 2 r[2] = "1" end
# Recursively create elements > 3
for i in 3:n
r[i] = r[i - 1] * r[i - 2]
end
return r
end
function testfibbo(n::Integer)
fib = fibboword(n)
for i in 1:length(fib)
@printf("%3d%9d%12.6f\n", i, length(fib[i]), entropy(fib[i]))
end
return 0
end
println(" n\tlength\tentropy")
testfibbo(37)

32
Task/Fibonacci-word/Kotlin/fibonacci-word.kotlin Normal file
View file

@ -0,0 +1,32 @@
// version 1.0.6
fun fibWord(n: Int): String {
if (n < 1) throw IllegalArgumentException("Argument can't be less than 1")
if (n == 1) return "1"
val words = Array(n){ "" }
words[0] = "1"
words[1] = "0"
for (i in 2 until n) words[i] = words[i - 1] + words[i - 2]
return words[n - 1]
}
fun log2(d: Double) = Math.log(d) / Math.log(2.0)
fun shannon(s: String): Double {
if (s.length <= 1) return 0.0
val count0 = s.count { it == '0' }
val count1 = s.length - count0
val nn = s.length.toDouble()
return -(count0 / nn * log2(count0 / nn) + count1 / nn * log2(count1 / nn))
}
fun main(args: Array<String>) {
println("N Length Entropy Word")
println("-- -------- ------------------ ----------------------------------")
for (i in 1..37) {
val s = fibWord(i)
print(String.format("%2d %8d %18.16f", i, s.length, shannon(s)))
if (i < 10) println(" $s")
else println()
}
}

35
Task/Fibonacci-word/Lua/fibonacci-word.lua Normal file
View file

@ -0,0 +1,35 @@
-- Return the base two logarithm of x
function log2 (x) return math.log(x) / math.log(2) end
-- Return the Shannon entropy of X
function entropy (X)
local N, count, sum, i = X:len(), {}, 0
for char = 1, N do
i = X:sub(char, char)
if count[i] then
count[i] = count[i] + 1
else
count[i] = 1
end
end
for n_i, count_i in pairs(count) do
sum = sum + count_i / N * log2(count_i / N)
end
return -sum
end
-- Return a table of the first n Fibonacci words
function fibWords (n)
local fw = {1, 0}
while #fw < n do fw[#fw + 1] = fw[#fw] .. fw[#fw - 1] end
return fw
end
-- Main procedure
print("n\tWord length\tEntropy")
for k, v in pairs(fibWords(37)) do
v = tostring(v)
io.write(k .. "\t" .. #v)
if string.len(#v) < 8 then io.write("\t") end
print("\t" .. entropy(v))
end

7
Task/Fibonacci-word/Mathematica/fibonacci-word.math Normal file
View file

@ -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"}}]

32
Task/Fibonacci-word/Nim/fibonacci-word.nim Normal file
View file

@ -0,0 +1,32 @@
import math, strformat, strutils
func entropy(str: string): float =
## return the entropy of a fibword string.
if str.len <= 1: return 0.0
let strlen = str.len.toFloat
let count0 = str.count('0').toFloat
let count1 = strlen - count0
result = -(count0 / strlen * log2(count0 / strlen) + count1 / strlen * log2(count1 / strlen))
iterator fibword(): string =
## Yield the successive fibwords.
var a = "1"
var b = "0"
yield a
yield b
while true:
a = b & a
swap a, b
yield b
when isMainModule:
echo " n length entropy"
echo "————————————————————————————————"
var n = 0
for str in fibword():
inc n
echo fmt"{n:2} {str.len:8} {entropy(str):.16f}"
if n == 37: break

58
Task/Fibonacci-word/Objeck/fibonacci-word.objeck Normal file
View file

@ -0,0 +1,58 @@
use Collection;
class FibonacciWord {
function : native : GetEntropy(result : String) ~ Float {
frequencies := IntMap->New();
each(i : result) {
c := result->Get(i);
if(frequencies->Has(c)) {
count := frequencies->Find(c)->As(IntHolder);
count->Set(count->Get() + 1);
}
else {
frequencies->Insert(c, IntHolder->New(1));
};
};
length := result->Size();
entropy := 0.0;
counts := frequencies->GetValues();
each(i : counts) {
count := counts->Get(i)->As(IntHolder)->Get();
freq := count->As(Float) / length;
entropy += freq * (freq->Log() / 2.0->Log());
};
return -1 * entropy;
}
function : native : PrintLine(n : Int, result : String) ~ Nil {
n->Print();
'\t'->Print();
result->Size()->Print();
"\t\t"->Print();
GetEntropy(result)->PrintLine();
}
function : Main(args : String[]) ~ Nil {
firstString := "1";
n := 1;
PrintLine( n, firstString );
secondString := "0";
n += 1;
PrintLine( n, secondString );
while(n < 37) {
resultString := "{$secondString}{$firstString}";
firstString := secondString;
secondString := resultString;
n += 1;
PrintLine( n, resultString );
};
}
}

13
Task/Fibonacci-word/Oforth/fibonacci-word.fth Normal file
View file

@ -0,0 +1,13 @@
: entropy(s) -- f
| freq sz |
s size dup ifZero: [ return ] asFloat ->sz
ListBuffer initValue(255, 0) ->freq
s apply( #[ dup freq at 1+ freq put ] )
0.0 freq applyIf( #[ 0 <> ], #[ sz / dup ln * - ] ) Ln2 / ;
: FWords(n)
| ws i |
ListBuffer new dup add("1") dup add("0") dup ->ws
3 n for: i [ i 1- ws at i 2 - ws at + ws add ]
dup map(#[ dup size swap entropy Pair new]) apply(#println) ;

51
Task/Fibonacci-word/OoRexx/fibonacci-word.rexx Normal file
View file

@ -0,0 +1,51 @@
/* REXX ---------------------------------------------------------------
* 09.08.2014 Walter Pachl 'copied' from REXX
* lists the # of chars in fibonacci words and the words' entropy
* as well as (part of) the Fibonacci word and the number of 0's and 1's
* Note: ooRexx allows for computing up to 47 Fibonacci words
*--------------------------------------------------------------------*/
Numeric Digits 20 /* use more precision, default=9.*/
Parse Arg n fw.1 fw.2 . /* get optional args from the C.L.*/
If n=='' Then n=50 /* Not specified? Then use default*/
If fw.1=='' Then fw.1=1 /* " " " " " */
If fw.2=='' Then fw.2=0 /* " " " " " */
hdr1=' N length Entropy Fibonacci word ',
'# of zeroes # of ones'
hdr2='-- ---------- ---------------------- --------------------',
'--------- ---------'
Say hdr1
Say hdr2
Do j=1 For n /* display N fibonacci words. */
j1=j-1
j2=j-2
If j>2 Then /* calculate FIBword if we need to*/
fw.j=fw.j1||fw.j2
If length(fw.j)<20 Then
fwd=left(fw.j,20) /* display the Fibonacci word */
Else
fwd=left(fw.j,5)'...'right(fw.j,12) /* display parts thereof */
Say right(j,2)' 'right(length(fw.j),9)' 'entropy(fw.j)' 'fwd,
right(aa.0,9) right(aa.1,9)
End
Say hdr2
Say hdr1
Exit
entropy: Procedure Expose aa.
Parse Arg dd
l=length(dd)
d=digits()
aa.0=l-length(space(translate(dd,,0),0)) /*fast way to count zeroes*/
aa.1=l-aa.0 /* and figure the number of ones. */
If l==1 Then
Return left(0,d+2) /* handle special case of one char*/
s=0 /* [?] calc entropy for each char */
do i=1 for 2
_=i-1 /* construct a chr from the ether.*/
p=aa._/l /* 'probability of aa-_ in fw */
s=s-p*rxmlog(p,d,2) /* add (negatively) the entropies.*/
End
If s=1 Then
Return left(1,d+2) /* return a left-justified "1". */
Return format(s,,d) /* normalize the number (sum or S)*/
::requires rxm.cls

4
Task/Fibonacci-word/PARI-GP/fibonacci-word.parigp Normal file
View file

@ -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))))

24
Task/Fibonacci-word/PL-I/fibonacci-word.pli Normal file
View file

@ -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;

109
Task/Fibonacci-word/Pascal/fibonacci-word.pas Normal file
View file

@ -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.

31
Task/Fibonacci-word/Perl/fibonacci-word.pl Normal file
View file

@ -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
}

28
Task/Fibonacci-word/Phix/fibonacci-word.phix Normal file
View file

@ -0,0 +1,28 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">entropy</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">symbols</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">unique</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">),</span>
<span style="color: #000000;">counts</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">symbols</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">symbols</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">counts</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">H</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">counts</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">ci</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">counts</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]/</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">H</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">ci</span><span style="color: #0000FF;">*</span><span style="color: #7060A8;">log2</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ci</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">H</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">F_words</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"0"</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">3</span> <span style="color: #008080;">to</span> <span style="color: #000000;">37</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">F_words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">F_words</span><span style="color: #0000FF;">,</span><span style="color: #000000;">F_words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]&</span><span style="color: #000000;">F_words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">F_words</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">fi</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">F_words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%2d: length %9d, entropy %f %s\n"</span><span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fi</span><span style="color: #0000FF;">),</span><span style="color: #000000;">entropy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fi</span><span style="color: #0000FF;">),</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;"><</span><span style="color: #000000;">10</span><span style="color: #0000FF;">?</span><span style="color: #000000;">fi</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"..."</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--

24
Task/Fibonacci-word/Picat/fibonacci-word.picat Normal file
View file

@ -0,0 +1,24 @@
go =>
foreach(N in 1..37)
F = fib(N),
E = entropy(F),
if N <= 10 then
printf("%3d %10d %0.16f %w\n",N,length(F),E,F)
else
printf("%3d %10d %0.16f\n",N,length(F),E)
end
end,
nl.
table
fib(1) = "1".
fib(2) = "0".
fib(N) = fib(N-1) ++ fib(N-2).
entropy(L) = Entropy =>
Len = L.len,
Occ = new_map(),
foreach(E in L)
Occ.put(E, Occ.get(E,0) + 1)
end,
Entropy = -sum([P2*log2(P2) : _C=P in Occ, P2 = P/Len]).

35
Task/Fibonacci-word/PureBasic/fibonacci-word.basic Normal file
View file

@ -0,0 +1,35 @@
EnableExplicit
Define fwx$, n.i
NewMap uchar.i()
Macro RowPrint(ns,ls,es,ws)
Print(RSet(ns,4," ")+RSet(ls,12," ")+" "+es+" ") : If Len(ws)<55 : PrintN(ws) : Else : PrintN("...") : EndIf
EndMacro
Procedure.d nlog2(x.d) : ProcedureReturn Log(x)/Log(2) : EndProcedure
Procedure countchar(s$, Map uchar())
If Len(s$)
uchar(Left(s$,1))=CountString(s$,Left(s$,1)) : s$=RemoveString(s$,Left(s$,1))
ProcedureReturn countchar(s$, uchar())
EndIf
EndProcedure
Procedure.d ce(fw$)
Define e.d
Shared uchar()
countchar(fw$,uchar())
ForEach uchar() : e-uchar()/Len(fw$)*nlog2(uchar()/Len(fw$)) : Next
ProcedureReturn e
EndProcedure
Procedure.s fw(n.i,a$="0",b$="1",m.i=2)
Select n : Case 1 : ProcedureReturn a$ : Case 2 : ProcedureReturn b$ : EndSelect
If m<n : ProcedureReturn fw(n,b$+a$,a$,m+1) : EndIf
ProcedureReturn Mid(a$,3)+ReverseString(Left(a$,2))
EndProcedure
OpenConsole()
PrintN(" N Length Entropy Word")
For n=1 To 37 : fwx$=fw(n) : RowPrint(Str(n),Str(Len(fwx$)),StrD(ce(fwx$),15),fwx$) : Next
Input()

58
Task/Fibonacci-word/Python/fibonacci-word.py Normal file
View file

@ -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>
>>>

31
Task/Fibonacci-word/R/fibonacci-word.r Normal file
View file

@ -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)
}

37
Task/Fibonacci-word/REXX/fibonacci-word.rexx Normal file
View file

@ -0,0 +1,37 @@
/*REXX program displays the number of chars in a fibonacci word, and the word's entropy.*/
d= 21; de= d + 6; numeric digits de /*use more precision (the default is 9)*/
parse arg N . /*get optional argument from the C.L. */
if N=='' | N=="," then N= 42 /*Not specified? Then use the default.*/
say center('N', 3) center("length", de) center('entropy', de) center("Fib word", 56)
say copies('─', 3) copies("─" , de) copies('─' , de) copies("─" , 56)
c= 1 /*initialize the 1st value for entropy.*/
do j=1 for N /* [↓] display N fibonacci words. */
if j==2 then c= 0 /*test for the case of J equals 2. */
if j==3 then parse value 1 0 with a b /* " " " " " " " 3. */
if j>2 then c= b || a /*calculate the FIBword if we need to.*/
L= length(c) /*find the length of the fib─word C. */
if L<56 then Fw= c
else Fw= '{the word is too wide to display}'
say right(j, 2) right( commas(L), de) ' ' entropy() " " Fw
a= b; b= c /*define the new values for A and B.*/
end /*j*/ /*display text msg; */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
entropy: if L==1 then return left(0, d + 2) /*handle special case of one character.*/
!.0= length(space(translate(c,, 1), 0)) /*efficient way to count the "zeroes".*/
!.1= L - !.0; $= 0 /*define 1st fib─word; initial entropy.*/
do i=1 for 2; _= i - 1 /*construct character from the ether. */
$= $ - !._ / L * log2(!._ / L) /*add (negatively) the entropies. */
end /*i*/
if $=1 then return left(1, d+2) /*return a left─justified "1" (one). */
return format($, , d) /*normalize the sum (S) number. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
log2: procedure; parse arg x 1 xx; ig=x>1.5; is=1-2*(ig\==1); numeric digits 5+digits()
e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759
m=0; 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; m=m+is*2**j; end /*while*/; x=x* e** -m -1; z=0; _=-1; p=z
do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/
r=z+m; if arg()==2 then return r; return r / log2(2,.)

62
Task/Fibonacci-word/Racket/fibonacci-word-1.rkt Normal file
View file

@ -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" _ _ _)))

32
Task/Fibonacci-word/Racket/fibonacci-word-2.rkt Normal file
View file

@ -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" _ _ _)))

11
Task/Fibonacci-word/Raku/fibonacci-word-1.raku Normal file
View file

@ -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 ?? '' !! $_;
}

19
Task/Fibonacci-word/Raku/fibonacci-word-2.raku Normal file
View file

@ -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];
}

51
Task/Fibonacci-word/Ring/fibonacci-word.ring Normal file
View file

@ -0,0 +1,51 @@
# Project : Fibonacci word
fw1 = "1"
fw2 = "0"
see "N Length Entropy Word" + nl
n = 1
see "" + n + " " + len(fw1) + " " + calcentropy(fw1,2) + " " + fw1 + nl
n = 2
see "" + n + " " + len(fw2) + " " + calcentropy(fw2,2) + " " + fw2 + nl
for n = 1 to 55
fw3 = fw2 + fw1
temp = fw2
fw2 = fw3
fw1 = temp
if len(fw3) < 55
see "" + (n+2) + " " + len(fw3) + " " + calcentropy(fw3,2) + " " + fw3 + nl
ok
next
func calcentropy(source,b)
decimals(11)
entropy = 0
countOfChar = list(255)
charCount =len( source)
usedChar =""
for i =1 to len( source)
ch =substr(source, i, 1)
if not(substr( usedChar, ch))
usedChar =usedChar +ch
ok
j =substr( usedChar, ch)
countOfChar[j] =countOfChar[j] +1
next
l =len(usedChar)
for i =1 to l
probability =countOfChar[i] /charCount
entropy =entropy - (probability *logBase(probability, 2))
next
return entropy
func swap(a, b)
temp = a
a = b
b = temp
return [a, b]
func logBase (x, b)
logBase =log( x) /log( 2)
return logBase

24
Task/Fibonacci-word/Ruby/fibonacci-word.rb Normal file
View file

@ -0,0 +1,24 @@
#encoding: ASCII-8BIT
def entropy(s)
counts = Hash.new(0.0)
s.each_char { |c| counts[c] += 1 }
leng = s.length
counts.values.reduce(0) do |entropy, count|
freq = count / leng
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 %9s %15s %s' % %w[N Length Entropy Fibword]
words.each.with_index(1) do |word, i|
puts '%3i %9i %15.12f %s' % [i, word.length, entropy(word), word.length<60 ? word : '<too long>']
end

46
Task/Fibonacci-word/Rust/fibonacci-word.rust Normal file
View file

@ -0,0 +1,46 @@
struct Fib<T> {
curr: T,
next: T,
}
impl<T> Fib<T> {
fn new(curr: T, next: T) -> Self {
Fib { curr: curr, next: next, }
}
}
impl Iterator for Fib<String> {
type Item = String;
fn next(&mut self) -> Option<Self::Item> {
let ret = self.curr.clone();
self.curr = self.next.clone();
self.next = format!("{}{}", ret, self.next);
Some(ret)
}
}
fn get_entropy(s: &[u8]) -> f64 {
let mut entropy = 0.0;
let mut histogram = [0.0; 256];
for i in 0..s.len() {
histogram.get_mut(s[i] as usize).map(|v| *v += 1.0);
}
for i in 0..256 {
if histogram[i] > 0.0 {
let ratio = histogram[i] / s.len() as f64;
entropy -= ratio * ratio.log2();
}
}
entropy
}
fn main() {
let f = Fib::new("1".to_string(), "0".to_string());
println!("{:10} {:10} {:10} {:60}", "N", "Length", "Entropy", "Word");
for (i, s) in f.take(37).enumerate() {
let word = if s.len() > 60 {"Too long"} else {&*s};
println!("{:10} {:10} {:.10} {:60}", i + 1, s.len(), get_entropy(&s.bytes().collect::<Vec<_>>()), word);
}
}

17
Task/Fibonacci-word/Scala/fibonacci-word.scala Normal file
View file

@ -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"))

42
Task/Fibonacci-word/Scheme/fibonacci-word.ss Normal file
View file

@ -0,0 +1,42 @@
(import (scheme base)
(scheme inexact)
(scheme write))
(define *words* (make-vector 38 ""))
(define (create-words)
(vector-set! *words* 1 "1")
(vector-set! *words* 2 "0")
(do ((i 3 (+ 1 i)))
((= i (vector-length *words*)) )
(vector-set! *words* i (string-append (vector-ref *words* (- i 1))
(vector-ref *words* (- i 2))))))
;; in this context, word only contains 1 or 0
(define (entropy word)
(let* ((N (string-length word))
(num-ones 0)
(num-zeros 0))
(string-for-each (lambda (c)
(if (char=? c #\1)
(set! num-ones (+ 1 num-ones))
(set! num-zeros (+ 1 num-zeros))))
word)
(if (or (zero? num-ones) (zero? num-zeros))
0
(- 0
(* (/ num-ones N) (log (/ num-ones N) 2))
(* (/ num-zeros N) (log (/ num-zeros N) 2))))))
;; display values
(create-words)
(do ((i 1 (+ 1 i)))
((= i (vector-length *words*)) )
(display (string-append (number->string i)
" "
(number->string
(string-length (vector-ref *words* i)))
" "
(number->string
(entropy (vector-ref *words* i)))
"\n")))

31
Task/Fibonacci-word/Scilab/fibonacci-word-1.scilab Normal file
View file

@ -0,0 +1,31 @@
exec('.\entropy.sci',0);
function word=fiboword(n)
word_1 = '1'; word_2 = '0';
select n
case 1
word = word_1
case 2
word = word_2;
case 3
word = strcat([word_2 word_1]);
else
word = strcat([fiboword(n-1) fiboword(n-2)])
end
endfunction
final_length = 37;
N=[1:final_length]';
char_length = zeros(N);
entropies = zeros(N);
tic();
for i=1:final_length
word = fiboword(i);
char_length(i) = length(word);
entropies(i) = entropy(word);
end
time = toc();
disp('EXECUTION TIME: '+string(time)+'s.');
disp(['N', 'LENGTH', 'ENTROPY'; string([N char_length entropies])]);

33
Task/Fibonacci-word/Scilab/fibonacci-word-2.scilab Normal file
View file

@ -0,0 +1,33 @@
exec('.\entropy.sci',0);
final_length = 37;
word_n = '';
word_n_1 = '';
word_n_2 = '';
N = [1:final_length]';
word_length = zeros(N);
entropies = zeros(N);
tic();
for i = 1:final_length
if i == 1 then
word_n = '1';
elseif i == 2
word_n = '0';
elseif i == 3
word_n = '01';
word_n_1 = '0';
else
word_n_2 = word_n_1;
word_n_1 = word_n;
word_n = word_n_1 + word_n_2;
end
word_length(i) = length(word_n);
entropies(i) = entropy(word_n);
end
time = toc();
disp('EXECUTION TIME: '+string(time)+'s.');
disp(['N', 'LENGTH', 'ENTROPY'; string([N word_length entropies])]);

53
Task/Fibonacci-word/Seed7/fibonacci-word.seed7 Normal file
View file

@ -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;

22
Task/Fibonacci-word/Sidef/fibonacci-word.sidef Normal file
View file

@ -0,0 +1,22 @@
func entropy(s) {
[0] + (s.chars.freq.values »/» s.len) -> reduce { |a,b|
a - b*b.log2
}
}
var n_max = 37
var words = ['1', '0']
{
words.append(words[-1] + words[-2])
} * (n_max - words.len)
say ('%3s %10s %15s %s' % <N Length Entropy Fibword>...)
for i in ^words {
var word = words[i]
say ('%3i %10i %15.12f %s' % (i+1,
word.len,
entropy(word),
word.len<30 ? word : '<too long>'))
}

42
Task/Fibonacci-word/Swift/fibonacci-word.swift Normal file
View file

@ -0,0 +1,42 @@
import Foundation
struct Fib: Sequence, IteratorProtocol {
private var cur: String
private var nex: String
init(cur: String, nex: String) {
self.cur = cur
self.nex = nex
}
mutating func next() -> String? {
let ret = cur
cur = nex
nex = "\(ret)\(nex)"
return ret
}
}
func getEntropy(_ s: [Int]) -> Double {
var entropy = 0.0
var hist = Array(repeating: 0.0, count: 256)
for i in 0..<s.count {
hist[s[i]] += 1
}
for i in 0..<256 where hist[i] > 0 {
let rat = hist[i] / Double(s.count)
entropy -= rat * log2(rat)
}
return entropy
}
for (i, str) in Fib(cur: "1", nex: "0").prefix(37).enumerated() {
let ent = getEntropy(str.map({ Int($0.asciiValue!) }))
print("i: \(i) len: \(str.count) entropy: \(ent)")
}

28
Task/Fibonacci-word/Tcl/fibonacci-word.tcl Normal file
View file

@ -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
}

40
Task/Fibonacci-word/Wren/fibonacci-word.wren Normal file
View file

@ -0,0 +1,40 @@
import "/fmt" for Fmt
var entropy = Fn.new { |s|
var m = {}
for (c in s) {
var d = m[c]
m[c] = (d) ? d + 1 : 1
}
var hm = 0
for (k in m.keys) {
var c = m[k]
hm = hm + c * c.log2
}
var l = s.count
return l.log2 - hm/l
}
var fibWord = Fn.new { |n|
if (n < 2) return n.toString
var a = "1"
var b = "0"
var i = 3
while (i <= n) {
var c = b + a
a = b
b = c
i = i + 1
}
return b
}
Fmt.print("$2s $10s $10m $s", "n", "Length", "Entropy", "Fib word")
for (i in 1..37) {
var fw = fibWord.call(i)
if (i < 10) {
Fmt.print("$2d $,10d $0.8f $s", i, fw.count, entropy.call(fw), fw)
} else {
Fmt.print("$2d $,10d $0.8f $s", i, fw.count, entropy.call(fw), Fmt.abbreviate(20, fw))
}
}

35
Task/Fibonacci-word/ZX-Spectrum-Basic/fibonacci-word.basic Normal file
View file

@ -0,0 +1,35 @@
10 LET x$="1": LET y$="0": LET z$=""
20 PRINT "N, Length, Entropy, Word"
30 LET n=1
40 PRINT n;" ";LEN x$;" ";
50 LET s$=x$: LET base=2: GO SUB 1000
60 PRINT entropy
70 PRINT x$
80 LET n=2
90 PRINT n;" ";LEN y$;" ";
100 LET s$=y$: GO SUB 1000
110 PRINT entropy
120 PRINT y$
130 FOR n=1 TO 18
140 LET x$="1": LET y$="0"
150 FOR i=1 TO n
160 LET z$=y$+x$
170 LET p$=x$: LET x$=y$: LET y$=p$
180 LET p$=y$: LET y$=z$: LET z$=p$
190 NEXT i
200 LET x$="": LET z$=""
210 LET s$=y$: GO SUB 1000
220 PRINT n+2;" ";LEN y$;" ";entropy
230 PRINT y$ AND (LEN y$<32)
240 NEXT n
250 STOP
1000 REM Calculate entropy
1010 LET sourcelen=LEN s$: LET entropy=0
1020 DIM t(255)
1030 FOR j=1 TO sourcelen
1040 LET digit=VAL s$(j)+1: LET t(digit)=t(digit)+1
1050 NEXT j
1060 FOR j=1 TO 255
1070 IF t(j)>0 THEN LET prop=t(j)/sourcelen: LET entropy=entropy-(prop*LN (prop)/LN (base))
1080 NEXT j
1090 RETURN

14
Task/Fibonacci-word/Zkl/fibonacci-word.zkl Normal file
View file

@ -0,0 +1,14 @@
fcn entropy(bs){ //binary String-->Float
len:=bs.len(); num1s:=(bs-"0").len();
T(num1s,len-num1s).filter().apply('wrap(p){ p=p.toFloat()/len; -p*p.log() })
.sum(0.0) / (2.0).log();
}
" N Length Entropy Fibword".println();
ws:=L("1","0");
foreach n in ([1..37]){
if(n>2) ws.append(ws[-1]+ws[-2]);
w:=ws[-1];
"%3d %10d %2.10f %s".fmt(n,w.len(),entropy(w),
w.len()<50 and w or "<too long>").println();
}