math.statistics: refactor histogram and histogram-by to use

histogram-by!

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 0166d577e316569cc6067ad998cd9864509aad8c..1595d3ab6cd3e0d17f77a2e2b9c42dc6d1eb08f7 100644 (file)
--- a/basis/math/statistics/statistics-tests.factor
+++ b/basis/math/statistics/statistics-tests.factor
@@ -104,12 +104,31 @@ IN: math.statistics
 
 {
     H{
-        { 97 2 }
+        { 97 5 }
         { 98 2 }
         { 99 2 }
     }
 } [
     "aabbcc" histogram
+    "aaa" histogram!
+] unit-test
+
+{
+    H{
+        { 97 5 }
+        { 98 2 }
+        { 99 2 }
+    }
+} [
+    "aabbcc" [ ] histogram-by
+    "aaa" [ ] histogram-by!
+] unit-test
+
+{
+    H{ { t 2 } { f 7 } }
+} [
+    "aabbcc" [ even? ] histogram-by
+    "aaa" [ even? ] histogram-by!
 ] unit-test
 
 { H{ { 1 1/2 } { 2 1/6 } { 3 1/3 } } }

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 8be9dae79b86c1e74d0d85c76f583297d06f1e78..e9a61a9628d2ab516ac3e1db1c240f83a4a3ce18 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -251,11 +251,14 @@ PRIVATE>
 : trimean ( seq -- x )
     quartile first3 [ 2 * ] dip + + 4 / ;
 
+: histogram-by! ( assoc seq quot: ( x -- bin ) -- hashtable )
+    rot [ '[ @ _ inc-at ] each ] keep ; inline
+
 : histogram! ( hashtable seq -- hashtable )
-    over '[ _ inc-at ] each ;
+    [ ] histogram-by! ; inline
 
 : histogram-by ( seq quot: ( x -- bin ) -- hashtable )
-    H{ } clone [ '[ @ _ inc-at ] each ] keep ; inline
+    [ H{ } clone ] 2dip histogram-by! ; inline
 
 : histogram ( seq -- hashtable )
     [ ] histogram-by ;