From 7aa7b08d425d7c0ca67ba29372acd97a346fc343 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 9 Apr 2011 23:51:14 -0500
Subject: [PATCH] Change how sequence>assoc and friends work. Now they take two
 quotations, the first of which prepares the key/value pair and the second
 insert it into the assoc. mrjbq7's group-by, formerly collect-values, is now
 called collect-by.

---
 basis/math/statistics/statistics-docs.factor | 19 ++++++-------
 basis/math/statistics/statistics.factor      | 28 +++++++++++---------
 2 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor
index 63263e603c..c43106a977 100644
--- a/basis/math/statistics/statistics-docs.factor
+++ b/basis/math/statistics/statistics-docs.factor
@@ -112,41 +112,42 @@ HELP: sorted-histogram
 
 HELP: sequence>assoc
 { $values
-    { "seq" sequence } { "quot" quotation } { "exemplar" "an exemplar assoc" }
+    { "seq" sequence } { "quot1" quotation } { "quot2" quotation } { "exemplar" "an exemplar assoc" }
     { "assoc" assoc }
 }
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } " according to the passed quotation." }
+{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } ". The first quotation gets passed an element from the sequence and should output whatever the second quotation needs, e.g. ( element -- value key ) if the second quotation is inserting into an assoc." }
 { $examples
     { $example "! Iterate over a sequence and increment the count at each element"
+               "! The first quotation has stack effect ( key -- key ), a no-op"
                "USING: assocs prettyprint math.statistics ;"
-               "\"aaabc\" [ inc-at ] H{ } sequence>assoc ."
+               "\"aaabc\" [ ] [ inc-at ] H{ } sequence>assoc ."
                "H{ { 97 3 } { 98 1 } { 99 1 } }"
     }
 } ;
 
 HELP: sequence>assoc!
 { $values
-    { "assoc" assoc } { "seq" sequence } { "quot" quotation }
+    { "assoc" assoc } { "seq" sequence } { "quot1" quotation } { "quot2" quotation }
 }
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } " according to the passed quotation." }
+{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } ". The first quotation gets passed an element from the sequence and should output whatever the second quotation needs, e.g. ( element -- value key ) if the second quotation is inserting into an assoc." }
 { $examples
     { $example "! Iterate over a sequence and add the counts to an existing assoc"
                "USING: assocs prettyprint math.statistics kernel ;"
-               "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc! ."
+               "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ ] [ inc-at ] sequence>assoc! ."
                "H{ { 97 5 } { 98 2 } { 99 1 } }"
     }
 } ;
 
 HELP: sequence>hashtable
 { $values
-    { "seq" sequence } { "quot" quotation }
+    { "seq" sequence } { "quot1" quotation } { "quot2" quotation }
     { "hashtable" hashtable }
 }
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a hashtable according to the passed quotation." }
+{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a hashtable according a combination of the first and second quotations. The quot1 is passed each element, and quot2 gets the hashtable on the top of the stack with quot1's results underneath for inserting into the hashtable." }
 { $examples
     { $example "! Count the number of times an element occurs in a sequence"
                "USING: assocs prettyprint math.statistics ;"
-               "\"aaabc\" [ inc-at ] sequence>hashtable ."
+               "\"aaabc\" [ ] [ inc-at ] sequence>hashtable ."
                "H{ { 97 3 } { 98 1 } { 99 1 } }"
     }
 } ;
diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index e5b5fb0872..ae7114423b 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Michael Judge.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel math math.functions
-math.order sequences sorting locals sequences.private
-assocs fry ;
+USING: assocs combinators generalizations kernel locals math
+math.functions math.order sequences sequences.private sorting ;
 IN: math.statistics
 
 : mean ( seq -- x )
@@ -59,31 +58,34 @@ IN: math.statistics
 
 <PRIVATE
 
-: (sequence>assoc) ( seq quot assoc -- assoc )
-    [ swap curry each ] keep ; inline
+: (sequence>assoc) ( seq quot1 quot2 assoc -- assoc )
+    [ swap curry compose each ] keep ; inline
 
 PRIVATE>
 
-: sequence>assoc! ( assoc seq quot: ( obj assoc -- ) -- assoc )
-    rot (sequence>assoc) ; inline
+: sequence>assoc! ( assoc seq quot1 quot2 -- assoc )
+    4 nrot (sequence>assoc) ; inline
 
-: sequence>assoc ( seq quot: ( obj assoc -- ) exemplar -- assoc )
+: sequence>assoc ( seq quot1 quot2 exemplar -- assoc )
     clone (sequence>assoc) ; inline
 
-: sequence>hashtable ( seq quot: ( obj hashtable -- ) -- hashtable )
+: sequence>hashtable ( seq quot1 quot2 -- hashtable )
     H{ } sequence>assoc ; inline
 
 : histogram! ( hashtable seq -- hashtable )
-    [ inc-at ] sequence>assoc! ;
+    [ ] [ inc-at ] sequence>assoc! ;
 
 : histogram ( seq -- hashtable )
-    [ inc-at ] sequence>hashtable ;
+    [ ] [ inc-at ] sequence>hashtable ;
 
 : sorted-histogram ( seq -- alist )
     histogram >alist sort-values ;
 
-: collect-values ( seq quot: ( obj hashtable -- ) -- hash )
-    '[ [ dup @ ] dip push-at ] sequence>hashtable ; inline
+: collect-pairs ( seq quot -- hashtable )
+    [ push-at ] sequence>hashtable ; inline
+
+: collect-by ( seq quot -- hashtable )
+    [ dup ] prepose collect-pairs ; inline
 
 : mode ( seq -- x )
     histogram >alist