From b2f686cdaab786f31f16fa22c083dfc1eb213a45 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 1 Mar 2020 16:53:17 +0100
Subject: [PATCH] utils: Add collect-by-key.

---
 utils-tests.rkt |  6 ++++++
 utils.rkt       | 20 +++++++++++++++++++-
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/utils-tests.rkt b/utils-tests.rkt
index 62140e1..d6f12c2 100644
--- a/utils-tests.rkt
+++ b/utils-tests.rkt
@@ -110,3 +110,9 @@
 
 (test-case "Pretty printing"
   (check-equal? (pretty-print-set (set 'a 'b 1)) "1 a b"))
+
+(test-case "Additional list utilties"
+  (let-values ([(e1 l1) (collect-by-key '((1 2) (1 3)) '(a b))]
+               [(e2 l2) (collect-by-key '((1 2) (1 2)) '(a b))])
+    (check-equal? e1 '((1 2) (1 3))) (check-equal? l1 '((a) (b)))
+    (check-equal? e2 '((1 2))) (check-equal? l2 '((b a)))))
diff --git a/utils.rkt b/utils.rkt
index 86782e6..a6d348e 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -24,7 +24,8 @@
                                   (#:v-func (-> any/c any/c)
                                    #:e-func (-> any/c any/c))
                                   graph?)]
-               [pretty-print-set (-> generic-set? string?)])
+               [pretty-print-set (-> generic-set? string?)]
+               [collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof any/c)))])
  ;; Contracts
  (contract-out [variable-mapping? contract?]
                [string-variable-mapping? contract?]
@@ -259,3 +260,20 @@
 ;;; Pretty print a set by listing its elements in alphabetic order.
 (define (pretty-print-set s)
   (string-join (sort (set-map s any->string) string<?)))
+
+
+;;; =========================
+;;; Additional list utilities
+;;; =========================
+
+;;; Collects labels for duplicate edges into a sets of labels.
+;;;
+;;; More precisely, given a list of edges and weights, produces a new
+;;; list of edges without duplicates, and a list of lists of weights
+;;; in which each element corresponds to the edge (the input is
+;;; suitable for graph constructors).
+(define (collect-by-key edges labels)
+  (for/fold ([ht (make-immutable-hash)]
+             #:result (values (hash-keys ht) (hash-values ht)))
+            ([e edges] [l labels])
+    (hash-update ht e (λ (ls) (cons l ls)) empty)))