scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

utils: Add collect-by-key/sets.

This commit is contained in:
Sergiu Ivanov 2020-03-02 18:15:41 +01:00
parent 64ca8f4bf1
commit 740918a542
2 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
utils-tests.rkt
View File

@ -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))))

6
utils.rkt
View File

@ -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)])