math.statistics: sum-of-squares, sum-of-cubes, sum-of-quads.

Also, meanest.

diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor
index 021e470543f5b7d870c59a1b4976b5bd06c6a0c6..4abf7cff205ef90b1c81adab5077c3092c1c6339 100644 (file)
--- a/basis/math/statistics/statistics-docs.factor
+++ b/basis/math/statistics/statistics-docs.factor
@@ -317,3 +317,5 @@ ABOUT: "math.statistics"
 { ste-ddof population-ste sample-ste } related-words
 { corr-ddof population-corr sample-corr } related-words
 { cov-ddof population-cov sample-cov } related-words
+
+{ sum-of-squares sum-of-cubes sum-of-quads } related-words

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 68fdac4f4b9bfb1aedf7cc48991e51c2e6be3a76..965a4e095cbb65e9b20e2ccd7a4b1178ead5125b 100644 (file)
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -22,6 +22,15 @@ IN: math.statistics
 { 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
 
+{ 2470 } [ 20 <iota> sum-of-squares ] unit-test
+{ 2470 } [ 20 <iota> >array sum-of-squares ] unit-test
+
+{ 36100 } [ 20 <iota> sum-of-cubes ] unit-test
+{ 36100 } [ 20 <iota> >array sum-of-cubes ] unit-test
+
+{ 562666 } [ 20 <iota> sum-of-quads ] unit-test
+{ 562666 } [ 20 <iota> >array sum-of-quads ] unit-test
+
 { 0 } [ { 1 } range ] unit-test
 { 89 } [ { 1 2 30 90 } range ] unit-test
 { 2 } [ { 1 2 3 } median ] unit-test
@@ -226,4 +235,4 @@ IN: math.statistics
 { 0.0 } [ { 0 } ndcg ] unit-test
 
 { t } [ { 3 2 3 0 1 2 } dcg 6.861126688593501 1e-6 ~ ] unit-test
-{ t } [ { 3 2 3 0 1 2 } ndcg 0.9608081943360615 1e-6 ~ ] unit-test
\ No newline at end of file
+{ t } [ { 3 2 3 0 1 2 } ndcg 0.9608081943360615 1e-6 ~ ] unit-test

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 30acf837926489a8628fd0430922e4a248485dc2..5d71711679c9486138999fc3e91cb76807485787 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman, Michael Judge, Loryn Jenkins.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs combinators fry generalizations grouping
-kernel locals math math.functions math.order math.vectors
-sequences sequences.private sorting ;
+USING: accessors arrays assocs combinators fry generalizations
+grouping kernel locals math math.functions math.order
+math.vectors sequences sequences.private sorting ;
 FROM: math.ranges => [a,b] ;
 IN: math.statistics
 
@@ -17,8 +17,30 @@ IN: math.statistics
 : mean ( seq -- x )
     0 mean-ddof ; inline
 
-: sum-of-squares ( seq -- x )
-    [ sq ] map-sum ; inline
+: meanest ( seq -- x )
+    [ mean ] keep [ - abs ] with infimum-by ;
+
+GENERIC: sum-of-squares ( seq -- x )
+M: object sum-of-squares [ sq ] map-sum ;
+M: iota sum-of-squares
+    n>> 1 - [ ] [ 1 + ] [ 1/2 + ] tri * * 3 / ;
+
+GENERIC: sum-of-cubes ( seq -- x )
+M: object sum-of-cubes [ 3 ^ ] map-sum ;
+M: iota sum-of-cubes sum sq ;
+
+GENERIC: sum-of-quads ( seq -- x )
+M: object sum-of-quads [ 4 ^ ] map-sum ;
+M: iota sum-of-quads
+    [let n>> 1 - :> n
+        n 0 > [
+            n
+            n 1 +
+            n 2 * 1 +
+            n sq 3 * n 3 * + 1 -
+            * * * 30 /
+        ] [ 0 ] if
+    ] ;
 
 : sum-of-squared-errors ( seq -- x )
     [ mean ] keep [ - sq ] with map-sum ; inline

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 75caa52676fbdac6a36d4ff2a3126f83de92d690..f89cfd67b025ffb6682b7f3ab388f3548d986a61 100644 (file)
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -133,12 +133,6 @@ tools.test ;
 { 4.0 } [ { 1e-30 1 3 -1e-30 } sum-floats ] unit-test
 { 1.0000000000000002e16 } [ { 1e-16 1 1e16 } sum-floats ] unit-test
 
-{ 2470 } [ 20 <iota> sum-squares ] unit-test
-{ 2470 } [ 20 <iota> >array sum-squares ] unit-test
-
-{ 36100 } [ 20 <iota> sum-cubes ] unit-test
-{ 36100 } [ 20 <iota> >array sum-cubes ] unit-test
-
 {
     {
         1 -1 -1 0 -1 1 -1 0 0 1 -1 0 -1 1 1

diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index e9d9f43162238110d741f49e1f780de1227e7d6b..9a986a979f849d298dbd8b68ec5bc76ed103b7df 100644 (file)
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -341,15 +341,6 @@ PRIVATE>
 ! SYNTAX: .. dup pop scan-object [a,b) suffix! ;
 ! SYNTAX: ... dup pop scan-object [a,b] suffix! ;
 
-GENERIC: sum-squares ( seq -- n )
-M: object sum-squares [ sq ] map-sum ;
-M: iota sum-squares
-    length 1 - [ ] [ 1 + ] [ 1/2 + ] tri * * 3 / ;
-
-GENERIC: sum-cubes ( seq -- n )
-M: object sum-cubes [ 3 ^ ] map-sum ;
-M: iota sum-cubes sum sq ;
-
 : mobius ( n -- x )
     group-factors values [ 1 ] [
         dup [ 1 > ] any?