FIXME WIP: Continue converting to Typed Racket.

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)])

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]{

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
 ;;; ===============