utils: Typed update-vertices/unweighted.

scribblings/utils.scrbl

@@ -277,6 +277,28 @@ Typeset the graph via graphviz and display it.
 (dotit (weighted-graph/directed '((1 a b) (2 b c))))
 ]}
 
+
+@defproc[(update-vertices/unweighted [graph Graph] [func (-> Any Any)]) Graph]{
+
+Applies a transformation to every vertex in the unweighted graph and returns
+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 @racket[rename-vertex!], so it can be used to
+permute vertex labels.
+
+@examples[#:eval utils-evaluator
+(define g (directed-graph '((a b) (b c))))
+(define (double-labels [x : Any])
+  (define x-str (symbol->string (cast x Symbol)))
+  (string->symbol (string-append x-str x-str)))
+(dotit (update-vertices/unweighted g double-labels))
+]}
+
+
 @section{Additional list and hash map utilities}
 
 @section{Functions and procedures}

utils.rkt

@@ -21,7 +21,8 @@
    extract-symbols any->string stringify-variable-mapping string->any
    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 dotit)
+   list-sets->list-strings pretty-print-set pretty-print-set-sets
+   update-vertices/unweighted dotit)
 
   (define-type Variable Symbol)
   (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@@ -297,6 +298,37 @@
       (check-equal? (pretty-print-set-sets (set (set 'a 'b) (set 'c))) "{a b}{c}")))
 
   (define dotit (compose display graphviz))
+
+  (: 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))))
+      (define gr2 (undirected-graph '((a b) (b c))))
+      (define (dbl [x : Any])
+        (define x-str (symbol->string (cast x Symbol)))
+        (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))))
   )
 
 (require 'typed)
@@ -304,14 +336,14 @@
          extract-symbols any->string stringify-variable-mapping string->any
          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 dotit)
+         list-sets->list-strings pretty-print-set pretty-print-set-sets
+         update-vertices/unweighted dotit)
 
 ;;; Untyped section.
 
 (provide
  ;; Functions
- (contract-out [update-vertices/unweighted (-> graph? (-> any/c any/c) graph?)]
+ (contract-out [update-graph (->* (graph?)
-               [update-graph (->* (graph?)
                                   (#:v-func (-> any/c any/c)
                                    #:e-func (-> any/c any/c))
                                   graph?)]
@@ -357,43 +389,6 @@
 ;;; 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.
-(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))))
-    (define gr2 (undirected-graph '((a b) (b c))))
-    (define dbl (λ (x) (let ([x-str (symbol->string x)])
-                         (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))))
-
 ;;; Given a graph, apply a transformation v-func to every vertex label
 ;;; and, if the graph is a weighted graph, the transformation e-func
 ;;; to every edge label.  Both transformations default to identity