utils: Type collect-by-key.

scribblings/utils.scrbl

@@ -327,6 +327,20 @@ unweighted graph.
 
 @section{Additional list and hash map utilities}
 
+@defproc[(collect-by-key [keys (Listof Any)] [vals (Listof Any)])
+			 (Values (Listof Any) (Listof (Listof Any)))]{
+
+Given a list of keys and the corresponding values, collects all the values
+associated to any given key and returns a list of keys without duplicates, and
+a list containing the corresponding list of values.
+
+If @racket[keys] can be treated as edges (i.e. pairs of vertices), the results
+produced by this function are suitable for graph constructors.
+
+@examples[#:eval utils-evaluator
+(collect-by-key '(a b a) '(1 2 3))
+]}
+
 @section{Functions and procedures}
 
 @section{Randomness}

utils.rkt

@@ -22,7 +22,7 @@
    handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
    read-org-variable-mapping unorgv read-symbol-list drop-first-last
    list-sets->list-strings pretty-print-set pretty-print-set-sets
-   update-vertices/unweighted update-graph dotit)
+   update-vertices/unweighted update-graph dotit collect-by-key)
 
   (define-type Variable Symbol)
   (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@@ -379,6 +379,23 @@
       (check-false (has-edge? new-gr3 'cc 'bb))
       (check-equal? (edge-weight new-gr3 'aa 'bb) 20)
       (check-equal? (edge-weight new-gr3 'bb 'cc) 22)))
+
+  (: collect-by-key (-> (Listof Any) (Listof Any)
+                        (Values (Listof Any) (Listof (Listof Any)))))
+  (define (collect-by-key keys vals)
+    (for/fold ([ht : (HashTable Any (Listof Any))
+                   (make-immutable-hash)]
+               #:result (values (hash-keys ht) (hash-values ht)))
+              ([e keys]
+               [l vals])
+      ((inst hash-update Any (Listof Any)) ht e (λ (ls) (cons l ls)) (λ () empty))))
+
+  (module+ test
+    (test-case "collect-by-key"
+      (define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
+      (define-values (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)))))
   )
 
 (require 'typed)
@@ -387,14 +404,13 @@
          map-sexp read-org-sexp unorg unstringify-pairs
          read-org-variable-mapping unorgv read-symbol-list drop-first-last
          list-sets->list-strings pretty-print-set pretty-print-set-sets
-         update-vertices/unweighted update-graph dotit)
+         update-vertices/unweighted update-graph dotit collect-by-key)
 
 ;;; Untyped section.
 
 (provide
  ;; Functions
- (contract-out [collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (listof any/c))))]
+ (contract-out [collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))]
-               [collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))]
 
                [ht-values/list->set (-> (hash/c any/c (listof any/c)) (hash/c any/c (set/c any/c)))]
                [hash->list/ordered (-> hash? (listof (cons/c any/c any/c)))]
@@ -435,25 +451,6 @@
 ;;; Additional list and hash map 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)))
-
-(module+ test
-  (test-case "collect-by-key"
-    (define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
-    (define-values (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)))))
-
 ;;; Like collect-by-key, but returns a list of sets of weights.
 (define (collect-by-key/sets edges labels)
   (let-values ([(es ls) (collect-by-key edges labels)])