From 86a1b06034069e7b9506040239a19740864a20fa Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 24 May 2009 15:45:25 -0500
Subject: [PATCH] add a mode word

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

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index c160d57db7..32ebcbc6a1 100644
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -13,6 +13,9 @@ IN: math.statistics.tests
 [ 2 ] [ { 1 2 3 } median ] unit-test
 [ 5/2 ] [ { 1 2 3 4 } median ] unit-test
 
+[ 1 ] [ { 1 } mode ] unit-test
+[ 3 ] [ { 1 2 3 3 3 4 5 6 76 7 2 21 1 3 3 3 } mode ] unit-test
+
 [ { } median ] must-fail
 [ { } upper-median ] must-fail
 [ { } lower-median ] must-fail
diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 3812e79ec5..a1a214b2c0 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: arrays combinators kernel math math.analysis
 math.functions math.order sequences sorting locals
-sequences.private ;
+sequences.private assocs fry ;
 IN: math.statistics
 
 : mean ( seq -- x )
@@ -56,6 +56,13 @@ IN: math.statistics
 : median ( seq -- x )
     dup length odd? [ lower-median ] [ medians + 2 / ] if ;
 
+: frequency ( seq -- hashtable )
+    H{ } clone [ '[ _ inc-at ] each ] keep ;
+
+: mode ( seq -- x )
+    frequency >alist
+    [ ] [ [ [ second ] bi@ > ] 2keep ? ] map-reduce first ;
+
 : minmax ( seq -- min max )
     #! find the min and max of a seq in one pass
     [ 1/0. -1/0. ] dip [ [ min ] [ max ] bi-curry bi* ] each ;