steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.statistics: adding mean-dev and median-dev.

db4
John Benediktsson 2012-05-04 14:40:24 -07:00
parent bacdd691fc
commit 4339b14d77
2 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/math/statistics/statistics-tests.factor
View File

@ -58,6 +58,9 @@ IN: math.statistics.tests
[ 0.0 ] [ { 1 } std ] unit-test [ 0.0 ] [ { 1 } std ] unit-test
[ 0.0 ] [ { 1 } ste ] unit-test [ 0.0 ] [ { 1 } ste ] unit-test
{ 2 } [ { 1 3 5 7 } mean-dev ] unit-test
{ 4/5 } [ { 1 3 3 3 5 } median-dev ] unit-test
[ [
H{ H{
{ 97 2 } { 97 2 }

24
basis/math/statistics/statistics.factor
View File

@ -45,7 +45,7 @@ IN: math.statistics
k i < [ j m! ] when k i < [ j m! ] when
] while ] while
k seq nth ; inline k seq nth ; inline
: (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt ) : (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt )
[ clone ] 4dip ((kth-object)) ; inline [ clone ] 4dip ((kth-object)) ; inline
@ -66,9 +66,9 @@ PRIVATE>
'[ [ nth ] [ exchange ] _ ((kth-object)) ] with map ; inline '[ [ nth ] [ exchange ] _ ((kth-object)) ] with map ; inline
: kth-smallests ( seq kths -- elts ) [ < ] kth-objects-unsafe ; : kth-smallests ( seq kths -- elts ) [ < ] kth-objects-unsafe ;
: kth-smallest ( seq k -- elt ) [ < ] kth-object-unsafe ; : kth-smallest ( seq k -- elt ) [ < ] kth-object-unsafe ;
: kth-largests ( seq kths -- elts ) [ > ] kth-objects-unsafe ; : kth-largests ( seq kths -- elts ) [ > ] kth-objects-unsafe ;
: kth-largest ( seq k -- elt ) [ > ] kth-object-unsafe ; : kth-largest ( seq k -- elt ) [ > ] kth-object-unsafe ;
@ -90,11 +90,11 @@ PRIVATE>
{ +eq+ [ [ 1 + ] 4dip drop ] } { +eq+ [ [ 1 + ] 4dip drop ] }
} case } case
] each ; ] each ;
: lower-median-index ( seq -- n ) : lower-median-index ( seq -- n )
[ midpoint@ ] [ midpoint@ ]
[ length odd? [ 1 - ] unless ] bi ; [ length odd? [ 1 - ] unless ] bi ;
: lower-median ( seq -- elt ) : lower-median ( seq -- elt )
[ ] [ lower-median-index ] bi kth-smallest ; [ ] [ lower-median-index ] bi kth-smallest ;
@ -125,15 +125,15 @@ PRIVATE>
:: quantile-indices ( seq qs a b c d -- seq ) :: quantile-indices ( seq qs a b c d -- seq )
qs [ [ a b seq length ] dip quantile-x ] map ; qs [ [ a b seq length ] dip quantile-x ] map ;
:: qabcd ( y-floor y-ceiling x c d -- qabcd ) :: qabcd ( y-floor y-ceiling x c d -- qabcd )
y-floor y-ceiling y-floor - c d x frac * + * + ; y-floor y-ceiling y-floor - c d x frac * + * + ;
:: quantile-abcd ( seq qs a b c d -- quantile ) :: quantile-abcd ( seq qs a b c d -- quantile )
seq qs a b c d quantile-indices :> indices seq qs a b c d quantile-indices :> indices
indices [ [ floor ] [ ceiling ] bi 2array ] map indices [ [ floor ] [ ceiling ] bi 2array ] map
concat :> index-pairs concat :> index-pairs
seq index-pairs kth-smallests seq index-pairs kth-smallests
2 group indices [ [ first2 ] dip c d qabcd ] 2map ; 2 group indices [ [ first2 ] dip c d qabcd ] 2map ;
@ -160,10 +160,10 @@ PRIVATE>
: quantile9 ( seq qs -- seq' ) : quantile9 ( seq qs -- seq' )
3/8 1/4 0 1 quantile-abcd ; 3/8 1/4 0 1 quantile-abcd ;
: quartile ( seq -- seq' ) : quartile ( seq -- seq' )
{ 1/4 1/2 3/4 } quantile5 ; { 1/4 1/2 3/4 } quantile5 ;
<PRIVATE <PRIVATE
: (sequence>assoc) ( seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) assoc -- assoc ) : (sequence>assoc) ( seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) assoc -- assoc )
@ -239,6 +239,10 @@ ALIAS: var sample-var
ALIAS: std sample-std ALIAS: std sample-std
: mean-dev ( seq -- x ) dup mean v-n vabs mean ;
: median-dev ( seq -- x ) dup median v-n vabs mean ;
: sample-ste ( seq -- x ) [ sample-std ] [ length ] bi sqrt / ; : sample-ste ( seq -- x ) [ sample-std ] [ length ] bi sqrt / ;
: full-ste ( seq -- x ) [ full-std ] [ length ] bi sqrt / ; : full-ste ( seq -- x ) [ full-std ] [ length ] bi sqrt / ;