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

math.statistics: adding winsorized-mean.

db4
John Benediktsson 2012-05-08 08:48:15 -07:00
parent 4c2d01c5ec
commit 07b0d52f55
2 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,8 +11,9 @@ IN: math.statistics.tests
[ 1.0 ] [ { 1 1 1 } geometric-mean ] unit-test [ 1.0 ] [ { 1 1 1 } geometric-mean ] unit-test
[ 1/3 ] [ { 1 1 1 } harmonic-mean ] unit-test [ 1/3 ] [ { 1 1 1 } harmonic-mean ] unit-test
[ 5+1/4 ] [ { 1 3 5 7 } contraharmonic-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 [ 18 ] [ { 4 8 15 16 23 42 } 0 trimmed-mean ] unit-test
[ 15+1/2 ] [ { 4 8 15 16 23 42 } 0.2 trim-mean ] unit-test [ 15+1/2 ] [ { 4 8 15 16 23 42 } 0.2 trimmed-mean ] unit-test
[ 3 ] [ { 1 3 3 3 3 5 } 0.2 winsorized-mean ] unit-test
[ 0 ] [ { 1 } range ] unit-test [ 0 ] [ { 1 } range ] unit-test
[ 89 ] [ { 1 2 30 90 } range ] unit-test [ 89 ] [ { 1 2 30 90 } range ] unit-test

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

@ -32,8 +32,22 @@ IN: math.statistics
: contraharmonic-mean ( seq -- x ) : contraharmonic-mean ( seq -- x )
[ sum-of-squares ] [ sum ] bi / ; inline [ sum-of-squares ] [ sum ] bi / ; inline
: trim-mean ( seq p -- x ) <PRIVATE
swap [ length [ * >integer ] keep over - ] keep <slice> mean ;
: trim-points ( p seq -- from to seq )
[ length [ * >integer ] keep over - ] keep ;
PRIVATE>
: trimmed-mean ( seq p -- x )
swap natural-sort trim-points <slice> mean ;
: winsorized-mean ( seq p -- x )
swap natural-sort trim-points
[ <slice> ]
[ nip dupd nth <array> ]
[ [ 1 - ] dip nth <array> ] 3tri
surround mean ;
<PRIVATE <PRIVATE