utils: Type list-sets->list-strings.

This commit is contained in:
Sergiu Ivanov 2022-02-03 16:40:02 +01:00
parent 4703bfcce8
commit 211f39e91f
2 changed files with 26 additions and 15 deletions

View file

@ -2,7 +2,8 @@
@(require scribble/example racket/sandbox @(require scribble/example racket/sandbox
(for-label typed/racket/base graph (for-label typed/racket/base graph
(submod "../utils.rkt" typed) (submod "../utils.rkt" typed)
(only-in typed/graph Graph))) (only-in typed/graph Graph)
(only-in racket/set set)))
@title[#:tag "utils"]{dds/utils: Various Utilities} @title[#:tag "utils"]{dds/utils: Various Utilities}
@ -236,6 +237,15 @@ Useful for removing the parentheses in string representations of lists.
(drop-first-last "(a b)") (drop-first-last "(a b)")
]} ]}
@defproc[(list-sets->list-strings (lst (Listof (Setof Any)))) (Listof String)]{
Converts a list of sets of symbols to a list of strings containing
those symbols.
@examples[#:eval utils-evaluator
(list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
]}
@section{Additional graph utilities} @section{Additional graph utilities}
@defproc[(dotit [graph Graph]) Void]{ @defproc[(dotit [graph Graph]) Void]{

View file

@ -21,7 +21,7 @@
extract-symbols any->string stringify-variable-mapping string->any extract-symbols any->string stringify-variable-mapping string->any
handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
read-org-variable-mapping unorgv read-symbol-list drop-first-last read-org-variable-mapping unorgv read-symbol-list drop-first-last
dotit) list-sets->list-strings dotit)
(define-type Variable Symbol) (define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A)) (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -267,6 +267,18 @@
(test-case "drop-first-last" (test-case "drop-first-last"
(check-equal? (drop-first-last "(a b)") "a b"))) (check-equal? (drop-first-last "(a b)") "a b")))
(: list-sets->list-strings (-> (Listof (Setof Any)) (Listof String)))
(define (list-sets->list-strings lst)
(map (multi-compose drop-first-last
any->string
(λ ([x : (Setof Any)])
(set->list x))) lst))
(module+ test
(test-case "list-sets->list-strings"
(check-equal? (list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
'("x y" "z" "" "t"))))
(define dotit (compose display graphviz)) (define dotit (compose display graphviz))
) )
@ -275,14 +287,13 @@
extract-symbols any->string stringify-variable-mapping string->any extract-symbols any->string stringify-variable-mapping string->any
map-sexp read-org-sexp unorg unstringify-pairs map-sexp read-org-sexp unorg unstringify-pairs
read-org-variable-mapping unorgv read-symbol-list drop-first-last read-org-variable-mapping unorgv read-symbol-list drop-first-last
dotit) list-sets->list-strings dotit)
;;; Untyped section. ;;; Untyped section.
(provide (provide
;; Functions ;; Functions
(contract-out [list-sets->list-strings (-> (listof (set/c any/c)) (listof string?))] (contract-out [pretty-print-set-sets (-> (set/c (set/c symbol?) #:kind 'dont-care) string?)]
[pretty-print-set-sets (-> (set/c (set/c symbol?) #:kind 'dont-care) string?)]
[update-vertices/unweighted (-> graph? (-> any/c any/c) graph?)] [update-vertices/unweighted (-> graph? (-> any/c any/c) graph?)]
[update-graph (->* (graph?) [update-graph (->* (graph?)
(#:v-func (-> any/c any/c) (#:v-func (-> any/c any/c)
@ -326,16 +337,6 @@
(or/c (list/c key-contract val-contract) (or/c (list/c key-contract val-contract)
(cons/c key-contract val-contract))) (cons/c key-contract val-contract)))
;;; Converts a list of sets of symbols to a list of strings containing
;;; those symbols.
(define (list-sets->list-strings lst)
(map (compose drop-first-last any->string set->list) lst))
(module+ test
(test-case "list-sets->list-strings"
(check-equal? (list-sets->list-strings (list (set 'x 'y) (set 'z) (set) (set 't)))
'("x y" "z" "" "t"))))
;;; Pretty-prints a set of sets of symbols. ;;; Pretty-prints a set of sets of symbols.
;;; ;;;
;;; Typically used for pretty-printing the annotations on the edges of ;;; Typically used for pretty-printing the annotations on the edges of