math.statistics: adding entropy function.

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 5f9a7947d4c3c126fea7990480d0c72820fee510..6b96b5e61e15d27064b669ad24265ffca8d4d3d1 100644 (file)
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -136,3 +136,7 @@ IN: math.statistics.tests
     { 18.9375 40.0 42.8125 } .00001 v~
 ] unit-test
 
+{ 1.0986122886681096 } [ { 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 005d8a883e87e8a5a9c2bc40239f91bfa71e20f6..13a796396ce2a9aea1f9b7f59ced754603f33d47 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs combinators generalizations kernel locals math
 math.functions math.order math.vectors sequences
-sequences.private sorting fry arrays grouping ;
+sequences.private sorting fry arrays grouping sets ;
 IN: math.statistics
 
 : mean ( seq -- x )
@@ -275,3 +275,10 @@ ERROR: empty-sequence ;
 
 : cum-max ( seq -- seq' )
     [ ?first ] keep [ max dup ] map nip ;
+
+: entropy ( seq -- n )
+    dup members [ [ = ] curry count ] with map
+    dup sum v/n dup [ log ] map v* sum neg ;
+
+: binary-entropy ( p -- h )
+    [ dup log * ] [ 1 swap - dup log * ] bi + neg 2 log / ;