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

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

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

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 / ;