From 4339b14d774ee719bc1dc0af04bd4835593a0bea Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 4 May 2012 14:40:24 -0700
Subject: [PATCH] math.statistics: adding mean-dev and median-dev.

---
 basis/math/statistics/statistics-tests.factor |  3 +++
 basis/math/statistics/statistics.factor       | 24 +++++++++++--------
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 4aa42dede5..de5ffa84ac 100644
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -58,6 +58,9 @@ IN: math.statistics.tests
 [ 0.0 ] [ { 1 } std ] unit-test
 [ 0.0 ] [ { 1 } ste ] unit-test
 
+{ 2 } [ { 1 3 5 7 } mean-dev ] unit-test
+{ 4/5 } [ { 1 3 3 3 5 } median-dev ] unit-test
+
 [
     H{
         { 97 2 }
diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 4655aa7d65..dad1f75ce6 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -45,7 +45,7 @@ IN: math.statistics
         k i < [ j m! ] when
     ] while
     k seq nth ; inline
-    
+
 : (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt )
     [ clone ] 4dip ((kth-object)) ; inline
 
@@ -66,9 +66,9 @@ PRIVATE>
     '[ [ nth ] [ exchange ]  _ ((kth-object)) ] with map ; inline
 
 : kth-smallests ( seq kths -- elts ) [ < ] kth-objects-unsafe ;
-    
+
 : kth-smallest ( seq k -- elt ) [ < ] kth-object-unsafe ;
-    
+
 : kth-largests ( seq kths -- elts ) [ > ] kth-objects-unsafe ;
 
 : kth-largest ( seq k -- elt ) [ > ] kth-object-unsafe ;
@@ -90,11 +90,11 @@ PRIVATE>
             { +eq+ [ [ 1 + ] 4dip drop ] }
         } case
     ] each ;
-    
+
 : lower-median-index ( seq -- n )    
     [ midpoint@ ]
     [ length odd? [ 1 - ] unless ] bi ;
-    
+
 : lower-median ( seq -- elt )
     [ ] [ lower-median-index ] bi kth-smallest ;
 
@@ -125,15 +125,15 @@ PRIVATE>
 
 :: quantile-indices ( seq qs a b c d -- seq )
     qs [ [ a b seq length ] dip quantile-x ] map ;
-    
+
 :: qabcd ( y-floor y-ceiling x c d -- qabcd )
     y-floor y-ceiling y-floor - c d x frac * + * + ;
-    
+
 :: quantile-abcd ( seq qs a b c d -- quantile )
     seq qs a b c d quantile-indices :> indices
     indices [ [ floor ] [ ceiling ] bi 2array ] map
     concat :> index-pairs
-    
+
     seq index-pairs kth-smallests
     2 group indices [ [ first2 ] dip c d qabcd ] 2map ;
 
@@ -160,10 +160,10 @@ PRIVATE>
 
 : quantile9 ( seq qs -- seq' )
     3/8 1/4 0 1 quantile-abcd ;
-    
+
 : quartile ( seq -- seq' )
     { 1/4 1/2 3/4 } quantile5 ;
-    
+
 <PRIVATE
 
 : (sequence>assoc) ( seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) assoc -- assoc )
@@ -239,6 +239,10 @@ ALIAS: var sample-var
 
 ALIAS: std sample-std
 
+: mean-dev ( seq -- x ) dup mean v-n vabs mean ;
+
+: median-dev ( seq -- x ) dup median v-n vabs mean ;
+
 : sample-ste ( seq -- x ) [ sample-std ] [ length ] bi sqrt / ;
 
 : full-ste ( seq -- x ) [ full-std ] [ length ] bi sqrt / ;