Another update from ingydotnet^djgoku

Task/Entropy/00DESCRIPTION

@@ -10,4 +10,7 @@ Therefore, given a string <math>S</math> of length <math>n</math> where <math>P(
 For this task, use "<tt>1223334444</tt>" as an example.
 The result should be around 1.84644 bits.
 
-Related Task: [[Fibonacci_word]]
+Related Tasks:
+
+:::* [[Fibonacci_word]]
+:::* [[Entropy/Narcissist]]

Task/Entropy/ALGOL-W/entropy.alg

@@ -0,0 +1,54 @@
+begin
+    % calculates the shannon entropy of a string                          %
+    % strings are fixed length in algol W and the length is part of the   %
+    % type, so we declare the string parameter to be the longest possible %
+    % string length (256 characters) and have a second parameter to       %
+    % specify how much is actually used                                   %
+    real procedure shannon_entropy ( string(256) value s
+                                   ; integer     value stringLength
+                                   );
+    begin
+
+        real    probability, entropy;
+
+        % algol W assumes there are 256 possible characters %
+        integer MAX_CHAR;
+                MAX_CHAR := 256;
+
+        % declarations must preceed statements, so we start a new         %
+        % block here so we can use MAX_CHAR as an array bound             %
+        begin
+
+            % increment an integer variable                               %
+            procedure incI ( integer value result a ) ; a := a + 1;
+
+            integer array charCount( 1 :: MAX_CHAR );
+
+            % count the occurances of each character in s                 %
+            for charPos := 1 until MAX_CHAR do charCount( charPos ) := 0;
+            for sPos := 0 until stringLength - 1 do incI( charCount( decode( s( sPos | 1 ) ) ) );
+
+            % calculate the entropy, we use log base 10 and then convert  %
+            % to log base 2 after calculating the sum                     %
+
+            entropy := 0.0;
+            for charPos := 1 until MAX_CHAR do
+            begin
+                if charCount( charPos ) not = 0
+                then begin
+                    % have a character that occurs in the string          %
+                    probability := charCount( charPos ) / stringLength;
+                    entropy     := entropy - ( probability * log( probability ) )
+                end
+            end charPos
+
+        end;
+
+        entropy / log( 2 )
+    end shannon_entropy ;
+
+    % test the shannon entropy routine                                    %
+    r_format := "A"; r_w := 12; r_d := 6; % set output to fixed format    %
+    write( shannon_entropy( "1223334444", 10 ) )
+
+end.

Task/Entropy/Common-Lisp/entropy.lisp

@@ -1,6 +1,8 @@
-(defun entropy(input-string)
-    (let ((frequency-table (make-hash-table :test 'equal))
-          (entropy 0))
-         (map 'nil #'(lambda(c) (setf (gethash c frequency-table) (if (gethash c frequency-table) (+ (gethash c frequency-table) 1) 1))) (coerce input-string 'list))
-         (maphash #'(lambda(k v) (setf entropy (+ entropy (* -1 (/ v (length input-string)) (log (/ v (length input-string)) 2))))) frequency-table)
-         entropy))
+(defun entropy (string)
+  (let ((table (make-hash-table :test 'equal))
+        (entropy 0))
+    (mapc (lambda (c) (setf (gethash c table) (+ (gethash c table 0) 1)))
+          (coerce string 'list))
+    (maphash (lambda (k v) (decf entropy (* (/ v (length input-string)) (log (/ v (length input-string)) 2))))
+             table)
+    entropy))

Task/Entropy/Elixir/entropy.elixir

@@ -0,0 +1,14 @@
+defmodule RC do
+  def entropy(str) do
+    leng = String.length(str)
+    String.split(str, "", trim: true)
+    |> Enum.group_by(&(&1))
+    |> Enum.map(fn{_,value} -> length(value) end)
+    |> Enum.reduce(0, fn count, entropy ->
+         freq = count / leng
+         entropy - freq * :math.log2(freq)
+       end)
+  end
+end
+
+IO.inspect RC.entropy("1223334444")

Task/Entropy/J/entropy-1.j

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

Task/Entropy/J/entropy-2.j

@@ -1,2 +1,10 @@
    entropy '1223334444'
 1.84644
+   entropy i.256
+8
+   entropy 256$9
+0
+   entropy 256$0 1
+1
+   entropy 256$0 1 2 3
+2

Task/Entropy/Liberty-BASIC/entropy.liberty

@@ -0,0 +1,32 @@
+dim countOfChar( 255) ' all possible one-byte ASCII chars
+
+    source$    ="1223334444"
+    charCount  =len( source$)
+    usedChar$  =""
+
+    for i =1 to len( source$)   '   count which chars are used in source
+        ch$             =mid$( source$, i, 1)
+        if not( instr( usedChar$, ch$)) then usedChar$ =usedChar$ +ch$
+        'currentCh$      =mid$(
+        j               =instr( usedChar$, ch$)
+        countOfChar( j) =countOfChar( j) +1
+    next i
+
+    l =len( usedChar$)
+    for i =1 to l
+        probability =countOfChar( i) /charCount
+        entropy     =entropy -( probability *logBase( probability, 2))
+    next i
+
+    print " Characters used and the number of occurrences of each "
+    for i =1 to l
+        print " '"; mid$( usedChar$, i, 1); "'", countOfChar( i)
+    next i
+
+    print " Entropy of '"; source$; "' is  "; entropy; " bits."
+    print " The result should be around 1.84644 bits."
+
+    end
+    function logBase( x, b) '   in LB log() is base 'e'.
+        logBase =log( x) /log( 2)
+    end function

Task/Entropy/Perl-6/entropy-2.pl6

@@ -1,4 +1,4 @@
-use MONKEY_TYPING;
+use MONKEY-TYPING;
 augment class Bag {
     method entropy {
 	[+] map -> \p { - p * log p },

Task/Entropy/PowerShell/entropy.psh

@@ -0,0 +1,9 @@
+function entropy ($string) {
+    $n = $string.Length
+    $string.ToCharArray() | group | foreach{
+        $p = $_.Count/$n
+        $i = [Math]::Log($p,2)
+        -$p*$i
+    } | measure -Sum | foreach Sum
+}
+entropy "1223334444"

Task/Entropy/Prolog/entropy.pro

@@ -0,0 +1,131 @@
+:-module(shannon_entropy, [shannon_entropy/2]).
+
+%!	shannon_entropy(+String, -Entropy) is det.
+%
+%	Calculate the Shannon Entropy of String.
+%
+%	Example query:
+%	==
+%	?- shannon_entropy(1223334444, H).
+%	H = 1.8464393446710154.
+%	==
+%
+shannon_entropy(String, Entropy):-
+	atom_chars(String, Cs)
+	,relative_frequencies(Cs, Frequencies)
+	,findall(CI
+		,(member(_C-F, Frequencies)
+		 ,log2(F, L)
+		 ,CI is F * L
+		 )
+		,CIs)
+	,foldl(sum, CIs, 0, E)
+	,Entropy is -E.
+
+%!	frequencies(+Characters,-Frequencies) is det.
+%
+%	Calculates the relative frequencies of elements in the list of
+%	Characters.
+%
+%	Frequencies is a key-value list with elements of the form:
+%	C-F, where C a character in the list and F its relative
+%	frequency in the list.
+%
+%	Example query:
+%	==
+%	?- relative_frequencies([a,a,a,b,b,b,b,b,b,c,c,c,a,a,f], Fs).
+%	Fs = [a-0.3333333333333333, b-0.4, c-0.2,f-0.06666666666666667].
+%	==
+%
+relative_frequencies(List, Frequencies):-
+	run_length_encoding(List, Rle)
+        % Sort Run-length encoded list and aggregate lengths by element
+	,keysort(Rle, Sorted_Rle)
+	,group_pairs_by_key(Sorted_Rle, Elements_Run_lengths)
+	,length(List, Elements_in_list)
+	,findall(E-Frequency_of_E
+		,(member(E-RLs, Elements_Run_lengths)
+                 % Sum the list of lengths of runs of E
+		 ,foldl(plus, RLs, 0, Occurences_of_E)
+		 ,Frequency_of_E is Occurences_of_E / Elements_in_list
+		 )
+		,Frequencies).
+
+
+%!	run_length_encoding(+List, -Run_length_encoding) is det.
+%
+%	Converts a list to its run-length encoded form where each "run"
+%	of contiguous repeats of the same element is replaced by that
+%	element and the length of the run.
+%
+%	Run_length_encoding is a key-value list, where each element is a
+%	term:
+%
+%	Element:term-Repetitions:number.
+%
+%	Example query:
+%	==
+%       ?- run_length_encoding([a,a,a,b,b,b,b,b,b,c,c,c,a,a,f], RLE).
+%	RLE = [a-3, b-6, c-3, a-2, f-1].
+%	==
+%
+run_length_encoding([], []-0):-
+	!. % No more results needed.
+
+run_length_encoding([Head|List], Run_length_encoded_list):-
+	run_length_encoding(List, [Head-1], Reversed_list)
+	% The resulting list is in reverse order due to the head-to-tail processing
+	,reverse(Reversed_list, Run_length_encoded_list).
+
+%!	run_length_encoding(+List,+Initialiser,-Accumulator) is det.
+%
+%	Business end of run_length_encoding/3. Calculates the run-length
+%	encoded form of a list and binds the result to the Accumulator.
+%	Initialiser is a list [H-1] where H is the first element of the
+%	input list.
+%
+run_length_encoding([], Fs, Fs).
+
+% Run of F consecutive occurrences of C
+run_length_encoding([C|Cs],[C-F|Fs], Acc):-
+        % Backtracking would produce successive counts
+	% of runs of C at different indices in the list.
+	!
+	,F_ is F + 1
+	,run_length_encoding(Cs, [C-F_| Fs], Acc).
+
+% End of a run of consecutive identical elements.
+run_length_encoding([C|Cs], Fs, Acc):-
+	run_length_encoding(Cs,[C-1|Fs], Acc).
+
+
+/* Arithmetic helper predicates */
+
+%!	log2(N, L2_N) is det.
+%
+%	L2_N is the logarithm with base 2 of N.
+%
+log2(N, L2_N):-
+	L_10 is log10(N)
+	,L_2 is log10(2)
+	,L2_N is L_10 / L_2.
+
+%!	sum(+A,+B,?Sum) is det.
+%
+%	True when Sum is the sum of numbers A and B.
+%
+%	Helper predicate to allow foldl/4 to do addition. The following
+%	call will raise an error (because there is no predicate +/3):
+%	==
+%	foldl(+, [1,2,3], 0, Result).
+%	==
+%
+%	This will not raise an error:
+%	==
+%	foldl(sum, [1,2,3], 0, Result).
+%	==
+%
+sum(A, B, Sum):-
+	must_be(number, A)
+	,must_be(number, B)
+	,Sum is A + B.

Task/Entropy/PureBasic/entropy.purebasic

@@ -0,0 +1,22 @@
+#TESTSTR="1223334444"
+NewMap uchar.i() : Define.d e
+
+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
+
+countchar(#TESTSTR,uchar())
+
+ForEach uchar()
+  e-uchar()/Len(#TESTSTR)*nlog2(uchar()/Len(#TESTSTR))
+Next
+
+OpenConsole()
+Print("Entropy of ["+#TESTSTR+"] = "+StrD(e,15))
+Input()

Task/Entropy/Python/entropy-3.py

@@ -0,0 +1,19 @@
+def Entropy(text):
+    import math
+    log2=lambda x:math.log(x)/math.log(2)
+    exr={}
+    infoc=0
+    for each in text:
+        try:
+            exr[each]+=1
+        except:
+            exr[each]=1
+    textlen=len(text)
+    for k,v in exr.items():
+        freq  =  1.0*v/textlen
+        infoc+=freq*log2(freq)
+    infoc*=-1
+    return infoc
+
+while True:
+    print Entropy(raw_input('>>>'))

Task/Entropy/REXX/entropy-3.rexx

@@ -1,30 +1,30 @@
-/*REXX program calculates the information entropy  for a given char str.*/
-numeric digits 30                      /*use thirty digits for precision*/
-parse arg $;         if $=='' then $=1223334444  /*obtain optional input*/
-n=0;  @.=0;  L=length($);  $$=
+/*REXX program calculates the information entropy for a given character string*/
+numeric digits 50                      /*use 50 decimal digits for precision. */
+parse arg $; if $='' then $=1223334444 /*obtain the optional input from the CL*/
+#=0;  @.=0;  L=length($); $$=          /*define handy-dandy REXX variables.   */
 
-      do j=1  for L;  _=substr($,j,1)  /*process each character in $ str*/
-      if @._==0  then do;   n=n+1      /*if unique,  bump char counter. */
-                      $$=$$ || _       /*add this character to the list.*/
+      do j=1  for L;  _=substr($,j,1)  /*process each character in  $  string.*/
+      if @._==0  then do;  #=#+1       /*Unique?  Yes, bump character counter.*/
+                           $$=$$ || _  /*add this character to the  $$  list. */
                       end
-      @._ = @._+1                      /*keep track of this char count. */
+      @._=@._+1                        /*keep track of this character's count.*/
       end   /*j*/
-sum=0                                  /*calc info entropy for each char*/
-      do i=1  for n;  _=substr($$,i,1) /*obtain a char from unique list.*/
-      sum=sum  -  @._/L  * log2(@._/L) /*add (negatively) the entropies.*/
+sum=0                                  /*calculate info entropy for each char.*/
+      do i=1  for #;  _=substr($$,i,1) /*obtain a character from unique list. */
+      sum=sum  -  @._/L  * log2(@._/L) /*add (negatively) the char entropies. */
       end   /*i*/
 
-say ' input string: ' $
-say 'string length: ' L
-say ' unique chars: ' n ;       say
-say 'the information entropy of the string ──► ' format(sum,,12)  " bits."
-exit                                   /*stick a fork in it, we're done.*/
+say ' input string: '   $
+say 'string length: '   L
+say ' unique chars: '   # ;     say
+say 'the information entropy of the string ──► '    format(sum,,12)     " bits."
+exit                                   /*stick a fork in it,  we're all done. */
 /*──────────────────────────────────LOG2 subroutine───────────────────────────*/
-log2: procedure; parse arg x 1 xx;  ig= x>1.5;  is=1-2*(ig\==1);  ii=0
-numeric digits digits()+5      /* [↓] precision of E must be > digits().*/
+log2: procedure;  parse arg x 1 ox;         ig= x>1.5;   is=1-2*(ig\==1);   ii=0
+numeric digits digits()+5           /* [↓]  precision of E must be ≥ digits().*/
 e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
-  do  while  ig & xx>1.5 | \ig&xx<.5;   _=e;       do j=-1;  iz=xx* _**-is
-  if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave;  _=_*_;  izz=iz;  end  /*j*/
-  xx=izz;  ii=ii+is*2**j;  end /*while*/;       x=x* e**-ii-1;  z=0;  _=-1;  p=z
-    do k=1;  _=-_*x;  z=z+_/k;  if z=p  then leave;  p=z;  end  /*k*/
-  r=z+ii;  if arg()==2  then return r;  return r/log2(2,0)
+   do  while  ig & ox>1.5 | \ig&ox<.5;      _=e;      do k=-1;  iz=ox* _**-is
+   if k>=0 & (ig & iz<1 | \ig&iz>.5)  then leave;     _=_*_;    izz=iz;   end
+   ox=izz;  ii=ii+is*2**k;  end;            x=x* e** -ii-1;  z=0;    _=-1;   p=z
+     do k=1;   _=-_*x;   z=z+_/k;     if z=p  then leave;  p=z;   end  /*k*/
+   r=z+ii;  if arg()==2  then return r;       return r/log2(2,0)

Task/Entropy/Ruby/entropy-1.rb

@@ -1,9 +1,12 @@
 def entropy(s)
-  counts = Hash.new(0)
+  counts = Hash.new(0.0)
   s.each_char { |c| counts[c] += 1 }
+  leng = s.length
 
   counts.values.reduce(0) do |entropy, count|
-    freq = count / s.length.to_f
+    freq = count / leng
     entropy - freq * Math.log2(freq)
   end
 end
+
+p entropy("1223334444")

Task/Entropy/Rust/entropy.rust

@@ -1,16 +1,20 @@
-// works for Rust 0.9
-fn entropy(s: &str) -> f32 {
-	let mut entropy: f32 = 0.0;
-	let mut histogram = [0, ..256];
-	let len = s.len();
+fn entropy(s: &[u8]) -> f32 {
+    let mut entropy: f32 = 0.0;
+    let mut histogram = [0; 256];
 
-	for i in range(0, len) { histogram[s[i]] += 1; }
-	for i in range(0, 256) {
-		if histogram[i] > 0 {
-			let ratio = (histogram[i] as f32 / len as f32) as f32;
-			entropy -= (ratio * log2(ratio)) as f32;
-		}
-	}
-
-	entropy
+    for i in 0..s.len() {
+        histogram.get_mut(s[i] as usize).map(|v| *v += 1);
+    }
+    for i in 0..256 {
+        if histogram[i] > 0 {
+            let ratio = (histogram[i] as f32 / s.len() as f32) as f32;
+            entropy -= (ratio * ratio.log2()) as f32;
+        }
+    }
+    entropy
+}
+
+fn main() {
+    let arg = std::env::args().nth(1).expect("Need a string.");
+    println!("Entropy of {} is {}.", arg, entropy(&arg.bytes().collect::<Vec<_>>()));
 }