diff --git a/graph-typed.rkt b/graph-typed.rkt index 5efcf59..d9eac09 100644 --- a/graph-typed.rkt +++ b/graph-typed.rkt @@ -7,4 +7,10 @@ [graphviz (-> Graph [#:output Output-Port] [#:colors (HashTable Any Natural)] - String)]) + String)] + [unweighted-graph/directed (-> (Listof (List Any Any)) Graph)] + [in-edges (-> Graph (Sequenceof Any))] + [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)] + [undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)] + [has-vertex? (-> Graph Any Boolean)] + [has-edge? (-> Graph Any Any Boolean)]) diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl index ba364fd..83e19b8 100644 --- a/scribblings/utils.scrbl +++ b/scribblings/utils.scrbl @@ -244,6 +244,14 @@ those symbols. @section{Additional graph utilities} +Apply a transformation to every vertex in the unweighted graph, return the new +graph. If the transformation function maps two vertices to the same values, +these vertices will be merged in the resulting graph. The transformation +function may be called multiple times for the same vertex. + +This function does not rely on rename-vertex!, so it can be used to permute +vertex labels. + @section{Pretty printing} @defproc[(pretty-print-set (s (Setof Any))) String]{ diff --git a/utils.rkt b/utils.rkt index 10e1164..4a9b3b3 100644 --- a/utils.rkt +++ b/utils.rkt @@ -286,6 +286,45 @@ '("y x" "z" "" "t")))) +;;; ========================== +;;; Additional graph utilities +;;; ========================== + +(: update-vertices/unweighted (-> Graph (-> Any Any) Graph)) +(define (update-vertices/unweighted gr func) + (unweighted-graph/directed + (for/list ([e (in-edges gr)]) + (match-let ([(list u v) e]) + (list (func u) (func v)))))) + +(module+ test + (test-case "update-vertices/unweighted" + (define gr1 (directed-graph '((a b) (b c)))) + gr1 +#| + (define gr2 (undirected-graph '((a b) (b c)))) + (define dbl (λ ([x : Any]) + (define x-str (symbol->string (cast x Variable))) + (string->symbol (string-append x-str x-str)))) + (define new-gr1 (update-vertices/unweighted gr1 dbl)) + (define new-gr2 (update-vertices/unweighted gr2 dbl)) + + (check-false (has-vertex? new-gr1 'a)) + (check-true (has-vertex? new-gr1 'aa)) + (check-false (has-vertex? new-gr1 'b)) + (check-true (has-vertex? new-gr1 'bb)) + (check-false (has-vertex? new-gr1 'c)) + (check-true (has-vertex? new-gr1 'cc)) + (check-true (has-edge? new-gr1 'aa 'bb)) + (check-true (has-edge? new-gr1 'bb 'cc)) + + (check-true (has-edge? new-gr2 'aa 'bb)) + (check-true (has-edge? new-gr2 'bb 'aa)) + (check-true (has-edge? new-gr2 'bb 'cc)) + (check-true (has-edge? new-gr2 'cc 'bb)) +|#)) + + ;;; =============== ;;; Pretty printing ;;; ===============