From ac7e79ae9b625d4c3067ed85cb170714a5425c59 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 7 Aug 2022 16:17:13 -0500
Subject: [PATCH] math.statistics: refactor histogram and histogram-by to use
 histogram-by!

---
 basis/math/statistics/statistics-tests.factor | 21 ++++++++++++++++++-
 basis/math/statistics/statistics.factor       |  7 +++++--
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor
index 0166d577e3..1595d3ab6c 100644
--- 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 8be9dae79b..e9a61a9628 100644
--- 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 ;
-- 
2.34.1