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

utils: Type collect-by-key/sets.

Browse source
This commit is contained in:
Sergiu Ivanov 2022-02-09 23:55:20 +01:00
parent cf3f20097b
commit 50fb3dab59
2 changed files with 27 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
scribblings/utils.scrbl
View file

@ -341,6 +341,17 @@ produced by this function are suitable for graph constructors.
(collect-by-key '(a b a) '(1 2 3))
]}
@defproc[(collect-by-key/sets [keys (Listof Any)] [vals (Listof Any)])
(Values (Listof Any) (Listof (Setof Any)))]{
Like @racket[collect-by-key], but produce a list of sets instead of a list
of lists.
@examples[#:eval utils-evaluator
(collect-by-key/sets '(a b a) '(1 2 3))
]}
@section{Functions and procedures}
@section{Randomness}

31
utils.rkt
View file

@ -22,7 +22,8 @@
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 collect-by-key)
update-vertices/unweighted update-graph dotit collect-by-key
collect-by-key/sets)
(define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -396,6 +397,17 @@
(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)))))
(: collect-by-key/sets (-> (Listof Any) (Listof Any)
(Values (Listof Any) (Listof (Setof Any)))))
(define (collect-by-key/sets edges labels)
(define-values (es ls) (collect-by-key edges labels))
(values es ((inst map (Setof Any) (Listof Any)) list->set ls)))
(module+ test
(test-case "collect-by-key/sets"
(define-values (e3 l3) (collect-by-key/sets '(a b a) '(1 2 1)))
(check-equal? e3 '(b a)) (check-equal? l3 (list (set 2) (set 1)))))
)
(require 'typed)
@ -404,15 +416,14 @@
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 collect-by-key)
update-vertices/unweighted update-graph dotit collect-by-key
collect-by-key/sets)
;;; Untyped section.
(provide
;; Functions
(contract-out [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)))]
(contract-out [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)))]
[multi-split-at (-> (listof (listof any/c)) number?
(values (listof (listof any/c)) (listof (listof any/c))))]
@ -451,16 +462,6 @@
;;; Additional list and hash map utilities
;;; ======================================
;;; 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))))
(module+ test
(test-case "collect-by-key/sets"
(define-values (e3 l3) (collect-by-key/sets '(a b a) '(1 2 1)))
(check-equal? e3 '(b a)) (check-equal? l3 (list (set 2) (set 1)))))
;;; Converts the values of a hash table from lists to sets.
(define (ht-values/list->set ht)
(for/hash ([(k v) (in-hash ht)])