From 740918a542d59caeb9dcc8421a0739556d52a578 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 2 Mar 2020 18:15:41 +0100 Subject: [PATCH] utils: Add collect-by-key/sets. --- utils-tests.rkt | 6 ++++-- utils.rkt | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/utils-tests.rkt b/utils-tests.rkt index 89189aa..bb6eafe 100644 --- a/utils-tests.rkt +++ b/utils-tests.rkt @@ -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)))) diff --git a/utils.rkt b/utils.rkt index 56459df..e29c6e7 100644 --- a/utils.rkt +++ b/utils.rkt @@ -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)])