utils: Make collect-by-keys and collect-by-keys/sets polymorphic.

This commit is contained in:
Sergiu Ivanov 2022-02-10 00:12:50 +01:00
parent e01ba07724
commit 9defe51ee6
2 changed files with 11 additions and 11 deletions

View file

@ -327,8 +327,8 @@ unweighted graph.
@section{Additional list and hash map utilities} @section{Additional list and hash map utilities}
@defproc[(collect-by-key [keys (Listof Any)] [vals (Listof Any)]) @defproc[(collect-by-key [keys (Listof a)] [vals (Listof b)])
(Values (Listof Any) (Listof (Listof Any)))]{ (Values (Listof a) (Listof (Listof b)))]{
Given a list of keys and the corresponding values, collects all the values 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 associated to any given key and returns a list of keys without duplicates, and
@ -341,8 +341,8 @@ produced by this function are suitable for graph constructors.
(collect-by-key '(a b a) '(1 2 3)) (collect-by-key '(a b a) '(1 2 3))
]} ]}
@defproc[(collect-by-key/sets [keys (Listof Any)] [vals (Listof Any)]) @defproc[(collect-by-key/sets [keys (Listof a)] [vals (Listof b)])
(Values (Listof Any) (Listof (Setof Any)))]{ (Values (Listof a) (Listof (Setof b)))]{
Like @racket[collect-by-key], but produce a list of sets instead of a list Like @racket[collect-by-key], but produce a list of sets instead of a list
of lists. of lists.

View file

@ -381,15 +381,15 @@
(check-equal? (edge-weight new-gr3 'aa 'bb) 20) (check-equal? (edge-weight new-gr3 'aa 'bb) 20)
(check-equal? (edge-weight new-gr3 'bb 'cc) 22))) (check-equal? (edge-weight new-gr3 'bb 'cc) 22)))
(: collect-by-key (-> (Listof Any) (Listof Any) (: collect-by-key (All (a b) (-> (Listof a) (Listof b)
(Values (Listof Any) (Listof (Listof Any))))) (Values (Listof a) (Listof (Listof b))))))
(define (collect-by-key keys vals) (define (collect-by-key keys vals)
(for/fold ([ht : (HashTable Any (Listof Any)) (for/fold ([ht : (HashTable a (Listof b))
(make-immutable-hash)] (make-immutable-hash)]
#:result (values (hash-keys ht) (hash-values ht))) #:result (values (hash-keys ht) (hash-values ht)))
([e keys] ([e keys]
[l vals]) [l vals])
((inst hash-update Any (Listof Any)) ht e (λ (ls) (cons l ls)) (λ () empty)))) ((inst hash-update a (Listof b)) ht e (λ (ls) (cons l ls)) (λ () empty))))
(module+ test (module+ test
(test-case "collect-by-key" (test-case "collect-by-key"
@ -398,11 +398,11 @@
(check-equal? e1 '((1 2) (1 3))) (check-equal? l1 '((a) (b))) (check-equal? e1 '((1 2) (1 3))) (check-equal? l1 '((a) (b)))
(check-equal? e2 '((1 2))) (check-equal? l2 '((b a))))) (check-equal? e2 '((1 2))) (check-equal? l2 '((b a)))))
(: collect-by-key/sets (-> (Listof Any) (Listof Any) (: collect-by-key/sets (All (a b) (-> (Listof a) (Listof b)
(Values (Listof Any) (Listof (Setof Any))))) (Values (Listof a) (Listof (Setof b))))))
(define (collect-by-key/sets edges labels) (define (collect-by-key/sets edges labels)
(define-values (es ls) (collect-by-key edges labels)) (define-values (es ls) (collect-by-key edges labels))
(values es ((inst map (Setof Any) (Listof Any)) list->set ls))) (values es ((inst map (Setof b) (Listof b)) list->set ls)))
(module+ test (module+ test
(test-case "collect-by-key/sets" (test-case "collect-by-key/sets"