math.statistics: some fixes to entropy, adding maximum-entropy and normalized-entropy.

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index b9cf7c4546d16a59813084bae34d208b86661ee6..e18129526237dfadba067e68aa7bb746ed441c29 100644 (file)
--- 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 1a12ae0b00c21e2a4e6c0056885b04958a7a2007..651b450185c190dd9fa067f10d53216f157f4077 100644 (file)
--- 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 / ;