utils: Add collect-by-key/sets.
This commit is contained in:
parent
64ca8f4bf1
commit
740918a542
2 changed files with 10 additions and 2 deletions
|
@ -113,8 +113,10 @@
|
|||
|
||||
(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))])
|
||||
[(e2 l2) (collect-by-key '((1 2) (1 2)) '(a b))]
|
||||
[(e3 l3) (collect-by-key/sets '(a b a) '(1 2 1))])
|
||||
(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)))
|
||||
(check-equal? e3 '(a b)) (check-equal? l3 (list (set 1) (set 2))))
|
||||
(check-equal? (ht-values:list->set #hash((a . (1 1))))
|
||||
(hash 'a (set 1))))
|
||||
|
|
|
@ -26,6 +26,7 @@
|
|||
graph?)]
|
||||
[pretty-print-set (-> generic-set? string?)]
|
||||
[collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof 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)))])
|
||||
;; Contracts
|
||||
|
@ -280,6 +281,11 @@
|
|||
([e edges] [l labels])
|
||||
(hash-update ht e (λ (ls) (cons l ls)) empty)))
|
||||
|
||||
;;; 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)])
|
||||
(values es (map list->set ls))))
|
||||
|
||||
;;; Converts the values of a hash table from lists to sets.
|
||||
(define (ht-values:list->set ht)
|
||||
(for/hash ([(k v) (in-hash ht)])
|
||||
|
|
Loading…
Reference in a new issue