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

db4
John Benediktsson 2012-04-02 17:12:32 -07:00
parent 30d8b5211e
commit 57231bfef4
3 changed files with 35 additions and 4 deletions

View File

@ -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

View File

@ -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

View File

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