math.statistics: adding winsorized-mean.

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 9fe8b02ecc848b6198bafb2f8c928d83a920e8fc..716800f000c194940da577e524789a75143641a7 100644 (file)
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -11,8 +11,9 @@ IN: math.statistics.tests
 [ 1.0 ] [ { 1 1 1 } geometric-mean ] unit-test
 [ 1/3 ] [ { 1 1 1 } harmonic-mean ] unit-test
 [ 5+1/4 ] [ { 1 3 5 7 } contraharmonic-mean ] unit-test
-[ 18 ] [ { 4 8 15 16 23 42 } 0 trim-mean ] unit-test
-[ 15+1/2 ] [ { 4 8 15 16 23 42 } 0.2 trim-mean ] unit-test
+[ 18 ] [ { 4 8 15 16 23 42 } 0 trimmed-mean ] unit-test
+[ 15+1/2 ] [ { 4 8 15 16 23 42 } 0.2 trimmed-mean ] unit-test
+[ 3 ] [ { 1 3 3 3 3 5 } 0.2 winsorized-mean ] unit-test
 
 [ 0 ] [ { 1 } range ] unit-test
 [ 89 ] [ { 1 2 30 90 } range ] unit-test

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 209e6d33453e4fc4abd5031b528e0ee44fe270d7..4fb282ad0594990c129a6a6ca4dc1b83ee301764 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -32,8 +32,22 @@ IN: math.statistics
 : contraharmonic-mean ( seq -- x )
     [ sum-of-squares ] [ sum ] bi / ; inline
 
-: trim-mean ( seq p -- x )
-    swap [ length [ * >integer ] keep over - ] keep <slice> mean ;
+<PRIVATE
+
+: trim-points ( p seq -- from to seq  )
+    [ length [ * >integer ] keep over - ] keep ;
+
+PRIVATE>
+
+: trimmed-mean ( seq p -- x )
+    swap natural-sort trim-points <slice> mean ;
+
+: winsorized-mean ( seq p -- x )
+    swap natural-sort trim-points
+    [ <slice> ]
+    [ nip dupd nth <array> ]
+    [ [ 1 - ] dip nth <array> ] 3tri
+    surround mean ;
 
 <PRIVATE