From 5878b6982b16f2b7d4211a75382403d1d920ccd4 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 26 Apr 2012 18:40:59 -0700
Subject: [PATCH] math.statistics: adding entropy function.

---
 basis/math/statistics/statistics-tests.factor | 4 ++++
 basis/math/statistics/statistics.factor       | 9 ++++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 5f9a7947d4..6b96b5e61e 100644
--- 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 005d8a883e..13a796396c 100644
--- 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 / ;