From 4c2d01c5ec5b1808eea7768622034edf52d0c1ed Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 8 May 2012 08:24:57 -0700
Subject: [PATCH] math.statistics: adding trim-mean and signal-to-noise.

---
 basis/math/statistics/statistics-tests.factor | 2 ++
 basis/math/statistics/statistics.factor       | 5 +++++
 2 files changed, 7 insertions(+)

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 63c9bfa388..9fe8b02ecc 100644
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -11,6 +11,8 @@ 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
 
 [ 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 2a2ed8b95c..209e6d3345 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -32,6 +32,9 @@ 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
 
 :: ((kth-object)) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt )
@@ -255,6 +258,8 @@ ALIAS: var sample-var
 
 ALIAS: std sample-std
 
+: signal-to-noise ( seq -- x ) [ mean ] [ std ] bi / ;
+
 : mean-dev ( seq -- x ) dup mean v-n vabs mean ;
 
 : median-dev ( seq -- x ) dup median v-n vabs mean ;