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

utils: Type collect-by-key.

This commit is contained in:
Sergiu Ivanov 2022-02-09 01:07:37 +01:00
parent 002b1a8006
commit cf3f20097b
2 changed files with 34 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
scribblings/utils.scrbl
View File

@ -327,6 +327,20 @@ unweighted graph.
@section{Additional list and hash map utilities}
@defproc[(collect-by-key [keys (Listof Any)] [vals (Listof Any)])
(Values (Listof Any) (Listof (Listof Any)))]{
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
a list containing the corresponding list of values.
If @racket[keys] can be treated as edges (i.e. pairs of vertices), the results
produced by this function are suitable for graph constructors.
@examples[#:eval utils-evaluator
(collect-by-key '(a b a) '(1 2 3))
]}
@section{Functions and procedures}
@section{Randomness}

43
utils.rkt
View File

@ -22,7 +22,7 @@
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)
update-vertices/unweighted update-graph dotit collect-by-key)
(define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -379,6 +379,23 @@
(check-false (has-edge? new-gr3 'cc 'bb))
(check-equal? (edge-weight new-gr3 'aa 'bb) 20)
(check-equal? (edge-weight new-gr3 'bb 'cc) 22)))
(: collect-by-key (-> (Listof Any) (Listof Any)
(Values (Listof Any) (Listof (Listof Any)))))
(define (collect-by-key keys vals)
(for/fold ([ht : (HashTable Any (Listof Any))
(make-immutable-hash)]
#:result (values (hash-keys ht) (hash-values ht)))
([e keys]
[l vals])
((inst hash-update Any (Listof Any)) ht e (λ (ls) (cons l ls)) (λ () empty))))
(module+ test
(test-case "collect-by-key"
(define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
(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)))))
)
(require 'typed)
@ -387,14 +404,13 @@
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)
update-vertices/unweighted update-graph dotit collect-by-key)
;;; Untyped section.
(provide
;; Functions
(contract-out [collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (listof any/c))))]
[collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))]
(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)))]
[hash->list/ordered (-> hash? (listof (cons/c any/c any/c)))]
@ -435,25 +451,6 @@
;;; Additional list and hash map utilities
;;; ======================================
;;; Collects labels for duplicate edges into a sets of labels.
;;;
;;; More precisely, given a list of edges and weights, produces a new
;;; list of edges without duplicates, and a list of lists of weights
;;; in which each element corresponds to the edge (the input is
;;; suitable for graph constructors).
(define (collect-by-key edges labels)
(for/fold ([ht (make-immutable-hash)]
#:result (values (hash-keys ht) (hash-values ht)))
([e edges] [l labels])
(hash-update ht e (λ (ls) (cons l ls)) empty)))
(module+ test
(test-case "collect-by-key"
(define-values (e1 l1) (collect-by-key '((1 2) (1 3)) '(a b)))
(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)))))
;;; 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)])