From da6ce99db9ac21b417262f5d23e605aee391b70e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 16 Jan 2014 06:23:49 -0800
Subject: * hash.c (group_by): New function.

* hash.h (group_by): Declared.

* eval.c (eval_init): group_by registered as group-by intrinsic.

* txr.1: Documented.
---
 ChangeLog | 10 ++++++++++
 eval.c    |  1 +
 hash.c    | 29 +++++++++++++++++++++++++++++
 hash.h    |  1 +
 txr.1     | 31 +++++++++++++++++++++++++++++++
 5 files changed, 72 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 60977626..ee79b4be 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2014-01-16  Kaz Kylheku  <kaz@kylheku.com>
+
+	* hash.c (group_by): New function.
+
+	* hash.h (group_by): Declared.
+
+	* eval.c (eval_init): group_by registered as group-by intrinsic.
+
+	* txr.1: Documented.
+
 2014-01-16  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 75
diff --git a/eval.c b/eval.c
index 3e51f600..f57a6f78 100644
--- a/eval.c
+++ b/eval.c
@@ -2437,6 +2437,7 @@ void eval_init(void)
   reg_fun(intern(lit("hash-uni"), user_package), func_n2(hash_uni));
   reg_fun(intern(lit("hash-diff"), user_package), func_n2(hash_diff));
   reg_fun(intern(lit("hash-isec"), user_package), func_n2(hash_isec));
+  reg_fun(intern(lit("group-by"), user_package), func_n2v(group_by));
 
   reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1));
   reg_fun(intern(lit("lisp-parse"), user_package), func_n2o(lisp_parse, 0));
diff --git a/hash.c b/hash.c
index 3721baf4..21168c0c 100644
--- a/hash.c
+++ b/hash.c
@@ -684,6 +684,35 @@ val hash_construct(val hashv_args, val pairs)
   return hash;
 }
 
+val group_by(val func, val seq, val hashv_args)
+{
+  val hash = hashv(hashv_args);
+
+  if (vectorp(seq)) {
+    cnum i, len;
+
+    for (i = 0, len = c_num(length(seq)); i < len; i++) {
+      val v = vecref(seq, num_fast(i));
+      pushhash(hash, funcall1(func, v), v);
+    }
+  } else {
+    for (; seq; seq = cdr(seq)) {
+      val v = car(seq);
+      pushhash(hash, funcall1(func, v), v);
+    }
+  }
+
+  {
+    val iter = hash_begin(hash);
+    val cell;
+
+    while ((cell = hash_next(iter)) != nil)
+      rplacd(cell, nreverse(cdr(cell)));
+
+    return hash;
+  }
+}
+
 static val hash_keys_lazy(val iter, val lcons)
 {
   val cell = hash_next(iter);
diff --git a/hash.h b/hash.h
index e6b82881..f927889c 100644
--- a/hash.h
+++ b/hash.h
@@ -47,6 +47,7 @@ val hash_eql(val obj);
 val hash_equal(val obj);
 val hashv(val args);
 val hash_construct(val hashv_args, val pairs);
+val group_by(val func, val seq, val hashv_args);
 val hash_keys(val hash);
 val hash_values(val hash);
 val hash_pairs(val hash);
diff --git a/txr.1 b/txr.1
index cd8d2e8e..96af04b7 100644
--- a/txr.1
+++ b/txr.1
@@ -9656,6 +9656,37 @@ the equal function instead.
 In addition to storing key-value pairs, a hash table can have a piece of
 information associated with it, called the user data.
 
+.SS Function group-by
+
+.TP
+Syntax:
+
+  (group-by <func> <sequence> . <options>)
+
+.TP
+Description:
+
+The group-by function produces a hash table from <sequence>, which is a
+list or vector. Entries of the hash table are not elements of sequence,
+but lists of elements of <sequence>. The function <func> is applied toe
+each element of <sequence> to compute a key. That key is used to determine
+which list the item is added to in the hash table.
+
+The trailing arguments <options>, if any, consist of the same keywords
+that are understood by the hash function, and determine the properties
+of the hash.
+
+.TP
+Example:
+
+Group the integers from 0 to 10 into three buckets keyed on 0, 1 and 2
+according to the modulo 3 congruence:
+
+  (group-by (op mod @1 3) (range 0 10)))
+
+  -> #H(() (0 (0 3 6 9)) (1 (1 4 7 10)) (2 (2 5 8)))
+
+
 .SS Functions make-similar-hash and copy-hash
 
 .TP
-- 
cgit v1.2.3