From a283782abe340c9246e2c5cb9b439ed944070460 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 25 Sep 2012 20:17:34 -0700
Subject: [PATCH] math.statistics: some fixes to entropy, adding
 maximum-entropy and normalized-entropy.

---
 basis/math/statistics/statistics-tests.factor |  2 +-
 basis/math/statistics/statistics.factor       | 13 +++++++++++--
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index b9cf7c4546..e181295262 100644
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -145,7 +145,7 @@ IN: math.statistics.tests
     { 18.9375 40.0 42.8125 } .00001 v~
 ] unit-test
 
-{ 1.0986122886681096 } [ { 1 2 3 } entropy ] unit-test
+{ 0x1.02eb63cff3f8p0 } [ { 1 2 3 } entropy ] unit-test
 
 { 1.0 } [ 0.5 binary-entropy ] unit-test
 
diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 1a12ae0b00..651b450185 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -330,8 +330,17 @@ ALIAS: corr sample-corr
 : cum-max ( seq -- seq' )
     [ ?first ] keep [ max dup ] map nip ;
 
-: entropy ( seq -- n )
-    histogram values dup sum '[ _ / dup log * ] map-sum neg ;
+: probabilities ( seq -- probabilities )
+    [ histogram values ] [ length ] bi v/n ;
+
+: entropy ( probabilities -- n )
+    dup sum '[ _ / dup log * ] map-sum neg ;
+
+: maximum-entropy ( probabilities -- n )
+    length log ;
+
+: normalized-entropy ( probabilities -- n )
+    [ entropy ] [ maximum-entropy ] bi / ;
 
 : binary-entropy ( p -- h )
     [ dup log * ] [ 1 swap - dup log * ] bi + neg 2 log / ;