605 lines
25 KiB
Racket
605 lines
25 KiB
Racket
;;; Copyright 2021 Sergiu Ivanov <sivanov@colimite.fr>
|
||
;;;
|
||
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||
;;; you may not use this file except in compliance with the License.
|
||
;;; You may obtain a copy of the License at
|
||
;;;
|
||
;;; http://www.apache.org/licenses/LICENSE-2.0
|
||
;;;
|
||
;;; Unless required by applicable law or agreed to in writing, software
|
||
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
||
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||
;;; See the License for the specific language governing permissions and
|
||
;;; limitations under the License.
|
||
|
||
#lang typed/racket
|
||
|
||
;;; This file implements Alex Knauth's solution presented here:
|
||
;;;
|
||
;;; https://stackoverflow.com/questions/65386334/racket-generic-graph-library-in-typed-racket
|
||
|
||
(module graph-wrapper racket
|
||
(require (prefix-in g: graph)
|
||
data/gen-queue/fifo)
|
||
(provide (struct-out graph) has-vertex? has-edge? vertex=? add-vertex! remove-vertex!
|
||
rename-vertex! add-edge! add-directed-edge! remove-edge!
|
||
remove-directed-edge! get-vertices in-vertices get-neighbors
|
||
in-neighbors get-edges in-edges edge-weight transpose graph-copy
|
||
graph-union!
|
||
|
||
unweighted-graph? unweighted-graph/undirected
|
||
unweighted-graph/directed unweighted-graph/adj
|
||
weighted-graph? weighted-graph/undirected weighted-graph/directed
|
||
undirected-graph directed-graph
|
||
(rename-out [g:matrix-graph? matrix-graph?])
|
||
matrix->matrix-graph matrix-graph->graph
|
||
|
||
bfs bfs/generalized fewest-vertices-path
|
||
dfs dfs/generalized
|
||
dag? tsort cc cc/bfs scc
|
||
|
||
min-st-kruskal max-st-kruskal min-st-prim max-st-prim
|
||
|
||
bellman-ford dijkstra dag-shortest-paths
|
||
floyd-warshall transitive-closure johnson
|
||
|
||
coloring coloring/greedy coloring/brelaz
|
||
order-smallest-last valid-coloring?
|
||
|
||
maxflow bipartite? maximum-bipartite-matching
|
||
|
||
graphviz)
|
||
|
||
;; Wrap the opaque graph structure coming from the generic
|
||
;; graph library.
|
||
(struct graph (g))
|
||
(define gg graph-g)
|
||
|
||
;; 1 Generic Graph Interface
|
||
(define (has-vertex? g v)
|
||
(g:has-vertex? (gg g) v))
|
||
(define (has-edge? g u v)
|
||
(g:has-edge? (gg g) u v))
|
||
(define (vertex=? g u v)
|
||
(g:vertex=? (gg g) u v))
|
||
(define (add-vertex! g v)
|
||
(g:add-vertex! (gg g) v))
|
||
(define (remove-vertex! g v)
|
||
(g:remove-vertex! (gg g) v))
|
||
(define (rename-vertex! g u v)
|
||
(g:rename-vertex! (gg g) u v))
|
||
(define (add-edge! g u v [weight 'default-value])
|
||
(g:add-edge! (gg g) u v weight))
|
||
(define (add-directed-edge! g u v [weight 'default-value])
|
||
(g:add-directed-edge! (gg g) u v weight))
|
||
(define (remove-edge! g u v)
|
||
(g:remove-edge! (gg g) u v))
|
||
(define (remove-directed-edge! g u v)
|
||
(g:remove-directed-edge! (gg g) u v))
|
||
(define (get-vertices g)
|
||
(g:get-vertices (gg g)))
|
||
(define (in-vertices g)
|
||
(g:in-vertices (gg g)))
|
||
(define (get-neighbors g v)
|
||
(g:get-neighbors (gg g) v))
|
||
(define (in-neighbors g v)
|
||
(g:in-neighbors (gg g) v))
|
||
(define (get-edges g)
|
||
(g:get-edges (gg g)))
|
||
(define (in-edges g)
|
||
(g:in-edges (gg g)))
|
||
(define (edge-weight g u v #:default [default +inf.0])
|
||
(g:edge-weight (gg g) u v #:default default))
|
||
(define (transpose g)
|
||
(graph (g:transpose (gg g))))
|
||
(define (graph-copy g)
|
||
(graph (g:graph-copy (gg g))))
|
||
(define (graph-union! g other)
|
||
(g:graph-union! (gg g) (gg other)))
|
||
|
||
;; 2 Graph constructors
|
||
;; 2.1 Unweighted Graphs
|
||
(define (unweighted-graph? g)
|
||
(g:unweighted-graph? (gg g)))
|
||
(define (unweighted-graph/undirected edges)
|
||
(graph (g:unweighted-graph/undirected edges)))
|
||
(define (unweighted-graph/directed edges)
|
||
(graph (g:unweighted-graph/directed edges)))
|
||
(define (unweighted-graph/adj edges)
|
||
(graph (g:unweighted-graph/adj edges)))
|
||
|
||
;; 2.2 Weighted Graphs
|
||
(define (weighted-graph? g)
|
||
(g:weighted-graph? (gg g)))
|
||
(define (weighted-graph/undirected edges)
|
||
(graph (g:weighted-graph/undirected edges)))
|
||
(define (weighted-graph/directed edges)
|
||
(graph (g:weighted-graph/directed edges)))
|
||
(define (undirected-graph es [ws #f])
|
||
(graph (g:undirected-graph es ws)))
|
||
(define (directed-graph es [ws #f])
|
||
(graph (g:directed-graph es ws)))
|
||
|
||
;; 2.3 Matrix Graphs
|
||
(define (matrix->matrix-graph mtx)
|
||
(g:matrix->matrix-graph mtx))
|
||
(define matrix-graph->graph graph)
|
||
|
||
;; 4 Basic Graph Functions
|
||
;; 4.1 Breadth-first Search
|
||
(define (bfs g source)
|
||
(g:bfs (gg g) source))
|
||
(define (bfs/generalized
|
||
g
|
||
source
|
||
#:init-queue [init-queue (mk-empty-fifo)]
|
||
#:break [break? (λ (G source from to) #f)]
|
||
#:init [init void]
|
||
#:visit? [custom-visit?-fn (λ (G source from to) #f)]
|
||
#:discover [discover (λ (G s u v acc) acc)]
|
||
#:visit [visit (λ (G s v acc) acc)]
|
||
#:return [finish (λ (G s acc) acc)])
|
||
(g:bfs/generalized
|
||
(gg g)
|
||
source
|
||
#:init-queue init-queue
|
||
#:break break?
|
||
#:init init
|
||
#:visit? custom-visit?-fn
|
||
#:discover discover
|
||
#:visit visit
|
||
#:return finish))
|
||
(define (fewest-vertices-path G source target)
|
||
(g:fewest-vertices-path (gg G) source target))
|
||
|
||
;; 4.2 Depth-first Search
|
||
(define (dfs g)
|
||
(g:dfs (gg g)))
|
||
(define (dfs/generalized
|
||
g
|
||
#:order [order (λ (x) x)]
|
||
#:break [break (λ (g from to acc) #f)]
|
||
#:init [init void]
|
||
#:inner-init [inner-init (λ (acc) acc)]
|
||
#:visit? [custom-visit?-fn #f]
|
||
#:prologue [prologue (λ (G u v acc) acc)]
|
||
#:epilogue [epilogue (λ (G u v acc) acc)]
|
||
#:process-unvisited? [process-unvisited?
|
||
(λ (G u v) #f)]
|
||
#:process-unvisited [process-unvisited
|
||
(λ (G u v acc) acc)]
|
||
#:combine [combine (λ (x acc) x)]
|
||
#:return [finish (λ (G acc) acc)])
|
||
(g:dfs/generalized
|
||
(gg g)
|
||
#:order order
|
||
#:break break
|
||
#:init init
|
||
#:inner-init inner-init
|
||
#:visit? custom-visit?-fn
|
||
#:prologue prologue
|
||
#:epilogue epilogue
|
||
#:process-unvisited? process-unvisited?
|
||
#:process-unvisited process-unvisited
|
||
#:combine combine
|
||
#:return finish))
|
||
(define (dag? g)
|
||
(g:dag? (gg g)))
|
||
(define (tsort g)
|
||
(g:tsort (gg g)))
|
||
(define (cc g)
|
||
(g:cc (gg g)))
|
||
(define (cc/bfs g)
|
||
(g:cc/bfs (gg g)))
|
||
(define (scc g)
|
||
(g:scc (gg g)))
|
||
|
||
;; 5 Spanning Trees
|
||
(define (min-st-kruskal g)
|
||
(g:min-st-kruskal (gg g)))
|
||
(define (max-st-kruskal g)
|
||
(g:max-st-kruskal (gg g)))
|
||
(define (min-st-prim g source)
|
||
(g:min-st-prim (gg g) source))
|
||
(define (max-st-prim g source)
|
||
(g:max-st-prim (gg g) source))
|
||
|
||
;; 6 Single-source Shortest Paths
|
||
(define (bellman-ford g source)
|
||
(g:bellman-ford (gg g) source))
|
||
(define (dijkstra g source)
|
||
(g:dijkstra (gg g) source))
|
||
(define (dag-shortest-paths g source)
|
||
(g:dag-shortest-paths (gg g) source))
|
||
|
||
;; 7 All-pairs Shortest Paths
|
||
(define (floyd-warshall g)
|
||
(g:floyd-warshall (gg g)))
|
||
(define (transitive-closure g)
|
||
(g:transitive-closure (gg g)))
|
||
(define (johnson g)
|
||
(g:johnson (gg g)))
|
||
|
||
;; 8 Coloring
|
||
(define (coloring g num-colors #:order [order (λ (x) x)])
|
||
(g:coloring (gg g) num-colors #:order order))
|
||
(define (coloring/greedy g #:order [order 'smallest-last])
|
||
(g:coloring/greedy (gg g) #:order order))
|
||
(define (coloring/brelaz g)
|
||
(g:coloring/brelaz (gg g)))
|
||
(define (order-smallest-last g)
|
||
(g:order-smallest-last (gg g)))
|
||
(define (valid-coloring? g coloring)
|
||
(g:valid-coloring? (gg g) coloring))
|
||
|
||
;; 9 Maximum Flow
|
||
(define (maxflow g source sink)
|
||
(g:maxflow (gg g) source sink))
|
||
(define (bipartite? g)
|
||
(g:bipartite? (gg g)))
|
||
(define (maximum-bipartite-matching g)
|
||
(g:maximum-bipartite-matching (gg g)))
|
||
|
||
;; 10 Graphviz
|
||
(define (graphviz g #:output [output #f] #:colors [colors #f])
|
||
(g:graphviz (gg g) #:output output #:colors colors)))
|
||
|
||
(require (only-in math/matrix Matrix))
|
||
|
||
(require/typed/provide 'graph-wrapper
|
||
[#:opaque Graph graph?]
|
||
[#:opaque Matrix-Graph matrix-graph?]
|
||
|
||
;; 1 Generic Graph Interface
|
||
[has-vertex? (-> Graph Any Boolean)]
|
||
[has-edge? (-> Graph Any Any Boolean)]
|
||
[vertex=? (-> Graph Any Any Boolean)]
|
||
[add-vertex! (-> Graph Any Void)]
|
||
[remove-vertex! (-> Graph Any Void)]
|
||
[rename-vertex! (-> Graph Any Any Void)]
|
||
[add-edge! (->* (Graph Any Any) (Any) Void)]
|
||
[add-directed-edge! (->* (Graph Any Any) (Any) Void)]
|
||
[remove-edge! (-> Graph Any Any Void)]
|
||
[remove-directed-edge! (-> Graph Any Any Void)]
|
||
[get-vertices (-> Graph (Listof Any))]
|
||
[in-vertices (-> Graph (Sequenceof Any))]
|
||
[get-neighbors (-> Graph Any (Listof Any))]
|
||
[in-neighbors (-> Graph Any (Sequenceof Any))]
|
||
[get-edges (-> Graph (U (Listof (List Any Any)) (Listof (List Any Any Any))))]
|
||
[in-edges (-> Graph (Sequenceof (U (List Any Any) (List Any Any Any))))]
|
||
[edge-weight (->* (Graph Any Any) (#:default Any) Any)]
|
||
[transpose (-> Graph Graph)]
|
||
[graph-copy (-> Graph Graph)]
|
||
[graph-union! (-> Graph Graph Void)]
|
||
|
||
;; 2 Graph constructors
|
||
;; 2.1 Unweighted Graphs
|
||
[unweighted-graph? (-> Graph Boolean)]
|
||
[unweighted-graph/undirected (-> (Listof (List Any Any)) Graph)]
|
||
[unweighted-graph/directed (-> (Listof (List Any Any)) Graph)]
|
||
[unweighted-graph/adj (-> (Listof (Listof Any)) Graph)]
|
||
|
||
;; 2.2 Weighted Graphs
|
||
[weighted-graph? (-> Graph Boolean)]
|
||
[weighted-graph/undirected (-> (Listof (List Any Any Any)) Graph)]
|
||
[weighted-graph/directed (-> (Listof (List Any Any Any)) Graph)]
|
||
[undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
|
||
[directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
|
||
|
||
;; 2.3 Matrix Graphs
|
||
[matrix->matrix-graph (-> (Matrix Any) Matrix-Graph)]
|
||
[matrix-graph->graph (-> Matrix-Graph Graph)]
|
||
|
||
;; 4 Basic Graph Functions
|
||
;; 4.1 Breadth-first Search
|
||
[bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
|
||
(Mutable-HashTable Any Any)))]
|
||
[bfs/generalized (->* (Graph Any)
|
||
(#:init-queue Any ; TODO: Add a proper type.
|
||
#:break (-> Graph Any Any Any Boolean)
|
||
#:init (U (-> Graph Any Void) Void)
|
||
#:visit? (U (-> Graph Any Any Any Boolean) False)
|
||
#:discover (-> Graph Any Any Any Any Any)
|
||
#:visit (-> Graph Any Any Any Any)
|
||
#:return (-> Graph Any Any Any))
|
||
Any)]
|
||
[fewest-vertices-path (-> Graph Any Any (U (Listof Any) False))]
|
||
|
||
;; 4.2 Depth-first Search
|
||
[dfs (-> Graph (Values (Mutable-HashTable Any Number)
|
||
(Mutable-HashTable Any Any)
|
||
(Mutable-HashTable Any Number)))]
|
||
[dfs/generalized (->* (Graph)
|
||
(#:order (-> (Listof Any) (Listof Any))
|
||
#:break (-> Graph Any Any Any Boolean)
|
||
#:init (U (-> Graph Void) Void)
|
||
#:inner-init (-> Any Any)
|
||
#:visit? (U (-> Graph Any Any Boolean) False)
|
||
#:prologue (-> Graph Any Any Any Any)
|
||
#:epilogue (-> Graph Any Any Any Any)
|
||
#:process-unvisited? (-> Graph Any Any Boolean)
|
||
#:process-unvisited (-> Graph Any Any Any Any)
|
||
#:combine (-> Any Any Any)
|
||
#:return (-> Graph Any Any))
|
||
Any)]
|
||
[dag? (-> Graph Boolean)]
|
||
[tsort (-> Graph (Listof Any))]
|
||
[cc (-> Graph (Listof (Listof Any)))]
|
||
[cc/bfs (-> Graph (Listof (Listof Any)))]
|
||
[scc (-> Graph (Listof (Listof Any)))]
|
||
|
||
;; 5 Spanning Trees
|
||
[min-st-kruskal (-> Graph (Listof (List Any Any)))]
|
||
[max-st-kruskal (-> Graph (Listof (List Any Any)))]
|
||
[min-st-prim (-> Graph Any (Listof (List Any Any)))]
|
||
[max-st-prim (-> Graph Any (Listof (List Any Any)))]
|
||
|
||
;; 6 Single-source Shortest Paths
|
||
[bellman-ford (-> Graph Any (Values (Mutable-HashTable Any Number)
|
||
(Mutable-HashTable Any Any)))]
|
||
[dijkstra (-> Graph Any (Values (Mutable-HashTable Any Number)
|
||
(Mutable-HashTable Any Any)))]
|
||
[dag-shortest-paths (-> Graph Any (Values (Mutable-HashTable Any Number)
|
||
(Mutable-HashTable Any Any)))]
|
||
|
||
;; 7 All-pairs Shortest Paths
|
||
[floyd-warshall (-> Graph (Mutable-HashTable (List Any Any) Number))]
|
||
[transitive-closure (-> Graph (Mutable-HashTable (List Any Any) Boolean))]
|
||
[johnson (-> Graph (Mutable-HashTable (List Any Any) Number))]
|
||
|
||
;; 8 Coloring
|
||
[coloring (->* (Graph Natural)
|
||
(#:order (-> (Listof Any) (Listof Any)))
|
||
(U (Mutable-HashTable Any Number) False))]
|
||
[coloring/greedy (->* (Graph)
|
||
(#:order (U (-> (Listof Any) (Listof Any))
|
||
'smallest-last))
|
||
(Values Number
|
||
(Mutable-HashTable Any Number)))]
|
||
[coloring/brelaz (-> Graph (Mutable-HashTable Any Number))]
|
||
[order-smallest-last (-> Graph (Listof Any))]
|
||
[valid-coloring? (-> Graph (HashTable Any Number) Boolean)]
|
||
|
||
;; 9 Maximum Flow
|
||
[maxflow (-> Graph Any Any (HashTable (List Any Any) Number))]
|
||
[bipartite? (-> Graph (U (List (Listof Any) (Listof Any)) False))]
|
||
[maximum-bipartite-matching (-> Graph (Listof (List Any Any)))]
|
||
|
||
;; 10 Graphviz
|
||
[graphviz (->* (Graph)
|
||
(#:output Output-Port
|
||
#:colors (HashTable Any Natural))
|
||
String)])
|
||
|
||
|
||
(module+ test
|
||
;; The goal of the tests is to check that all of the provided
|
||
;; functions can be invoked without errors. The tests do not check
|
||
;; whether the results make sense.
|
||
(require typed/rackunit)
|
||
(require (only-in math/matrix matrix))
|
||
|
||
;; TODO: Submit an update to hash->list in Racket and then remove
|
||
;; this function.
|
||
(: hash->ordered-list (All (a b) (-> (HashTable a b) (Listof (Pairof a b)))))
|
||
(define (hash->ordered-list h)
|
||
(hash-map h (inst cons a b) #t))
|
||
|
||
(test-case "1 Generic Graph Interface"
|
||
(define g (directed-graph '((a b) (b c))))
|
||
(check-false (has-edge? g 'a 'c))
|
||
(check-true (has-vertex? g 'a))
|
||
(check-false (vertex=? g 'a 'c))
|
||
(add-vertex! g 'd)
|
||
(remove-vertex! g 'a)
|
||
(rename-vertex! g 'd 'a)
|
||
(add-edge! g 'a 'c)
|
||
(add-edge! g 'a 'c "a->c")
|
||
(add-directed-edge! g 'a 'c)
|
||
(add-directed-edge! g 'a 'c "a->c")
|
||
(remove-edge! g 'a 'c)
|
||
(remove-directed-edge! g 'a 'c)
|
||
(check-equal? (get-vertices g) '(c b a))
|
||
(check-equal? (sequence->list (in-vertices g)) '(c b a))
|
||
(check-equal? (get-neighbors g 'b) '(c))
|
||
(check-equal? (sequence->list (in-neighbors g 'b)) '(c))
|
||
(check-equal? (get-edges g) '((b c)))
|
||
(check-equal? (sequence->list (in-edges g)) '((b c)))
|
||
(check-equal? (edge-weight g 'a 'c) +inf.0)
|
||
(check-equal? (edge-weight g 'a 'c #:default 'none) 'none)
|
||
(check-equal? (graphviz (transpose g))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t}\n}\n")
|
||
(check-equal? (graphviz (graph-copy g))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode2 -> node0;\n\t}\n}\n")
|
||
(graph-union! g (transpose g)))
|
||
|
||
(test-case "2 Graph Constructors"
|
||
;; 2.1 Unweighted Graphs
|
||
(check-true (unweighted-graph? (directed-graph '((a b) (b c)))))
|
||
(check-equal? (graphviz (unweighted-graph/undirected '((a b) (b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node2;\n\t}\n\tsubgraph D {\n\t}\n}\n")
|
||
(check-equal? (graphviz (unweighted-graph/directed '((a b) (b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node2;\n\t\tnode2 -> node0;\n\t}\n}\n")
|
||
(check-equal? (graphviz (unweighted-graph/adj '((a b c) (b c d))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"d\"];\n\tnode3 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0;\n\t\tnode1 -> node3;\n\t\tnode3 -> node0;\n\t\tnode3 -> node2;\n\t}\n}\n")
|
||
|
||
;; 2.2 Weighted Graphs
|
||
(check-false (weighted-graph? (directed-graph '((a b) (b c)))))
|
||
(check-equal? (graphviz (weighted-graph/undirected '((10 a b) (20 b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2 [label=\"20\"];\n\t\tnode1 -> node2 [label=\"10\"];\n\t}\n\tsubgraph D {\n\t}\n}\n")
|
||
(check-equal? (graphviz (weighted-graph/directed '((10 a b) (20 b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node2 [label=\"10\"];\n\t\tnode2 -> node0 [label=\"20\"];\n\t}\n}\n")
|
||
(check-equal? (graphviz (undirected-graph '((a b) (b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node2;\n\t}\n\tsubgraph D {\n\t}\n}\n")
|
||
(check-equal? (graphviz (undirected-graph '((a b) (b c)) '(1 "hello")))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2 [label=\"hello\"];\n\t\tnode1 -> node2 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t}\n}\n")
|
||
(check-equal? (graphviz (directed-graph '((a b) (b c))))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node2;\n\t\tnode2 -> node0;\n\t}\n}\n")
|
||
(check-equal? (graphviz (directed-graph '((a b) (b c)) '(1 "hello")))
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node2 [label=\"1\"];\n\t\tnode2 -> node0 [label=\"hello\"];\n\t}\n}\n")
|
||
|
||
;; 2.3 Matrix Graphs
|
||
(check-false (matrix-graph? (directed-graph '((a b) (b c)))))
|
||
(define mg (matrix->matrix-graph (matrix [[1 2] [3 #f]])))
|
||
(check-true (matrix-graph? mg))
|
||
(check-true (has-vertex? (matrix-graph->graph mg) 1)))
|
||
|
||
(test-case "4 Basic Graph Functions"
|
||
;; 4.1 Breadth-first Search
|
||
(define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
|
||
(check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
|
||
(check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b)))
|
||
|
||
(check-equal? (bfs/generalized (directed-graph '((a b) (a c) (b d) (c d))) 'a)
|
||
(void))
|
||
|
||
(check-equal? (fewest-vertices-path (directed-graph '((a b) (b c) (c d))) 'a 'd)
|
||
'(a b c d))
|
||
|
||
;; 4.2 Depth-first Search
|
||
(define-values (dfs-discovery dfs-pred dfs-finish)
|
||
(dfs (directed-graph '((a b) (a c) (b d) (c d)))))
|
||
(check-equal? (hash->ordered-list dfs-discovery)
|
||
'((a . 4) (b . 5) (c . 0) (d . 1)))
|
||
(check-equal? (hash->ordered-list dfs-pred)
|
||
'((a . #f) (b . a) (c . #f) (d . c)))
|
||
(check-equal? (hash->ordered-list dfs-finish)
|
||
'((a . 7) (b . 6) (c . 3) (d . 2)))
|
||
|
||
(check-equal? (dfs/generalized (directed-graph '((a b) (a c) (b d) (c d))))
|
||
(void))
|
||
(check-true (dag? (directed-graph '((a b) (b c)))))
|
||
(check-false (dag? (directed-graph '((a b) (b a)))))
|
||
(check-equal? (tsort (directed-graph '((a b) (b c) (a d) (d b))))
|
||
'(a d b c))
|
||
(check-equal? (cc (undirected-graph '((a b) (b c) (d e))))
|
||
'((e d) (a b c)))
|
||
(check-equal? (cc/bfs (undirected-graph '((a b) (b c) (d e))))
|
||
'((e d) (a b c)))
|
||
(check-equal? (scc (directed-graph '((a b) (b c) (c a) (c d) (e a))))
|
||
'((e) (c b a) (d))))
|
||
|
||
;; 5 Spanning Trees
|
||
(test-case "5 Spanning Trees"
|
||
(define g0 (weighted-graph/undirected '((1 a b) (2 b c) (3 c a) (4 c d) (5 e a))))
|
||
|
||
(check-equal? (min-st-kruskal g0)
|
||
'((a e) (c d) (c b) (a b)))
|
||
(check-equal? (max-st-kruskal g0)
|
||
'((c b) (c a) (c d) (a e)))
|
||
(check-equal? (min-st-prim g0 'e)
|
||
'((b c) (e a) (c d) (a b)))
|
||
(check-equal? (max-st-prim g0 'e)
|
||
'((a c) (e a) (c d) (c b))))
|
||
|
||
(test-case "6 Single-source Shortest Paths"
|
||
(define g0 (weighted-graph/directed '((1 a b) (2 a c) (3 b d) (3 c d))))
|
||
|
||
(define-values (bf-dists bf-pred) (bellman-ford g0 'a))
|
||
(check-equal? (hash->ordered-list bf-dists)
|
||
'((a . 0) (b . 1) (c . 2) (d . 4)))
|
||
(check-equal? (hash->ordered-list bf-pred)
|
||
'((a . #f) (b . a) (c . a) (d . b)))
|
||
|
||
(define-values (dj-dists dj-pred) (dijkstra g0 'a))
|
||
(check-equal? (hash->ordered-list dj-dists)
|
||
'((a . 0) (b . 1) (c . 2) (d . 4)))
|
||
(check-equal? (hash->ordered-list dj-pred)
|
||
'((a . #f) (b . a) (c . a) (d . b)))
|
||
|
||
(define-values (dsp-dists dsp-pred) (dag-shortest-paths g0 'a))
|
||
(check-equal? (hash->ordered-list dsp-dists)
|
||
'((a . 0) (b . 1) (c . 2) (d . 4)))
|
||
(check-equal? (hash->ordered-list dsp-pred)
|
||
'((a . #f) (b . a) (c . a) (d . b))))
|
||
|
||
(test-case "7 All-pairs Shortest Paths"
|
||
(define g0 (weighted-graph/directed '((1 a b) (2 a c) (3 b d) (3 c d))))
|
||
|
||
(check-equal? (hash->ordered-list (floyd-warshall g0))
|
||
'(((a d) . 4.0)
|
||
((c c) . 0.0)
|
||
((b a) . +inf.0)
|
||
((a a) . 0.0)
|
||
((d c) . +inf.0)
|
||
((a c) . 2.0)
|
||
((c b) . +inf.0)
|
||
((d d) . 0.0)
|
||
((c a) . +inf.0)
|
||
((b c) . +inf.0)
|
||
((d a) . +inf.0)
|
||
((c d) . 3.0)
|
||
((b d) . 3.0)
|
||
((b b) . 0)
|
||
((d b) . +inf.0)
|
||
((a b) . 1.0)))
|
||
|
||
(check-equal? (hash->ordered-list (transitive-closure g0))
|
||
'(((a d) . #t)
|
||
((c c) . #t)
|
||
((b a) . #f)
|
||
((a a) . #t)
|
||
((d c) . #f)
|
||
((a c) . #t)
|
||
((c b) . #f)
|
||
((d d) . #t)
|
||
((c a) . #f)
|
||
((b c) . #f)
|
||
((d a) . #f)
|
||
((c d) . #t)
|
||
((b d) . #t)
|
||
((b b) . #t)
|
||
((d b) . #f)
|
||
((a b) . #t)))
|
||
|
||
(check-equal? (hash->ordered-list (johnson g0))
|
||
'(((a d) . 4)
|
||
((c c) . 0)
|
||
((b a) . +inf.0)
|
||
((a a) . 0)
|
||
((d c) . +inf.0)
|
||
((a c) . 2)
|
||
((c b) . +inf.0)
|
||
((d d) . 0)
|
||
((c a) . +inf.0)
|
||
((b c) . +inf.0)
|
||
((d a) . +inf.0)
|
||
((c d) . 3)
|
||
((b d) . 3)
|
||
((b b) . 0)
|
||
((d b) . +inf.0)
|
||
((a b) . 1))))
|
||
|
||
(test-case "8 Coloring"
|
||
(define g0 (undirected-graph '((a b) (b c) (c d) (d a))))
|
||
(check-equal? (hash->ordered-list (cast (coloring g0 5)
|
||
(Mutable-HashTable Any Number)))
|
||
'((a . 0) (b . 1) (c . 0) (d . 1)))
|
||
(check-false (coloring g0 1))
|
||
|
||
(define-values (ncolors colors) (coloring/greedy g0))
|
||
(check-equal? ncolors 2)
|
||
(check-equal? (hash->ordered-list colors)
|
||
'((a . 0) (b . 1) (c . 0) (d . 1)))
|
||
|
||
(check-equal? (hash->ordered-list (coloring/brelaz g0))
|
||
'((a . 0) (b . 1) (c . 0) (d . 1)))
|
||
|
||
(check-equal? (order-smallest-last g0) '(c d a b))
|
||
|
||
(check-true (valid-coloring? g0 #hash((a . 0) (b . 1) (c . 0) (d . 2)))))
|
||
|
||
(test-case "9 Maximum Flow"
|
||
(define g0 (weighted-graph/directed '((1 a b) (2 a c) (3 b d) (3 c d))))
|
||
(check-equal? (hash->ordered-list (maxflow g0 'a 'd))
|
||
'(((a b) . 1) ((c d) . 2) ((b d) . 1) ((a c) . 2)))
|
||
|
||
(define g1 (directed-graph '((a b) (c b))))
|
||
(check-false (bipartite? g0))
|
||
(check-equal? (bipartite? g1) '((b) (a c)))
|
||
(check-equal? (maximum-bipartite-matching g1) '((c b))))
|
||
|
||
(test-case "10 Graphviz"
|
||
(define g (directed-graph '((a b) (b c))))
|
||
(check-equal? (graphviz g)
|
||
"digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"a\"];\n\tnode2 [label=\"b\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node2;\n\t\tnode2 -> node0;\n\t}\n}\n")))
|