diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor index 9fe8b02ecc..716800f000 100644 --- a/basis/math/statistics/statistics-tests.factor +++ b/basis/math/statistics/statistics-tests.factor @@ -11,8 +11,9 @@ IN: math.statistics.tests [ 1.0 ] [ { 1 1 1 } geometric-mean ] unit-test [ 1/3 ] [ { 1 1 1 } harmonic-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 -[ 15+1/2 ] [ { 4 8 15 16 23 42 } 0.2 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 trimmed-mean ] unit-test +[ 3 ] [ { 1 3 3 3 3 5 } 0.2 winsorized-mean ] unit-test [ 0 ] [ { 1 } range ] unit-test [ 89 ] [ { 1 2 30 90 } range ] unit-test diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 209e6d3345..4fb282ad05 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -32,8 +32,22 @@ IN: math.statistics : contraharmonic-mean ( seq -- x ) [ sum-of-squares ] [ sum ] bi / ; inline -: trim-mean ( seq p -- x ) - swap [ length [ * >integer ] keep over - ] keep mean ; +integer ] keep over - ] keep ; + +PRIVATE> + +: trimmed-mean ( seq p -- x ) + swap natural-sort trim-points mean ; + +: winsorized-mean ( seq p -- x ) + swap natural-sort trim-points + [ ] + [ nip dupd nth ] + [ [ 1 - ] dip nth ] 3tri + surround mean ;