10 LET items=100: LET filtered=0
20 DIM a(items)
30 FOR i=1 TO items
40 LET a(i)=INT (RND*items)
50 NEXT i
60 FOR i=1 TO items
70 IF FN m(a(i),2)=0 THEN LET filtered=filtered+1: LET a(filtered)=a(i)
80 NEXT i
90 DIM b(filtered)
100 FOR i=1 TO filtered
110 LET b(i)=a(i): PRINT b(i);" ";
120 NEXT i
130 DIM a(1): REM To free memory (well, almost all)
140 DEF FN m(a,b)=a-INT (a/b)*b


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


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;


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


F is_ext(file_name, extensions)
   R any(extensions.map(e -> @file_name.lowercase().ends_with(‘.’e.lowercase())))

F test(file_names, extensions)
   L(file_name) file_names
      print(file_name.ljust(max(file_names.map(f_n -> f_n.len)))‘ ’String(is_ext(file_name, extensions)))

test([‘MyData.a##’, ‘MyData.tar.Gz’, ‘MyData.gzip’, ‘MyData.7z.backup’, ‘MyData...’, ‘MyData’], [‘zip’, ‘rar’, ‘7z’, ‘gz’, ‘archive’, ‘A##’, ‘tar.bz2’])
test([‘MyData_v1.0.tar.bz2’, ‘MyData_v1.0.bz2’], [‘tar.bz2’])


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


DEFINE PTR="CARD"

CHAR FUNC ToLower(CHAR c)
  IF c>='A AND c<='Z THEN
    c==+'a-'A
  FI
RETURN (c)

BYTE FUNC CheckExt(CHAR ARRAY file,ext)
  BYTE i,j
  CHAR c1,c2

  i=file(0) j=ext(0)
  IF i<j THEN RETURN (0) FI

  WHILE j>0
  DO
    c1=ToLower(file(i))
    c2=ToLower(ext(j))
    IF c1#c2 THEN RETURN (0) FI
    i==-1
    j==-1
  OD
  IF file(i)#'. THEN
    RETURN (0)
  FI
RETURN (1)

BYTE FUNC Check(CHAR ARRAY file PTR ARRAY exts BYTE count)
  BYTE i

  FOR i=0 TO count-1
  DO
    IF CheckExt(file,exts(i)) THEN
      RETURN (1)
    FI
  OD
RETURN (0)

PROC Main()
  PTR ARRAY exts(7),files(8)
  BYTE i

  exts(0)="zip"
  exts(1)="rar"
  exts(2)="7z"
  exts(3)="gz"
  exts(4)="archive"
  exts(5)="A##"
  exts(6)="tar.bz2"

  files(0)="MyData.a##"
  files(1)="MyData.tar.Gz"
  files(2)="MyData.gzip"
  files(3)="MyData.7z.backup"
  files(4)="MyData..."
  files(5)="MyData"
  files(6)="MyData_v1.0.tar.bz2"
  files(7)="MyData_v1.0.bz2"

  FOR i=0 to 7
  DO
    Print(files(i)) Print(" -> ")
    IF Check(files(i),exts,7) THEN
      PrintE("true")
    ELSE
      PrintE("false")
    FI
  OD
RETURN


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


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


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
}


with Ada.Text_IO;                              use Ada.Text_IO;
with Ada.Strings.Fixed.Equal_Case_Insensitive; use Ada.Strings.Fixed;
with Ada.Strings.Bounded;

procedure Main is

   package B_String is new Ada.Strings.Bounded.Generic_Bounded_Length (30);
   use B_String;
   function is_equal (left, right : String) return Boolean renames
     Ada.Strings.Fixed.Equal_Case_Insensitive;

   type extension_list is array (Positive range <>) of Bounded_String;
   Ext_List : extension_list :=
     (To_Bounded_String ("zip"), To_Bounded_String ("rar"),
      To_Bounded_String ("7z"), To_Bounded_String ("gz"),
      To_Bounded_String ("archive"), To_Bounded_String ("A##"),
      To_Bounded_String ("tar.bz2"));
   type filename_list is array (Positive range <>) of Bounded_String;
   fnames : filename_list :=
     (To_Bounded_String ("MyData.a##"), To_Bounded_String ("MyData.tar.Gz"),
      To_Bounded_String ("MyData.gzip"), To_Bounded_String ("MyData..."),
      To_Bounded_String ("Mydata"), To_Bounded_String ("MyData_V1.0.tar.bz2"),
      To_Bounded_String ("MyData_v1.0.bz2"));
   Valid_Extension : Boolean;
begin
   for name of fnames loop
      Valid_Extension := False;
      Put (To_String (name));
      for ext of Ext_List loop
         declare
            S : String := "." & To_String (ext);
            T : String := Tail (Source => To_String (name), Count => S'Length);
         begin
            if is_equal (S, T) then
               Valid_Extension := True;
            end if;
         end;
      end loop;
      Set_Col (22);
      Put_Line (": " & Valid_Extension'Image);
   end loop;
end Main;


# returns the length of str                                         #
OP   LENGTH = ( STRING str )INT: ( UPB str - LWB str ) + 1;
# returns TRUE if str ends with ending FALSE otherwise              #
PRIO ENDSWITH = 9;
OP   ENDSWITH = ( STRING str, STRING ending )BOOL:
     IF  INT str length    = LENGTH str;
         INT ending length = LENGTH ending;
         ending length > str length
     THEN
         # the ending is longer than the string                     #
         FALSE
     ELSE
         # the string is at least as long as the ending             #
         str[ ( str length - ending length ) + 1 : AT 1 ] = ending
     FI # ENDSWITH # ;
# returns str cnverted to upper case                                #
OP   TOUPPER   = ( STRING str )STRING:
     BEGIN
        STRING result := str;
        FOR s pos FROM LWB result TO UPB result DO
            result[ s pos ] := to upper( result[ s pos ] )
        OD;
        result
     END # TOUPPER # ;
# tests whether file name has one of the extensions and returns     #
# the index of the extension in extensions or LWB extensions - 1    #
# if it does not end with one of the extensions                     #
# the tests are not case-sensitive                                  #
PROC has extension in list = ( STRING file name, []STRING extensions )INT:
     BEGIN
        INT    extension number := LWB extensions - 1;
        STRING upper name        = TOUPPER file name;
        FOR pos FROM LWB extensions TO UPB extensions WHILE extension number < LWB extensions DO
            IF upper name ENDSWITH ( "." + TOUPPER extensions[ pos ] )
            THEN
                # found the extension                              #
                extension number := pos
            FI
        OD;
        extension number
     END # has extension # ;
# test the has extension in list procedure                          #
PROC test has extension in list = ( STRING file name, []STRING extensions, BOOL expected result )VOID:
     IF INT extension number = has extension in list( file name, extensions );
        extension number < LWB extensions
     THEN
        # the file does not have one of the extensions              #
        print( ( file name
               , " does not have an extension in the list "
               , IF expected result THEN "NOT AS EXPECTED" ELSE "" FI
               , newline
               )
             )
     ELSE
        # the file does have one of the extensions                  #
        print( ( file name
               , " has extension """
               , extensions[ extension number ]
               , """ "
               , IF NOT expected result THEN "NOT AS EXPECTED" ELSE "" FI
               , newline
               )
             )
     FI # test has extension in list # ;
# the extensions for the task                                       #
[]STRING task extensions = ( "zip", "rar", "7z", "gz", "archive", "A##" );
# test the file names in the standard task                          #
test has extension in list( "MyData.a##",          task extensions, TRUE  );
test has extension in list( "MyData.tar.Gz",       task extensions, TRUE  );
test has extension in list( "MyData.gzip",         task extensions, FALSE );
test has extension in list( "MyData.7z.backup",    task extensions, FALSE );
test has extension in list( "MyData...",           task extensions, FALSE );
test has extension in list( "MyData",              task extensions, FALSE );
# the extensions for the extra credit                               #
[]STRING ec extensions = ( "zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2" );
# test the file names in the extra credit                           #
test has extension in list( "MyData_v1.0.tar.bz2", ec extensions,   TRUE  );
test has extension in list( "MyData_v1.0.bz2",     ec extensions,   FALSE )


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


fileExtensions: map ["zip" "rar" "7z" "gz" "archive" "A##"] => ["." ++ lower]

hasExtension?: function [file][
    in? extract.extension lower file
        fileExtensions
]

files: ["MyData.a##" "MyData.tar.Gz" "MyData.gzip" "MyData.7z.backup" "MyData..." "MyData"]

loop files 'file ->
    print [file "=> hasExtension?:" hasExtension? file]


# syntax: GAWK -f FILE_EXTENSION_IS_IN_EXTENSIONS_LIST.AWK
BEGIN {
    n = split("zip,rar,7z,gz,archive,A##,tar.bz2", arr, ",")
    for (i=1; i<=n; i++) {
      ext_arr[tolower(arr[i])] = ""
    }
    filenames = "MyData.a##,MyData.tar.Gz,MyData.gzip,MyData.7z.backup,MyData...,MyData,MyData_v1.0.tar.bz2,MyData_v1.0.bz2"
    n = split(filenames, fn_arr, ",")

    for (i=1; i<=n; i++) {
      ext_found = ""
      for (ext in ext_arr) {
        if (tolower(fn_arr[i]) ~ (".*\\." ext "$")) {
          ext_found = ext
          break
        }
      }
      ans = (ext_found == "") ? "is not in list" : ("is in list: " ext_found)
      printf("%s extension %s\n", fn_arr[i], ans)
    }
    exit(0)
}


arraybase 1
dim extensions$ = {".zip", ".rar", ".7z", ".gz", ".archive", ".a##", ".tar.bz2"}

dim filenames$ = {"MyData.a##", "MyData.tar.gz", "MyData.gzip", "MyData.7z.backup", "MyData...", "MyData", "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2"}

#dim as integer n, m
#dim as boolean flag

for n = 1 to filenames$[?]
	flag = False
	for m = 1 to extensions$[?]
		if right(filenames$[n], length(extensions$[m])) = extensions$[m] then
			flag = True
			print filenames$[n]; " -> "; extensions$[m]; " -> "; " true"
			exit for
		end if
	next m
	if flag = False then print filenames$[n]; " -> "; "false"
next n
end


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


@echo off
setlocal enabledelayedexpansion

set "extensions=.zip .rar .7z .gz .archive .A##"

:loop
if "%~1"=="" exit /b
set onlist=0

for %%i in (%extensions%) do if /i "%~x1"=="%%i" set onlist=1

if %onlist%==1 (
  echo Filename: "%~1" ^| Extension: "%~x1" ^| TRUE
) else (
  echo Filename: "%~1" ^| Extension: "%~x1" ^| FALSE
)

shift
goto loop


/*
 * File extension is in extensions list (dots allowed).
 *
 * This problem is trivial because the so-called extension is simply the end
 * part of the name.
 */

#define _CRT_SECURE_NO_WARNINGS

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <locale.h>
#include <string.h>

#ifdef _Bool
#include <stdbool.h>
#else
#define bool int
#define true  1
#define false 0
#endif

/*
 * The implemented algorithm is not the most efficient one: for N extensions
 * of length M it has the cost O(N * M).
 */
int checkFileExtension(char* fileName, char* fileExtensions)
{
    char* fileExtension = fileExtensions;

    if ( *fileName )
    {
        while ( *fileExtension )
        {
            int fileNameLength = strlen(fileName);
            int extensionLength = strlen(fileExtension);
            if ( fileNameLength >= extensionLength )
            {
                char* a = fileName + fileNameLength - extensionLength;
                char* b = fileExtension;
                while ( *a && toupper(*a++) == toupper(*b++) )
                    ;
                if ( !*a )
                    return true;
            }
            fileExtension += extensionLength + 1;
        }
    }
    return false;
}

void printExtensions(char* extensions)
{
    while( *extensions )
    {
        printf("%s\n", extensions);
        extensions += strlen(extensions) + 1;
    }
}

bool test(char* fileName, char* extension, bool expectedResult)
{
    bool result = checkFileExtension(fileName,extension);
    bool returnValue = result == expectedResult;
    printf("%20s  result: %-5s  expected: %-5s  test %s\n",
        fileName,
        result         ? "true"   : "false",
        expectedResult ? "true"   : "false",
        returnValue    ? "passed" : "failed" );
    return returnValue;
}

int main(void)
{
    static char extensions[] = ".zip\0.rar\0.7z\0.gz\0.archive\0.A##\0.tar.bz2\0";

    setlocale(LC_ALL,"");

    printExtensions(extensions);
    printf("\n");

    if ( test("MyData.a##",         extensions,true )
    &&   test("MyData.tar.Gz",      extensions,true )
    &&   test("MyData.gzip",        extensions,false)
    &&   test("MyData.7z.backup",   extensions,false)
    &&   test("MyData...",          extensions,false)
    &&   test("MyData",             extensions,false)
    &&   test("MyData_v1.0.tar.bz2",extensions,true )
    &&   test("MyData_v1.0.bz2",    extensions,false)
    &&   test("filename",           extensions,false)
    )
        printf("\n%s\n", "All tests passed.");
    else
        printf("\n%s\n", "Last test failed.");

    printf("\n%s\n", "press enter");
    getchar();
    return 0;
}


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


#include <algorithm>
#include <cctype>
#include <iomanip>
#include <iostream>
#include <string>
#include <vector>

bool endsWithIgnoreCase(const std::string& str, const std::string& suffix) {
    const size_t n1 = str.length();
    const size_t n2 = suffix.length();
    if (n1 < n2)
        return false;
    return std::equal(str.begin() + (n1 - n2), str.end(), suffix.begin(),
        [](char c1, char c2) {
            return std::tolower(static_cast<unsigned char>(c1))
                == std::tolower(static_cast<unsigned char>(c2));
    });
}

bool filenameHasExtension(const std::string& filename,
                          const std::vector<std::string>& extensions) {
    return std::any_of(extensions.begin(), extensions.end(),
        [&filename](const std::string& extension) {
            return endsWithIgnoreCase(filename, "." + extension);
    });
}

void test(const std::string& filename,
          const std::vector<std::string>& extensions) {
    std::cout << std::setw(20) << std::left << filename
        << ": " << std::boolalpha
        << filenameHasExtension(filename, extensions) << '\n';
}

int main() {
    const std::vector<std::string> extensions{"zip", "rar", "7z",
        "gz", "archive", "A##", "tar.bz2"};
    test("MyData.a##", extensions);
    test("MyData.tar.Gz", extensions);
    test("MyData.gzip", extensions);
    test("MyData.7z.backup", extensions);
    test("MyData...", extensions);
    test("MyData", extensions);
    test("MyData_v1.0.tar.bz2", extensions);
    test("MyData_v1.0.bz2", extensions);
    return 0;
}


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


% 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


(defn matches-extension [ext s]
  (re-find (re-pattern (str "\\." ext "$"))
           (clojure.string/lower-case s)))

(defn matches-extension-list [ext-list s]
  (some #(matches-extension % s) ext-list))


import std.stdio;
import std.string;
import std.range;
import std.algorithm;

void main()
{
  auto exts = ["zip", "rar", "7z", "gz", "archive", "A##"];
  auto filenames = ["MyData.a##",
                    "MyData.tar.Gz",
                    "MyData.gzip",
                    "MyData.7z.backup",
                    "MyData...",
                    "MyData"];

  writeln("extensions: ", exts);
  writeln;

  foreach(filename; filenames)
  {
    string extension = filename.drop(filename.lastIndexOf(".") + 1).toLower;

    bool found;
    foreach(ext; exts)
    {
      if (extension == ext.toLower)
      {
        found = true;
        break;
      }
    }

    writeln(filename, " : ", found);
  }


program File_extension_is_in_extensions_list;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

const
  exts: TArray<string> = ['zip', 'rar', '7z', 'gz', 'archive', 'A##', 'tar.bz2'];
  filenames: TArray<string> = ['MyData.a##', 'MyData.tar.Gz', 'MyData.gzip',
    'MyData.7z.backup', 'MyData...', 'MyData', 'MyData_v1.0.tar.bz2', 'MyData_v1.0.bz2'];

begin
  write('extensions: [');
  for var ext in exts do
  begin
    write(ext, ' ');
  end;
  writeln(']'#10);

  for var filename in filenames do
  begin
    var found := false;
    for var ext in exts do
      if (filename.toLower.endsWith('.' + ext.toLower)) then
      begin
        found := True;
        Break;
      end;
    writeln(filename: 20, ' : ', found);
  end;

  readln;
end.


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


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


USING: formatting kernel qw sequences splitting unicode ;
IN: rosetta-code.file-extension-list

CONSTANT: extensions qw{ zip rar 7z gz archive A## tar.bz2 }
CONSTANT: filenames qw{
    MyData.a## MyData.tar.Gz MyData.gzip MyData.7z.backup
    MyData... MyData MyData_v1.0.tar.bz2 MyData_v1.0.bz2
}

: ext-in-list? ( filename list -- ? )
    [ >lower "." split ] dup [ map ] curry bi*
    [ tail? t = ] with find nip >boolean ;

extensions "List of file extensions: %[%s, %]\n\n" printf
"File extension in extensions list?\n" printf
filenames [
    dup extensions ext-in-list? "%19s  %u\n" printf
] each


        IT = ICHAR(TEXT(I:I)) - ICHAR("a")	!More symbols precede "a" than "A".
        IF (IT.GE.0 .AND. IT.LE.25) TEXT(I:I) = CHAR(IT + ICHAR("A"))	!In a-z? Convert!


package main

import (
    "fmt"
    "strings"
)

var extensions = []string{"zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"}

func fileExtInList(filename string) (bool, string) {
    filename2 := strings.ToLower(filename)
    for _, ext := range extensions {
        ext2 := "." + strings.ToLower(ext)
        if strings.HasSuffix(filename2, ext2) {
            return true, ext
        }
    }
    s := strings.Split(filename, ".")
    if len(s) > 1 {
        t := s[len(s)-1]
        if t != "" {
            return false, t
        } else {
            return false, "<empty>"
        }
    } else {
        return false, "<none>"
    }
}

func main() {
    fmt.Println("The listed extensions are:")
    fmt.Println(extensions, "\n")
    tests := []string{
        "MyData.a##", "MyData.tar.Gz", "MyData.gzip",
        "MyData.7z.backup", "MyData...", "MyData",
        "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2",
    }
    for _, test := range tests {
        ok, ext := fileExtInList(test)
        fmt.Printf("%-20s => %-5t  (extension = %s)\n", test, ok, ext)
    }
}


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


import Data.List
import qualified Data.Char as Ch

toLower :: String -> String
toLower = map Ch.toLower

isExt :: String -> [String] -> Bool
isExt filename extensions = any (`elem` (tails . toLower $ filename)) $ map toLower extensions


isSuffix=: -~&# = {:@[email protected]
isExt=: ('.'&,&.>@[ ([: +./ isSuffix&([email protected]>)/) [email protected]])


import java.util.Arrays;
import java.util.Comparator;

public class FileExt{
	public static void main(String[] args){
		String[] tests = {"text.txt", "text.TXT", "test.tar.gz", "test/test2.exe", "test\\test2.exe", "test", "a/b/c\\d/foo"};
		String[] exts = {".txt",".gz","",".bat"};

		System.out.println("Extensions: " + Arrays.toString(exts) + "\n");

		for(String test:tests){
			System.out.println(test +": " + extIsIn(test, exts));
		}
	}

	public static boolean extIsIn(String test, String... exts){
		int lastSlash = Math.max(test.lastIndexOf('/'), test.lastIndexOf('\\')); //whichever one they decide to use today
		String filename = test.substring(lastSlash + 1);//+1 to get rid of the slash or move to index 0 if there's no slash

		//end of the name if no dot, last dot index otherwise
		int lastDot = filename.lastIndexOf('.') == -1 ? filename.length() : filename.lastIndexOf('.');
		String ext = filename.substring(lastDot);//everything at the last dot and after is the extension

		Arrays.sort(exts);//sort for the binary search

		return Arrays.binarySearch(exts, ext, new Comparator<String>() { //just use the built-in binary search method
			@Override                                                //it will let us specify a Comparator and it's fast enough
			public int compare(String o1, String o2) {
				return o1.compareToIgnoreCase(o2);
			}
		}) >= 0;//binarySearch returns negative numbers when it's not found
	}
}


# Input: filename
# Output: if the filename ends with one of the extensions (ignoring case), output that extension; else output null.
# Assume that the list of file extensions consists of lower-case strings, including a leading period.
def has_extension(list):
  def ascii_downcase: explode | map( if 65 <= . and . <= 90 then . + 32  else . end) | implode;
  rindex(".") as $ix
  | if $ix then (.[$ix:] | ascii_downcase) as $ext
       | if list | index($ext) then $ext else null end
    else null
    end;


isext(filename, extensions) = any(x -> endswith(lowercase(filename), lowercase(x)), "." .* extensions)

# Test
extensions = ["zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"]
for f in ["MyData.a##", "MyData.tar.Gz", "MyData.gzip", "MyData.7z.backup", "MyData...", "MyData", "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2"]
    @printf("%20s : %5s\n", f, isext(f, extensions))
end


// version 1.1

/* implicitly allows for extensions containing dots */
fun String.isFileExtensionListed(extensions: List<String>): Boolean {
    return extensions.any { toLowerCase().endsWith("." + it.toLowerCase()) }
}

fun main(args: Array<String>) {
    val extensions = listOf("zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2")
    val fileNames  = listOf(
        "MyData.a##",
        "MyData.tar.Gz",
        "MyData.gzip",
        "MyData.7z.backup",
        "MyData...",
        "MyData",
        "MyData_v1.0.tar.bz2",
        "MyData_v1.0.bz2"
    )

    for (fileName in fileNames) {
        println("${fileName.padEnd(19)} -> ${fileName.isFileExtensionListed(extensions)}")
    }
}


-- Data declarations
local extentions = {"zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"}
local testCases = {
  "MyData.a##",
  "MyData.tar.Gz",
  "MyData.gzip",
  "MyData.7z.backup",
  "MyData...",
  "MyData",
  "MyData_v1.0.tar.bz2",
  "MyData_v1.0.bz2"
}

-- Return boolean of whether example has a file extension found in extList
function extMatch (extList, example)
  for _, extension in pairs(extList) do
    if example:lower():match("%." .. extension:lower() .. "$") then
      return true
    end
  end
  return false
end

-- Main procedure
for _, case in pairs(testCases) do
  print(case .. ": " .. tostring(extMatch(extentions, case)))
end


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)


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


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


ClearAll[CheckExtension]
CheckExtension[fn_String, e : {_String ..}] := StringMatchQ[ToLowerCase[FileExtension[fn]], Alternatives @@ ToLowerCase[e]]
exts = {"zip", "rar", "7z", "gz", "archive", "A##"};
CheckExtension["MyData.a##", exts]
CheckExtension["MyData.tar.gz", exts]
CheckExtension["MyData.gzip", exts]
CheckExtension["MyData.7z.backup", exts]
CheckExtension["MyData..", exts]
CheckExtension["MyData", exts]


import os, strutils

let fileNameList = ["MyData.a##", "MyData.tar.Gz", "MyData.gzip",
                    "MyData.7z.backup", "MyData...", "MyData"]

func buildExtensionList(extensions: varargs[string]): seq[string] {.compileTime.} =
  for ext in extensions:
    result.add('.' & ext.toLowerAscii())

const ExtList = buildExtensionList("zip", "rar", "7z", "gz", "archive", "A##")

for fileName in fileNameList:
  echo fileName, " → ", fileName.splitFile().ext.toLowerAscii() in ExtList


class FileExtension  {
  function : Main(args : String[]) ~ Nil {
    files := ["MyData.a##", "MyData.tar.Gz", "MyData.gzip",
      "MyData.7z.backup", "MyData...", "MyData", "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2"];
    exts := ["zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"];
    each(i : files) {
      HasExt(files[i], exts);
    };
  }

  function : HasExt(file : String, exts : String[]) ~ Nil {
    full_file := file->ToLower();
    each(i : exts) {
      full_ext := ".";
      full_ext += exts[i]->ToLower();
      if(full_file->EndsWith(full_ext)) {
	IO.Console->Print(file)->Print(" has extension \"")->Print(exts[i])->PrintLine("\"");
        return;
      };
    };

    IO.Console->Print(file)->PrintLine(" does not have an extension in the list");
  }
}


' 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


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


lower(s)=
{
  my(v=Vecsmall(s));
  for(i=1,#v,
    if(v[i]<91 && v[i]>64, v[i]+=32)
  );
  \\Strchr(v); \\ Use to return a string rather than a t_VECSMALL
  v;
}
checkExt(ext, file)=
{
  ext=apply(lower,ext);
  my(v=lower(file),e);
  for(i=1,#ext,
    e=ext[i];
    if(#v>#e && v[#v-#e+1..#v]==e && v[#v-#e]==46,
      return(1)
    )
  );
}
ext=["txt","gz","bat","c","c++","exe","pdf"];
filenames=["c:","txt","text.txt","text.TXT","test.tar.gz","test/test2.exe","test","foo.c","foo.C","foo.C++","foo.c#","foo.zkl","document.pdf"];
select(f -> checkExt(ext, f), filenames)


sub check_extension {
    my ($filename, @extensions) = @_;
    my $extensions = join '|', map quotemeta, @extensions;
    scalar $filename =~ / \. (?: $extensions ) $ /xi
}


$allowed = ['zip', 'rar', '7z', 'gz', 'archive', 'A##', 'tar.bz2'];
$lc_allowed = array_map('strtolower', $allowed);

$tests = [
    ['MyData.a##',true],
    ['MyData.tar.Gz',true],
    ['MyData.gzip',false],
    ['MyData.7z.backup',false],
    ['MyData...',false],
    ['MyData',false],
    ['archive.tar.gz', true]
];

foreach ($tests as $test) {
    $ext = pathinfo($test[0], PATHINFO_EXTENSION);
    if (in_array(strtolower($ext), $lc_allowed)) {
        $result = 'true';
    } else {
        $result = 'false';
    }
    printf("%20s : %s \n", $test[0],$result);
}


with javascript_semantics
constant extensions = lower({"zip","rar","7z","gz","archive","A##","tar.bz2"})

global function get_known_extension(string filename)
    for i=1 to length(filename) do
        if filename[i]='.' then
            string extension = lower(filename[i+1..$])
            if find(extension,extensions) then
                return extension
            end if
        end if
    end for
    return ""
end function

constant tests = {"MyData.a##",
                  "MyData.tar.Gz",
                  "MyData.gzip",
                  "MyData.7z.backup",
                  "MyData...",
                  "MyData",
                  "MyData_v1.0.tar.bz2",
                  "MyData_v1.0.bz2"}

for i=1 to length(tests) do
    string ti = tests[i],
           ext = get_known_extension(ti)
    printf(1,"%-20s %-10s %s\n",{ti,ext,{"true","false"}[2-(find(ext,extensions)!=0)]})
end for


def isExt(fileName, extensions):
  return True in map(fileName.lower().endswith, ("." + e.lower() for e in extensions))


#lang racket

(define extensions '(".zip"
                     ".rar"
                     ".7z"
                     ".gz"
                     ".archive"
                     ".a##"
                     ".tar.bz2"))

(define filenames '("MyData.a##"
                    "MyData.tar.Gz"
                    "MyData.gzip"
                    "MyData.7z.backup"
                    "MyData..."
                    "MyData"
                    "MyData_v1.0.tar.bz2"
                    "MyData_v1.0.bz2"))

(define (string-right s n)
    (if (< (string-length s) n)
        s
        (substring s (- (string-length s) n))))

(define (file-extension-in-list? f lst)
  (let ([lcase (string-downcase f)])
    (ormap (lambda (x) (equal? (string-right lcase (string-length x)) x)) extensions)))

(for ((f (in-list filenames)))
  (printf "~a ~a~%" (~a #:width 20 f) (file-extension-in-list? f extensions)))


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


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


sub check-extension ($filename, *@extensions) {
    so $filename ~~ /:i '.' @extensions $/
}

# Testing:

my @extensions = <zip rar 7z gz archive A## tar.bz2>;
my @files= <
    MyData.a##  MyData.tar.Gz  MyData.gzip  MyData.7z.backup  MyData...  MyData
    MyData_v1.0.tar.bz2  MyData_v1.0.bz2
>;
say "{$_.fmt: '%-19s'} - {check-extension $_, @extensions}" for @files;


/*REXX pgm displays if a filename has a known extension  (as per a list of extensions). */
$= 'zip rar 7z gz archive A## tar.bz2';  upper $ /*a list of "allowable" file extensions*/
parse arg fn                                     /*obtain optional argument from the CL.*/
@.=                                              /*define the default for the  @. array.*/
if fn\=''  then       @.1 =  strip(fn)           /*A filename specified?   Then use it. */
           else do;   @.1 = "MyData.a##"         /*No    "        "        Else use list*/
                      @.2 = "MyData.tar.Gz"
                      @.3 = "MyData.gzip"
                      @.4 = "MyData.7z.backup"
                      @.5 = "MyData..."
                      @.6 = "MyData"
                      @.7 = "MyData_v1.0.tar.bz2"
                      @.8 = "MyData_v1.0.bz2"
                end
#= words($)

  do j=1  while @.j\=='';   @@= @.j;   upper @@  /*traipse through @ file extension list*/
      do k=1  for #  until right(@@, L)==x       /*Search $ list, is extension in list? */
      x= . || word($, k);  L=length(x)           /*construct the extension of the file. */
      end   /*k*/                                /* [↓]  display file, and a nay or yea.*/
  say  right(@.j, 40)     ' '      right( word( "false true",  1 + (k<=#) ),  5)
  end       /*j*/                                /*stick a fork in it,  we're all done. */


# Project : File extension is in extensions list

extensions = [".zip", ".rar", ".7z", ".gz", ".archive", ".a##", ".tar.bz2"]

filenames = ["MyData.a##", "MyData.tar.gz", "MyData.gzip", "MyData.7z.backup",
                   "MyData...", "MyData", "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2"]

for n = 1 to len(filenames)
    flag = 0
    for m = 1 to len(extensions)
        if right(filenames[n], len(extensions[m])) = extensions[m]
           flag = 1
           see filenames[n] + " -> " + extensions[m] + " -> " + " true" + nl
           exit
        ok
    next
    if flag = 0
       see filenames[n] + " -> " + "false" + nl
    ok
next


def is_ext(filename, extensions)
  if filename.respond_to?(:each)
    filename.each do |fn|
      is_ext(fn, extensions)
    end
  else
    fndc = filename.downcase
    extensions.each do |ext|
      bool = fndc.end_with?(?. + ext.downcase)
      puts "%20s : %s" % [filename, bool] if bool
    end
  end
end


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


fn main() {
    let exts = ["zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"];
    let filenames = [
        "MyData.a##",
        "MyData.tar.Gz",
        "MyData.gzip",
        "MyData.7z.backup",
        "MyData...",
        "MyData",
        "MyData_v1.0.tar.bz2",
        "MyData_v1.0.bz2",
    ];

    println!("extenstions: {:?}\n", exts);

    for filename in filenames.iter() {
        let check = exts.iter().any(|ext| {
            filename
                .to_lowercase()
                .ends_with(&format!(".{}", ext.to_lowercase()))
        });
        println!("{:20} {}", filename, check);
    }
}


  def isExt(fileName: String, extensions: List[String]): Boolean = {
    extensions.map { _.toLowerCase }.exists { fileName.toLowerCase endsWith "." + _ }
  }


func check_extension(filename, extensions) {
    filename ~~ Regex('\.(' + extensions.map { .escape }.join('|') + ')\z', :i)
}


# This example includes the extra credit.
# With a slight variation, a matching suffix can be identified.
# Note that suffixes with two or more dots (ie a dot in suffix) are checked for each case.
# This way, filename.1.txt will match for txt, and filename3.tar.gz.1 will match for tar.gz.1 for example.

# Example input data:
set f_list [list \
                "MyData.a##" \
                MyData.tar.Gz \
                MyData.gzip \
                MyData.7z.backup \
                "MyData..." \
                MyData \
                MyData_v1.0.tar.bz2 \
                MyData_v1.0.bz2 ]
set suffix_input_list [list zip rar 7z gz archive "A##" tar.bz2 ]

# Prefix a dot to any suffix that does not begin with a dot.
set suffix_list [list ]
foreach s $suffix_input_list {
    if { [string range $s 0 0] ne "." } {
        set s2 "."
    } else {
        set s2 ""
    }
    append s2 $s
    lappend suffix_list [string tolower $s2]
}

# Check each filename
foreach filename0 $f_list {
    set filename1 [string tolower [file tail $filename0]]
    set suffix1 [file extension $filename1]
    set file_suffix_list [list $suffix1]
    set filename2 [file rootname $filename1]
    set i 0
    # i is an infinite loop breaker. In case there is some unforseen case..
    while { $filename2 ne "" && $filename2 ne $filename1 && $i < 32} {
        # Another suffix is possible
        set suffix2 [file extension $filename2]
        if { $suffix2 ne "" } {
            # found another suffix
            append suffix2 $suffix1
            lappend file_suffix_list $suffix2
        }
        set suffix1 $suffix2
        set filename1 $filename2
        set filename2 [file rootname $filename2]
        incr i
    }
    set a_suffix_found_p 0
    foreach file_suffix $file_suffix_list {
        if { $file_suffix in $suffix_list } {
            set a_suffix_found_p 1
        }
    }
    puts -nonewline "${filename0}\t"
    if { $a_suffix_found_p } {
        puts "true"
    } else {
        puts "false"
    }
}


//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);


import "/str" for Str
import "/fmt" for Fmt

var exts = ["zip", "rar", "7z", "gz", "archive", "A##", "tar.bz2"]

var tests = [
    "MyData.a##", "MyData.tar.Gz", "MyData.gzip" , "MyData.7z.backup",
    "MyData...", "MyData", "MyData_v1.0.tar.bz2", "MyData_v1.0.bz2"
]

var ucExts = exts.map { |e| "." + Str.upper(e) }
for (test in tests) {
    var ucTest = Str.upper(test)
    var hasExt = false
    var i = 0
    for (ext in ucExts) {
        hasExt = ucTest.endsWith(ext)
        if (hasExt) {
            Fmt.print("$-20s $s (extension: $s)", test, hasExt, exts[i])
            break
        }
        i = i + 1
    }
    if (!hasExt) Fmt.print("$-20s $-5s", test, hasExt)
}


fcn hasExtension(fnm){
   var [const] extensions=T(".zip",".rar",".7z",".gz",".archive",".a##");
   nm,ext:=File.splitFileName(fnm)[-2,*].apply("toLower");
   if(extensions.holds(ext)) True;
   else if(ext==".bz2" and ".tar"==File.splitFileName(nm)[-1]) True;
   else False
}
nms:=T("MyData.a##","MyData.tar.Gz","MyData.gzip","MyData.7z.backup",
       "MyData...","MyData",
       "MyData_v1.0.tAr.bz2","MyData_v1.0.bz2");
foreach nm in (nms){ println("%20s : %s".fmt(nm,hasExtension(nm))); }


# 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) ;


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)


// 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()
    }
}


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


entropy = (p - 1) Log[2, 1 - p] - p Log[2, p];

TableForm[
 Table[{k, Fibonacci[k],
   [email protected][N[entropy /. {p -> Fibonacci[k - 1]/Fibonacci[k]}, 15],
      0]}, {k, 37}],
 TableHeadings -> {None, {"N", "Length", "Entropy"}}]


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


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


: 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) ;


/* 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


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


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.


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
}


with javascript_semantics
function entropy(sequence s)
    sequence symbols = unique(s),
             counts = repeat(0,length(symbols))
    for i=1 to length(s) do
        integer k = find(s[i],symbols)
        counts[k] += 1
    end for
    atom H = 0
    for i=1 to length(counts) do
        atom ci = counts[i]/length(s)
        H -= ci*log2(ci)
    end for
    return H
end function

sequence F_words = {"1","0"}
for i=3 to 37 do
    F_words = append(F_words,F_words[i-1]&F_words[i-2])
end for

for i=1 to length(F_words) do
    string fi = F_words[i]
    printf(1,"%2d: length %9d, entropy %f %s\n",
             {i,length(fi),entropy(fi),iff(i<10?fi,"...")})
end for


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]).


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;


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


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


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


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


/*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,.)


# 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


#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


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


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


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


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])]);


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


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


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


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
}


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


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


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


with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Main is
   procedure feigenbaum is
      subtype i_range is Integer range 2 .. 13;
      subtype j_range is Integer range 1 .. 10;

      -- the number of digits in type Real is reduced to 15 to produce the
      -- results reported by C, C++, C# and Ring. Increasing the number of
      -- digits in type Real produces the results reported by D.

      type Real is digits 15;
      package Real_Io is new Float_IO (Real);
      use Real_Io;

      a, x, y, d : Real;
      a1         : Real := 1.0;
      a2         : Real := 0.0;
      d1         : Real := 3.2;
   begin
      Put_Line (" i       d");
      for i in i_range loop
         a := a1 + (a1 - a2) / d1;
         for j in j_range loop
            x := 0.0;
            y := 0.0;
            for k in 1 .. 2**i loop
               y := 1.0 - 2.0 * x * y;
               x := a - x * x;
            end loop;
            a := a - x / y;
         end loop;
         d := (a1 - a2) / (a - a1);
         Put (Item => i, Width => 2);
         Put (Item => d, Fore => 5, Aft => 8, Exp => 0);
         New_Line;
         d1 := d;
         a2 := a1;
         a1 := a;
      end loop;
   end feigenbaum;

begin
   feigenbaum;
end Main;


# Calculate the Feigenbaum constant #

print( ( "Feigenbaum constant calculation:", newline ) );
INT max it   = 13;
INT max it j = 10;
REAL a1 := 1.0;
REAL a2 := 0.0;
REAL d1 := 3.2;
print( ( "i  ", "d", newline ) );
FOR i FROM 2 TO max it DO
     REAL a := a1 + (a1 - a2) / d1;
     FOR j TO max it j DO
          REAL x := 0;
          REAL y := 0;
          FOR k TO 2 ^ i DO
               y := 1 - 2 * y * x;
               x := a - x * x
          OD;
          a := a - x / y
     OD;
     REAL d = (a1 - a2) / (a - a1);
     IF i < 10 THEN
        print( ( whole( i, 0 ), "  ", fixed( d, -10, 8 ), newline ) )
     ELSE
        print( ( whole( i, 0 ), " ",  fixed( d, -10, 8 ), newline ) )
     FI;
     d1 := d;
     a2 := a1;
     a1 := a
OD


# syntax: GAWK -f FEIGENBAUM_CONSTANT_CALCULATION.AWK
BEGIN {
    a1 = 1
    a2 = 0
    d1 = 3.2
    max_i = 13
    max_j = 10
    print(" i d")
    for (i=2; i<=max_i; i++) {
      a = a1 + (a1 - a2) / d1
      for (j=1; j<=max_j; j++) {
        x = y = 0
        for (k=1; k<=2^i; k++) {
          y = 1 - 2 * y * x
          x = a - x * x
        }
        a -= x / y
      }
      d = (a1 - a2) / (a - a1)
      printf("%2d %.8f\n",i,d)
      d1 = d
      a2 = a1
      a1 = a
    }
    exit(0)
}


maxIt = 13 : maxItj = 13
a1 = 1.0 : a2 = 0.0 : d = 0.0 : d1 = 3.2

print "Feigenbaum constant calculation:"
print
print "  i      d"
print "======================"

for i = 2 to maxIt
    a = a1 + (a1 - a2) / d1
    for j = 1 to maxItj
        x = 0.0 : y = 0.0
        for k = 1 to 2 ^ i
            y = 1 - 2 * y * x
            x = a - x * x
        next k
        a -= x / y
    next j
    d = (a1 - a2) / (a - a1)
    print rjust(i,3); chr(9); ljust(d,13,"0")
    d1 = d
    a2 = a1
    a1 = a
next i


using System;

namespace FeigenbaumConstant {
    class Program {
        static void Main(string[] args) {
            var maxIt = 13;
            var maxItJ = 10;
            var a1 = 1.0;
            var a2 = 0.0;
            var d1 = 3.2;
            Console.WriteLine(" i       d");
            for (int i = 2; i <= maxIt; i++) {
                var a = a1 + (a1 - a2) / d1;
                for (int j = 1; j <= maxItJ; j++) {
                    var x = 0.0;
                    var y = 0.0;
                    for (int k = 1; k <= 1<<i; k++) {
                        y = 1.0 - 2.0 * y * x;
                        x = a - x * x;
                    }
                    a -= x / y;
                }
                var d = (a1 - a2) / (a - a1);
                Console.WriteLine("{0,2:d}    {1:f8}", i, d);
                d1 = d;
                a2 = a1;
                a1 = a;
            }
        }
    }
}


#include <iostream>

int main() {
    const int max_it = 13;
    const int max_it_j = 10;
    double a1 = 1.0, a2 = 0.0, d1 = 3.2;

    std::cout << " i       d\n";
    for (int i = 2; i <= max_it; ++i) {
        double a = a1 + (a1 - a2) / d1;
        for (int j = 1; j <= max_it_j; ++j) {
            double x = 0.0;
            double y = 0.0;
            for (int k = 1; k <= 1 << i; ++k) {
                y = 1.0 - 2.0*y*x;
                x = a - x * x;
            }
            a -= x / y;
        }
        double d = (a1 - a2) / (a - a1);
        printf("%2d    %.8f\n", i, d);
        d1 = d;
        a2 = a1;
        a1 = a;
    }

    return 0;
}


import std.stdio;

void main() {
    int max_it = 13;
    int max_it_j = 10;
    double a1 = 1.0;
    double a2 = 0.0;
    double d1 = 3.2;
    double a;

    writeln(" i       d");
    for (int i=2; i<=max_it; i++) {
        a = a1 + (a1 - a2) / d1;
        for (int j=1; j<=max_it_j; j++) {
            double x = 0.0;
            double y = 0.0;
            for (int k=1; k <= 1<<i; k++) {
                y = 1.0 - 2.0 * y * x;
                x = a - x * x;
            }
            a -= x / y;
        }
        double d = (a1 - a2) / (a - a1);
        writefln("%2d    %.8f", i, d);
        d1 = d;
        a2 = a1;
        a1 = a;
    }
}


open System

[<EntryPoint>]
let main _ =
    let maxIt = 13
    let maxItJ = 10
    let mutable a1 = 1.0
    let mutable a2 = 0.0
    let mutable d1 = 3.2
    Console.WriteLine(" i       d")
    for i in 2 .. maxIt do
        let mutable a = a1 + (a1 - a2) / d1
        for j in 1 .. maxItJ do
            let mutable x = 0.0
            let mutable y = 0.0
            for _ in 1 .. (1 <<< i) do
                y <- 1.0 - 2.0 * y * x
                x <- a - x * x
            a <- a - x / y
        let d = (a1 - a2) / (a - a1)
        Console.WriteLine("{0,2:d}    {1:f8}", i, d)
        d1 <- d
        a2 <- a1
        a1 <- a
    0 // return an integer exit code


USING: formatting io locals math math.ranges sequences ;

[let
      1 :> a1!
      0 :> a2!
    3.2 :> d!

    " i d" print

    2 13 [a,b] [| exp |
        a1 a2 - d /f a1 + :> a!
        10 [
            0 :> x!
            0 :> y!
            exp 2^ [
                1 2 x y * * - y!
                a x sq - x!
            ] times
            a x y /f - a!
        ] times
        a1 a2 - a a1 - /f d!
        a1 a2! a a1!
        exp d "%2d %.8f\n" printf
    ] each
]


' version 25-0-2019
' compile with: fbc -s console

Dim As UInteger i, j, k, maxit = 13, maxitj = 13
Dim As Double x, y, a, a1 = 1, a2, d, d1 = 3.2

Print "Feigenbaum constant calculation:"
Print
Print "  i     d"
Print "==================="

For i = 2 To maxIt
    a = a1 + (a1 - a2) / d1
    For j = 1 To maxItJ
        x = 0 : y = 0
        For k = 1 To 2 ^ i
            y = 1 - 2 * y * x
            x = a - x * x
        Next
        a = a - x / y
    Next
    d = (a1 - a2) / (a - a1)
    Print Using "###    ##.#########"; i; d
    d1 = d
    a2 = a1
    a1 = a
Next

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


window 1, @"Feignenbaum Constant", ( 0, 0, 200, 300 )

_maxIt  = 13
_maxItJ = 10

void local fn Feignenbaum
NSUInteger i, j, k
double     a1 = 1.0, a2 = 0.0, d1 = 3.2

print "Feignenbaum Constant"
print " i       d"

for i = 2 to _maxIt
double a = a1 + ( a1 - a2 ) / d1
for j = 1 to _maxItJ
double x = 0, y = 0
for k = 1 to fn pow( 2, i )
y = 1 - 2 * y * x
x = a - x * x
next
a = a - x / y
next
double d = ( a1 - a2 ) / ( a - a1 )
printf @"%2d.   %.8f", i, d
d1 = d
a2 = a1
a1 = a
next
end fn

fn Feignenbaum

HandleEvents