math.statistics: change 'var' to 'sample-var' and implement variance, covariance...

diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor
index e17d046852de865729a3c89a7965b3ce791be776..5a9729d9f94bb622883cab1dae270219f367ff62 100644 (file)
--- a/basis/math/statistics/statistics-docs.factor
+++ b/basis/math/statistics/statistics-docs.factor
@@ -69,6 +69,13 @@ HELP: var
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } var ." "1" }
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } var ." "1+2/3" } } ;
 
+HELP: cov
+{ $values { "{x}" sequence } { "{y}" sequence } { "x" "a real number" } }
+{ $description "Computes the covariance of two sequences, " { $snippet "{x}" } " and " { $snippet "{y}" } "." } ;
+
+HELP: corr
+{ $values { "{x}" sequence } { "{y}" sequence } { "x" "a real number" } }
+{ $description "Computes the correlation of two sequences, " { $snippet "{x}" } " and " { $snippet "{y}" } "." } ;
 
 HELP: histogram
 { $values

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index ec6cda05b1d42206737b0dea2bcd74267c1e6eeb..5b7606eab6d213dd35d21a4ca51c10e2a1b01efa 100644 (file)
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -34,8 +34,11 @@ IN: math.statistics.tests
 [ 2 ] [ { 1 2 } upper-median ] unit-test
 [ 3/2 ] [ { 1 2 } median ] unit-test
 
-[ 1 ] [ { 1 2 3 } var ] unit-test
-[ 1.0 ] [ { 1 2 3 } std ] unit-test
+[ 1 ] [ { 1 2 3 } sample-var ] unit-test
+[ 16 ] [ { 4 6 8 10 10 12 14 16 } sample-var ] unit-test
+
+[ 16 ] [ { 4 6 8 10 12 14 16 } var ] unit-test
+[ 4.0 ] [ { 4 6 8 10 12 14 16 } std ] unit-test
 [ t ] [ { 1 2 3 4 } ste 0.6454972243679028 - .0001 < ] unit-test
 
 [ t ] [ { 23.2 33.4 22.5 66.3 44.5 } std 18.1906 - .0001 < ] unit-test
@@ -62,3 +65,9 @@ IN: math.statistics.tests
     10 iota [ 3 mod ] collect-by
     [ 0 swap at ] [ 1 swap at ] [ 2 swap at ] tri
 ] unit-test
+
+[ 0 ] [ { 1 } { 1 } cov ] unit-test
+[ 2/3 ] [ { 1 2 3 } { 4 5 6 } cov ] unit-test
+
+[ 1.0 ] [ { 1 2 3 } { 1 2 3 } corr ] unit-test
+[ -1.0 ] [ { 1 2 3 } { -4 -5 -6 } corr ] unit-test

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 54edff34a44d57f5ff444385ca56b7b6166f7cbd..f14a2c368029d06aa36ca5282e2f52ac0e09f980 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman, Michael Judge.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs combinators generalizations kernel locals math
-math.functions math.order sequences sequences.private sorting ;
+math.functions math.order math.vectors sequences
+sequences.private sorting ;
 IN: math.statistics
 
 : mean ( seq -- x )
@@ -106,7 +107,7 @@ ERROR: empty-sequence ;
 : range ( seq -- x )
     minmax swap - ;
 
-: var ( seq -- x )
+: sample-var ( seq -- x )
     #! normalize by N-1
     dup length 1 <= [
         drop 0
@@ -115,6 +116,14 @@ ERROR: empty-sequence ;
         [ length 1 - ] bi /
     ] if ;
 
+: var ( seq -- x )
+    dup length 1 <= [
+        drop 0
+    ] [
+        [ [ mean ] keep [ - sq ] with map-sum ]
+        [ length ] bi /
+    ] if ;
+
 : std ( seq -- x ) var sqrt ;
 
 : ste ( seq -- x ) [ std ] [ length ] bi sqrt / ;
@@ -141,3 +150,9 @@ ERROR: empty-sequence ;
     [ (r) ] 2keep ! stack is mean(x) mean(y) r sx sy
     swap / * ! stack is mean(x) mean(y) beta
     [ swapd * - ] keep ;
+
+: cov ( {x} {y} -- cov )
+    [ dup mean v-n ] bi@ v* mean ;
+
+: corr ( {x} {y} -- corr )
+     [ cov ] [ [ var ] bi@ * sqrt ] 2bi / ;