From 908676a28b25c5dc15b5831a2d8f8af3fe7d5b4a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 2 Feb 2024 19:30:15 -0800
Subject: New function: hist-sort-by.

* eval.c (eval_init): Register hist-sort-by intrinsic.

* lib.c (hist_sort_by): New function.
(hist_sort): Wrapper for hist_sort_by now.

* lib.h (hist_sort_by): Declared.

* tests/012/sort.tl: Tests.

* txr.1: Documented.
---
 eval.c            |  1 +
 lib.c             |  9 +++++++--
 lib.h             |  1 +
 tests/012/sort.tl |  3 +++
 txr.1             | 26 +++++++++++++++++++++++++-
 5 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/eval.c b/eval.c
index 0406dd78..828ba73e 100644
--- a/eval.c
+++ b/eval.c
@@ -7426,6 +7426,7 @@ void eval_init(void)
   reg_fun(intern(lit("uniq"), user_package), func_n1(uniq));
   reg_fun(intern(lit("grade"), user_package), func_n3o(grade, 1));
   reg_fun(intern(lit("hist-sort"), user_package), func_n1v(hist_sort));
+  reg_fun(intern(lit("hist-sort-by"), user_package), func_n2v(hist_sort_by));
 
   reg_fun(intern(lit("nrot"), user_package), func_n2o(nrot, 1));
   reg_fun(intern(lit("rot"), user_package), func_n2o(rot, 1));
diff --git a/lib.c b/lib.c
index c5722241..e1ca5e9e 100644
--- a/lib.c
+++ b/lib.c
@@ -11600,14 +11600,19 @@ static val hist_succ(val left, val right)
   return succ(left);
 }
 
-val hist_sort(val seq, varg hashv_args)
+val hist_sort_by(val fun, val seq, varg hashv_args)
 {
   val hash = group_reduce(hashv(hashv_args),
-                          identity_f, hist_succ_f,
+                          fun, hist_succ_f,
                           seq, zero, nil);
   return nsort(hash_alist(hash), gt_f, cdr_f);
 }
 
+val hist_sort(val seq, varg hashv_args)
+{
+  return hist_sort_by(identity_f, seq, hashv_args);
+}
+
 val nrot(val seq, val n_in)
 {
   val len = length(seq);
diff --git a/lib.h b/lib.h
index 0fc4e91a..349d0888 100644
--- a/lib.h
+++ b/lib.h
@@ -1342,6 +1342,7 @@ val sort_group(val seq, val keyfun, val lessfun);
 val unique(val seq, val keyfun, varg hashv_args);
 val uniq(val seq);
 val grade(val seq, val lessfun, val keyfun_in);
+val hist_sort_by(val fun, val seq, varg hashv_args);
 val hist_sort(val seq, varg hashv_args);
 val nrot(val seq, val n_in);
 val rot(val seq, val n_in);
diff --git a/tests/012/sort.tl b/tests/012/sort.tl
index 92811715..bca4a3d8 100644
--- a/tests/012/sort.tl
+++ b/tests/012/sort.tl
@@ -93,3 +93,6 @@
   (hist-sort nil) nil
   (hist-sort '(3 4 5)) ((3 . 1) (4 . 1) (5 . 1))
   (hist-sort '("a" "b" "c" "a" "b" "a" "b" "a")) (("a" . 4) ("b" . 3) ("c" . 1)))
+
+(test
+  [hist-sort-by upcase-str '("a" "b" "c" "a" "b" "a" "b" "a")] (("A" . 4) ("B" . 3) ("C" . 1)))
diff --git a/txr.1 b/txr.1
index f598381f..ecf4e2a1 100644
--- a/txr.1
+++ b/txr.1
@@ -57039,9 +57039,10 @@ Separate the integers 1\(en10 into even and odd, and sum these groups:
   -> #H(() (t 30) (nil 25))
 .brev
 
-.coNP Function @ hist-sort
+.coNP Functions @ hist-sort and @ hist-sort-by
 .synb
 .mets (hist-sort < sequence << option *)
+.mets (hist-sort-by < by-fun < sequence << option *)
 .syne
 .desc
 The
@@ -57072,6 +57073,29 @@ if any, consist of the same keywords that are understood by the
 .code hash
 function, and determine the properties of that hash.
 
+The
+.code hist-sort-by
+function differs from
+.code hist-sort
+in that it requires an additional argument
+.meta by-fun
+with the following semantics: every element of
+.meta sequence
+is passed to
+.meta by-fun
+such that the resulting value is used as the hash key in the resulting
+histogram.
+
+Thus, an invocation of
+.code hist-sort
+is equivalent to an invocation of
+.code hist-sort-by
+where the
+.meta by-fun
+argument is specified as the
+.code identity
+function.
+
 .TP* Examples
 
 .verb
-- 
cgit v1.2.3