New function: hash-invert.

* hash.c (hash_invert): New function.
(hash_init): hash-invert intrinsic registered.

* hash.c (hash_invert): Declared.

* txr.1: Documented.

3 files changed, 127 insertions, 0 deletions

diff --git a/hash.c b/hash.c
index 27d62dba..e85efa03 100644
--- a/hash.c
+++ b/hash.c
@@ -1735,6 +1735,36 @@ val hash_revget(val hash, val value, val test, val keyfun)
   return nil;
 }
 
+val hash_invert(val hash, val joinfun, val unitfun, struct args *hashv_args)
+{
+  val self = lit("hash-invert");
+  val hout = hashv(hashv_args);
+  val iter = hash_begin(hash);
+  val jfun = default_arg(joinfun, identity_star_f);
+  val ufun = default_arg(unitfun, identity_f);
+  val cell;
+
+  if (jfun == identity_star_f && ufun == identity_f) {
+    while ((cell = hash_next(iter)) != nil) {
+      us_cons_bind(k, v, cell);
+      sethash(hout, v, k);
+    }
+  } else {
+    while ((cell = hash_next(iter)) != nil) {
+      us_cons_bind(k, v, cell);
+      val new_p;
+      loc place = gethash_l(self, hout, v, mkcloc(new_p));
+      val ukey = funcall1(ufun, k);
+      if (new_p)
+        set(place, ukey);
+      else
+        set(place, funcall2(jfun, deref(place), ukey));
+    }
+  }
+
+  return hout;
+}
+
 static val set_hash_traversal_limit(val lim)
 {
   val old = num(hash_traversal_limit);
@@ -1809,6 +1839,7 @@ void hash_init(void)
   reg_fun(intern(lit("hash-update-1"), user_package),
           func_n4o(hash_update_1, 3));
   reg_fun(intern(lit("hash-revget"), user_package), func_n4o(hash_revget, 2));
+  reg_fun(intern(lit("hash-invert"), user_package), func_n3ov(hash_invert, 1));
   reg_fun(intern(lit("hash-begin"), user_package), func_n1(hash_begin));
   reg_fun(intern(lit("hash-next"), user_package), func_n1(hash_next));
   reg_fun(intern(lit("hash-peek"), user_package), func_n1(hash_peek));
diff --git a/hash.h b/hash.h
index da30adab..869e6fbd 100644
--- a/hash.h
+++ b/hash.h
@@ -77,6 +77,7 @@ val hash_proper_subset(val hash1, val hash2);
 val hash_update(val hash, val fun);
 val hash_update_1(val hash, val key, val fun, val init);
 val hash_revget(val hash, val value, val test, val keyfun);
+val hash_invert(val hash, val joinfun, val unitfun, struct args *hashv_args);
 
 void hash_process_weak(void);
 
diff --git a/txr.1 b/txr.1
index 2cf8eb8c..c437875d 100644
--- a/txr.1
+++ b/txr.1
@@ -44933,6 +44933,101 @@ is the
 .code eql
 function.
 
+.coNP Function @ hash-invert
+.synb
+.mets (hash-invert >> hash >> [ joinfun >> [ unitfun  << hash-arg *]])
+.syne
+.desc
+The
+.code hash-invert
+function calculates and returns an inversion of hash table
+.metn hash .
+The values in
+.meta hash
+become keys in the returned hash table. Conversely, the values
+in the returned hash table are derived from the keys.
+
+The optional
+.meta joinfun
+and
+.meta unitfun
+arguments must be functions, if they are given.
+These functions determine the behavior of
+.code hash-invert
+with regard to duplicate values in
+.meta hash
+which turn into duplicate keys.
+The
+.meta joinfun
+function must be callable with two arguments, and
+.meta joinfun
+must accept one argument.
+If
+.meta joinfun
+is omitted, it defaults to the
+.code identity*
+function;
+.meta unitfun
+defaults to
+.codn identity .
+
+The
+.code hash-invert
+function constructs a hash table as if by a call to the
+.code hash
+function, passing the
+.meta hash-arg
+arguments which determine the properties of the newly created hash.
+
+The new hash table is then populated by iterating over the key-value pairs of
+.meta hash
+and inserting them as follows:
+The key from
+.meta hash
+is turned into a value
+.meta v1
+by invoking the
+.meta unitfun
+function on it, and taking the return value.
+The value from
+.meta hash
+is used as a key to perform a lookup in the new hash table.
+If no entry exists, then a new entry is created, whose value is
+.metn v1 .
+Otherwise if the entry already exists, then the value
+.meta v0
+of that entry is combined with
+.meta v1
+by calling the
+.meta joinfun
+on the arguments
+.meta v0
+and
+.metn v1 .
+The entry is updated with the resulting value.
+
+The new hash table is then returned.
+
+.TP* Examples:
+
+.verb
+  ;; Invert simple 1 to 1 table:
+
+  (hash-invert #H(() (a 1) (b 2) (c 3)))
+  --> #H(() (1 a) (2 b) (3 c))
+
+  ;; Invert table such that the keys of duplicate values
+  ;; are accumulated into lists:
+
+  [hash-invert #H(() (1 a) (2 a) (3 c) (5 c) (7 d)) append list]
+  --> #H(() (d (7)) (c (3 5)) (a (1 2)))
+
+  ;; Invert table such that keys of duplicate values are summed:
+
+  [hash-invert #H(() (1 a) (2 a) (3 c) (5 c) (7 d)) +]
+  --> #H(() (d 7) (c 8) (a 3))
+.brev
+
 .coNP Functions @ hash-eql and @ hash-equal
 .synb
 .mets (hash-eql << object )