A typed interface to the Racket generic graph library.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

566 lines
23 KiB

1 year ago
2 years ago
1 year ago
1 year ago
2 years ago
2 years ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
2 years ago
2 years ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
2 years ago
2 years ago
1 year ago
1 year ago
1 year ago
1 year ago
1 year ago
2 years ago
1 year ago
1 year ago
1 year ago
1 year ago
2 years ago
  1. ;;; Copyright 2021 Sergiu Ivanov <sivanov@colimite.fr>
  2. ;;;
  3. ;;; Licensed under the Apache License, Version 2.0 (the "License");
  4. ;;; you may not use this file except in compliance with the License.
  5. ;;; You may obtain a copy of the License at
  6. ;;;
  7. ;;; http://www.apache.org/licenses/LICENSE-2.0
  8. ;;;
  9. ;;; Unless required by applicable law or agreed to in writing, software
  10. ;;; distributed under the License is distributed on an "AS IS" BASIS,
  11. ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. ;;; See the License for the specific language governing permissions and
  13. ;;; limitations under the License.
  14. #lang typed/racket
  15. ;;; This file implements Alex Knauth's solution presented here:
  16. ;;;
  17. ;;; https://stackoverflow.com/questions/65386334/racket-generic-graph-library-in-typed-racket
  18. (module graph-wrapper racket
  19. (require (prefix-in g: graph)
  20. data/gen-queue/fifo)
  21. (provide (struct-out graph) has-vertex? has-edge? vertex=? add-vertex! remove-vertex!
  22. rename-vertex! add-edge! add-directed-edge! remove-edge!
  23. remove-directed-edge! get-vertices in-vertices get-neighbors
  24. in-neighbors get-edges in-edges edge-weight transpose graph-copy
  25. graph-union!
  26. unweighted-graph? unweighted-graph/undirected
  27. unweighted-graph/directed unweighted-graph/adj
  28. weighted-graph? weighted-graph/undirected weighted-graph/directed
  29. undirected-graph directed-graph
  30. matrix-graph?
  31. bfs bfs/generalized fewest-vertices-path
  32. dfs dfs/generalized
  33. dag? tsort cc cc/bfs scc
  34. min-st-kruskal max-st-kruskal min-st-prim max-st-prim
  35. bellman-ford dijkstra dag-shortest-paths
  36. floyd-warshall transitive-closure johnson
  37. coloring coloring/greedy coloring/brelaz
  38. order-smallest-last
  39. graphviz)
  40. ;; Wrap the opaque graph structure coming from the generic
  41. ;; graph library.
  42. (struct graph (g))
  43. (define gg graph-g)
  44. ;; 1 Generic Graph Interface
  45. (define (has-vertex? g v)
  46. (g:has-vertex? (gg g) v))
  47. (define (has-edge? g u v)
  48. (g:has-edge? (gg g) u v))
  49. (define (vertex=? g u v)
  50. (g:vertex=? (gg g) u v))
  51. (define (add-vertex! g v)
  52. (g:add-vertex! (gg g) v))
  53. (define (remove-vertex! g v)
  54. (g:remove-vertex! (gg g) v))
  55. (define (rename-vertex! g u v)
  56. (g:rename-vertex! (gg g) u v))
  57. (define (add-edge! g u v [weight 'default-value])
  58. (g:add-edge! (gg g) u v weight))
  59. (define (add-directed-edge! g u v [weight 'default-value])
  60. (g:add-directed-edge! (gg g) u v weight))
  61. (define (remove-edge! g u v)
  62. (g:remove-edge! (gg g) u v))
  63. (define (remove-directed-edge! g u v)
  64. (g:remove-directed-edge! (gg g) u v))
  65. (define (get-vertices g)
  66. (g:get-vertices (gg g)))
  67. (define (in-vertices g)
  68. (g:in-vertices (gg g)))
  69. (define (get-neighbors g v)
  70. (g:get-neighbors (gg g) v))
  71. (define (in-neighbors g v)
  72. (g:in-neighbors (gg g) v))
  73. (define (get-edges g)
  74. (g:get-edges (gg g)))
  75. (define (in-edges g)
  76. (g:in-edges (gg g)))
  77. (define (edge-weight g u v #:default [default +inf.0])
  78. (g:edge-weight (gg g) u v #:default default))
  79. (define (transpose g)
  80. (graph (g:transpose (gg g))))
  81. (define (graph-copy g)
  82. (graph (g:graph-copy (gg g))))
  83. (define (graph-union! g other)
  84. (g:graph-union! (gg g) (gg other)))
  85. ;; 2 Graph constructors
  86. ;; 2.1 Unweighted Graphs
  87. (define (unweighted-graph? g)
  88. (g:unweighted-graph? (gg g)))
  89. (define (unweighted-graph/undirected edges)
  90. (graph (g:unweighted-graph/undirected edges)))
  91. (define (unweighted-graph/directed edges)
  92. (graph (g:unweighted-graph/directed edges)))
  93. (define (unweighted-graph/adj edges)
  94. (graph (g:unweighted-graph/adj edges)))
  95. ;; 2.2 Weighted Graphs
  96. (define (weighted-graph? g)
  97. (g:weighted-graph? (gg g)))
  98. (define (weighted-graph/undirected edges)
  99. (graph (g:weighted-graph/undirected edges)))
  100. (define (weighted-graph/directed edges)
  101. (graph (g:weighted-graph/directed edges)))
  102. (define (undirected-graph es [ws #f])
  103. (graph (g:undirected-graph es ws)))
  104. (define (directed-graph es [ws #f])
  105. (graph (g:directed-graph es ws)))
  106. ;; 2.3 Matrix Graphs
  107. (define (matrix-graph? g)
  108. (g:matrix-graph? (gg g)))
  109. ;; 4 Basic Graph Functions
  110. ;; 4.1 Breadth-first Search
  111. (define (bfs g source)
  112. (g:bfs (gg g) source))
  113. (define (bfs/generalized
  114. g
  115. source
  116. #:init-queue [init-queue (mk-empty-fifo)]
  117. #:break [break? (λ (G source from to) #f)]
  118. #:init [init void]
  119. #:visit? [custom-visit?-fn (λ (G source from to) #f)]
  120. #:discover [discover (λ (G s u v acc) acc)]
  121. #:visit [visit (λ (G s v acc) acc)]
  122. #:return [finish (λ (G s acc) acc)])
  123. (g:bfs/generalized
  124. (gg g)
  125. source
  126. #:init-queue init-queue
  127. #:break break?
  128. #:init init
  129. #:visit? custom-visit?-fn
  130. #:discover discover
  131. #:visit visit
  132. #:return finish))
  133. (define (fewest-vertices-path G source target)
  134. (g:fewest-vertices-path (gg G) source target))
  135. ;; 4.2 Depth-first Search
  136. (define (dfs g)
  137. (g:dfs (gg g)))
  138. (define (dfs/generalized
  139. g
  140. #:order [order (λ (x) x)]
  141. #:break [break (λ (g from to acc) #f)]
  142. #:init [init void]
  143. #:inner-init [inner-init (λ (acc) acc)]
  144. #:visit? [custom-visit?-fn #f]
  145. #:prologue [prologue (λ (G u v acc) acc)]
  146. #:epilogue [epilogue (λ (G u v acc) acc)]
  147. #:process-unvisited? [process-unvisited?
  148. (λ (G u v) #f)]
  149. #:process-unvisited [process-unvisited
  150. (λ (G u v acc) acc)]
  151. #:combine [combine (λ (x acc) x)]
  152. #:return [finish (λ (G acc) acc)])
  153. (g:dfs/generalized
  154. (gg g)
  155. #:order order
  156. #:break break
  157. #:init init
  158. #:inner-init inner-init
  159. #:visit? custom-visit?-fn
  160. #:prologue prologue
  161. #:epilogue epilogue
  162. #:process-unvisited? process-unvisited?
  163. #:process-unvisited process-unvisited
  164. #:combine combine
  165. #:return finish))
  166. (define (dag? g)
  167. (g:dag? (gg g)))
  168. (define (tsort g)
  169. (g:tsort (gg g)))
  170. (define (cc g)
  171. (g:cc (gg g)))
  172. (define (cc/bfs g)
  173. (g:cc/bfs (gg g)))
  174. (define (scc g)
  175. (g:scc (gg g)))
  176. ;; 5 Spanning Trees
  177. (define (min-st-kruskal g)
  178. (g:min-st-kruskal (gg g)))
  179. (define (max-st-kruskal g)
  180. (g:max-st-kruskal (gg g)))
  181. (define (min-st-prim g source)
  182. (g:min-st-prim (gg g) source))
  183. (define (max-st-prim g source)
  184. (g:max-st-prim (gg g) source))
  185. ;; 6 Single-source Shortest Paths
  186. (define (bellman-ford g source)
  187. (g:bellman-ford (gg g) source))
  188. (define (dijkstra g source)
  189. (g:dijkstra (gg g) source))
  190. (define (dag-shortest-paths g source)
  191. (g:dag-shortest-paths (gg g) source))
  192. ;; 7 All-pairs Shortest Paths
  193. (define (floyd-warshall g)
  194. (g:floyd-warshall (gg g)))
  195. (define (transitive-closure g)
  196. (g:transitive-closure (gg g)))
  197. (define (johnson g)
  198. (g:johnson (gg g)))
  199. ;; 8 Coloring
  200. (define (coloring g num-colors #:order [order (λ (x) x)])
  201. (g:coloring (gg g) num-colors #:order order))
  202. (define (coloring/greedy g #:order [order 'smallest-last])
  203. (g:coloring/greedy (gg g) #:order order))
  204. (define (coloring/brelaz g)
  205. (g:coloring/brelaz (gg g)))
  206. (define (order-smallest-last g)
  207. (g:order-smallest-last (gg g)))
  208. ;; 10 Graphviz
  209. (define (graphviz g #:output [output #f] #:colors [colors #f])
  210. (g:graphviz (gg g) #:output output #:colors colors)))
  211. (require/typed/provide 'graph-wrapper
  212. [#:opaque Graph graph?]
  213. ;; 1 Generic Graph Interface
  214. [has-vertex? (-> Graph Any Boolean)]
  215. [has-edge? (-> Graph Any Any Boolean)]
  216. [vertex=? (-> Graph Any Any Boolean)]
  217. [add-vertex! (-> Graph Any Void)]
  218. [remove-vertex! (-> Graph Any Void)]
  219. [rename-vertex! (-> Graph Any Any Void)]
  220. [add-edge! (->* (Graph Any Any) (Any) Void)]
  221. [add-directed-edge! (->* (Graph Any Any) (Any) Void)]
  222. [remove-edge! (-> Graph Any Any Void)]
  223. [remove-directed-edge! (-> Graph Any Any Void)]
  224. [get-vertices (-> Graph (Listof Any))]
  225. [in-vertices (-> Graph (Sequenceof Any))]
  226. [get-neighbors (-> Graph Any (Listof Any))]
  227. [in-neighbors (-> Graph Any (Sequenceof Any))]
  228. [get-edges (-> Graph (U (Listof (List Any Any)) (Listof (List Any Any Any))))]
  229. [in-edges (-> Graph (Sequenceof (U (List Any Any) (List Any Any Any))))]
  230. [edge-weight (->* (Graph Any Any) (#:default Any) Any)]
  231. [transpose (-> Graph Graph)]
  232. [graph-copy (-> Graph Graph)]
  233. [graph-union! (-> Graph Graph Void)]
  234. ;; 2 Graph constructors
  235. ;; 2.1 Unweighted Graphs
  236. [unweighted-graph? (-> Graph Boolean)]
  237. [unweighted-graph/undirected (-> (Listof (List Any Any)) Graph)]
  238. [unweighted-graph/directed (-> (Listof (List Any Any)) Graph)]
  239. [unweighted-graph/adj (-> (Listof (Listof Any)) Graph)]
  240. ;; 2.2 Weighted Graphs
  241. [weighted-graph? (-> Graph Boolean)]
  242. [weighted-graph/undirected (-> (Listof (List Any Any Any)) Graph)]
  243. [weighted-graph/directed (-> (Listof (List Any Any Any)) Graph)]
  244. [undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  245. [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  246. ;; 2.3 Matrix Graphs
  247. [matrix-graph? (-> Graph Boolean)]
  248. ;; 4 Basic Graph Functions
  249. ;; 4.1 Breadth-first Search
  250. [bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
  251. (Mutable-HashTable Any Any)))]
  252. [bfs/generalized (->* (Graph Any)
  253. (#:init-queue Any ; TODO: Add a proper type.
  254. #:break (-> Graph Any Any Any Boolean)
  255. #:init (U (-> Graph Any Void) Void)
  256. #:visit? (U (-> Graph Any Any Any Boolean) False)
  257. #:discover (-> Graph Any Any Any Any Any)
  258. #:visit (-> Graph Any Any Any Any)
  259. #:return (-> Graph Any Any Any))
  260. Any)]
  261. [fewest-vertices-path (-> Graph Any Any (U (Listof Any) False))]
  262. ;; 4.2 Depth-first Search
  263. [dfs (-> Graph (Values (Mutable-HashTable Any Number)
  264. (Mutable-HashTable Any Any)
  265. (Mutable-HashTable Any Number)))]
  266. [dfs/generalized (->* (Graph)
  267. (#:order (-> (Listof Any) (Listof Any))
  268. #:break (-> Graph Any Any Any Boolean)
  269. #:init (U (-> Graph Void) Void)
  270. #:inner-init (-> Any Any)
  271. #:visit? (U (-> Graph Any Any Boolean) False)
  272. #:prologue (-> Graph Any Any Any Any)
  273. #:epilogue (-> Graph Any Any Any Any)
  274. #:process-unvisited? (-> Graph Any Any Boolean)
  275. #:process-unvisited (-> Graph Any Any Any Any)
  276. #:combine (-> Any Any Any)
  277. #:return (-> Graph Any Any))
  278. Any)]
  279. [dag? (-> Graph Boolean)]
  280. [tsort (-> Graph (Listof Any))]
  281. [cc (-> Graph (Listof (Listof Any)))]
  282. [cc/bfs (-> Graph (Listof (Listof Any)))]
  283. [scc (-> Graph (Listof (Listof Any)))]
  284. ;; 5 Spanning Trees
  285. [min-st-kruskal (-> Graph (Listof (List Any Any)))]
  286. [max-st-kruskal (-> Graph (Listof (List Any Any)))]
  287. [min-st-prim (-> Graph Any (Listof (List Any Any)))]
  288. [max-st-prim (-> Graph Any (Listof (List Any Any)))]
  289. ;; 6 Single-source Shortest Paths
  290. [bellman-ford (-> Graph Any (Values (Mutable-HashTable Any Number)
  291. (Mutable-HashTable Any Any)))]
  292. [dijkstra (-> Graph Any (Values (Mutable-HashTable Any Number)
  293. (Mutable-HashTable Any Any)))]
  294. [dag-shortest-paths (-> Graph Any (Values (Mutable-HashTable Any Number)
  295. (Mutable-HashTable Any Any)))]
  296. ;; 7 All-pairs Shortest Paths
  297. [floyd-warshall (-> Graph (Mutable-HashTable (List Any Any) Number))]
  298. [transitive-closure (-> Graph (Mutable-HashTable (List Any Any) Boolean))]
  299. [johnson (-> Graph (Mutable-HashTable (List Any Any) Number))]
  300. ;; 8 Coloring
  301. [coloring (->* (Graph Natural)
  302. (#:order (-> (Listof Any) (Listof Any)))
  303. (U (Mutable-HashTable Any Number) False))]
  304. [coloring/greedy (->* (Graph)
  305. (#:order (U (-> (Listof Any) (Listof Any))
  306. 'smallest-last))
  307. (Values Number
  308. (Mutable-HashTable Any Number)))]
  309. [coloring/brelaz (-> Graph (Mutable-HashTable Any Number))]
  310. [order-smallest-last (-> Graph (Listof Any))]
  311. ;; 10 Graphviz
  312. [graphviz (->* (Graph)
  313. (#:output Output-Port
  314. #:colors (HashTable Any Natural))
  315. String)])
  316. (module+ test
  317. ;; The goal of the tests is to check that all of the provided
  318. ;; functions can be invoked without errors. The tests do not check
  319. ;; whether the results make sense.
  320. (require typed/rackunit)
  321. ;; TODO: Submit an update to hash->list in Racket and then remove
  322. ;; this function.
  323. (: hash->ordered-list (All (a b) (-> (HashTable a b) (Listof (Pairof a b)))))
  324. (define (hash->ordered-list h)
  325. (hash-map h (inst cons a b) #t))
  326. (test-case "1 Generic Graph Interface"
  327. (define g (directed-graph '((a b) (b c))))
  328. (check-false (has-edge? g 'a 'c))
  329. (check-true (has-vertex? g 'a))
  330. (check-false (vertex=? g 'a 'c))
  331. (add-vertex! g 'd)
  332. (remove-vertex! g 'a)
  333. (rename-vertex! g 'd 'a)
  334. (add-edge! g 'a 'c)
  335. (add-edge! g 'a 'c "a->c")
  336. (add-directed-edge! g 'a 'c)
  337. (add-directed-edge! g 'a 'c "a->c")
  338. (remove-edge! g 'a 'c)
  339. (remove-directed-edge! g 'a 'c)
  340. (check-equal? (get-vertices g) '(c b a))
  341. (check-equal? (sequence->list (in-vertices g)) '(c b a))
  342. (check-equal? (get-neighbors g 'b) '(c))
  343. (check-equal? (sequence->list (in-neighbors g 'b)) '(c))
  344. (check-equal? (get-edges g) '((b c)))
  345. (check-equal? (sequence->list (in-edges g)) '((b c)))
  346. (check-equal? (edge-weight g 'a 'c) +inf.0)
  347. (check-equal? (edge-weight g 'a 'c #:default 'none) 'none)
  348. (check-equal? (graphviz (transpose g))
  349. "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")
  350. (check-equal? (graphviz (graph-copy g))
  351. "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")
  352. (graph-union! g (transpose g)))
  353. (test-case "2 Graph Constructors"
  354. ;; 2.1 Unweighted Graphs
  355. (check-true (unweighted-graph? (directed-graph '((a b) (b c)))))
  356. (check-equal? (graphviz (unweighted-graph/undirected '((a b) (b c))))
  357. "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")
  358. (check-equal? (graphviz (unweighted-graph/directed '((a b) (b c))))
  359. "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")
  360. (check-equal? (graphviz (unweighted-graph/adj '((a b c) (b c d))))
  361. "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")
  362. ;; 2.2 Weighted Graphs
  363. (check-false (weighted-graph? (directed-graph '((a b) (b c)))))
  364. (check-equal? (graphviz (weighted-graph/undirected '((10 a b) (20 b c))))
  365. "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")
  366. (check-equal? (graphviz (weighted-graph/directed '((10 a b) (20 b c))))
  367. "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")
  368. (check-equal? (graphviz (undirected-graph '((a b) (b c))))
  369. "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")
  370. (check-equal? (graphviz (undirected-graph '((a b) (b c)) '(1 "hello")))
  371. "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")
  372. (check-equal? (graphviz (directed-graph '((a b) (b c))))
  373. "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")
  374. (check-equal? (graphviz (directed-graph '((a b) (b c)) '(1 "hello")))
  375. "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")
  376. ;; 2.3 Matrix Graphs
  377. (check-false (matrix-graph? (directed-graph '((a b) (b c))))))
  378. (test-case "4 Basic Graph Functions"
  379. ;; 4.1 Breadth-first Search
  380. (define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
  381. (check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
  382. (check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b)))
  383. (check-equal? (bfs/generalized (directed-graph '((a b) (a c) (b d) (c d))) 'a)
  384. (void))
  385. (check-equal? (fewest-vertices-path (directed-graph '((a b) (b c) (c d))) 'a 'd)
  386. '(a b c d))
  387. ;; 4.2 Depth-first Search
  388. (define-values (dfs-discovery dfs-pred dfs-finish)
  389. (dfs (directed-graph '((a b) (a c) (b d) (c d)))))
  390. (check-equal? (hash->ordered-list dfs-discovery)
  391. '((a . 4) (b . 5) (c . 0) (d . 1)))
  392. (check-equal? (hash->ordered-list dfs-pred)
  393. '((a . #f) (b . a) (c . #f) (d . c)))
  394. (check-equal? (hash->ordered-list dfs-finish)
  395. '((a . 7) (b . 6) (c . 3) (d . 2)))
  396. (check-equal? (dfs/generalized (directed-graph '((a b) (a c) (b d) (c d))))
  397. (void))
  398. (check-true (dag? (directed-graph '((a b) (b c)))))
  399. (check-false (dag? (directed-graph '((a b) (b a)))))
  400. (check-equal? (tsort (directed-graph '((a b) (b c) (a d) (d b))))
  401. '(a d b c))
  402. (check-equal? (cc (undirected-graph '((a b) (b c) (d e))))
  403. '((e d) (a b c)))
  404. (check-equal? (cc/bfs (undirected-graph '((a b) (b c) (d e))))
  405. '((e d) (a b c)))
  406. (check-equal? (scc (directed-graph '((a b) (b c) (c a) (c d) (e a))))
  407. '((e) (c b a) (d))))
  408. ;; 5 Spanning Trees
  409. (test-case "5 Spanning Trees"
  410. (define g0 (weighted-graph/undirected '((1 a b) (2 b c) (3 c a) (4 c d) (5 e a))))
  411. (check-equal? (min-st-kruskal g0)
  412. '((a e) (c d) (c b) (a b)))
  413. (check-equal? (max-st-kruskal g0)
  414. '((c b) (c a) (c d) (a e)))
  415. (check-equal? (min-st-prim g0 'e)
  416. '((b c) (e a) (c d) (a b)))
  417. (check-equal? (max-st-prim g0 'e)
  418. '((a c) (e a) (c d) (c b))))
  419. (test-case "6 Single-source Shortest Paths"
  420. (define g0 (weighted-graph/directed '((1 a b) (2 a c) (3 b d) (3 c d))))
  421. (define-values (bf-dists bf-pred) (bellman-ford g0 'a))
  422. (check-equal? (hash->ordered-list bf-dists)
  423. '((a . 0) (b . 1) (c . 2) (d . 4)))
  424. (check-equal? (hash->ordered-list bf-pred)
  425. '((a . #f) (b . a) (c . a) (d . b)))
  426. (define-values (dj-dists dj-pred) (dijkstra g0 'a))
  427. (check-equal? (hash->ordered-list dj-dists)
  428. '((a . 0) (b . 1) (c . 2) (d . 4)))
  429. (check-equal? (hash->ordered-list dj-pred)
  430. '((a . #f) (b . a) (c . a) (d . b)))
  431. (define-values (dsp-dists dsp-pred) (dag-shortest-paths g0 'a))
  432. (check-equal? (hash->ordered-list dsp-dists)
  433. '((a . 0) (b . 1) (c . 2) (d . 4)))
  434. (check-equal? (hash->ordered-list dsp-pred)
  435. '((a . #f) (b . a) (c . a) (d . b))))
  436. (test-case "7 All-pairs Shortest Paths"
  437. (define g0 (weighted-graph/directed '((1 a b) (2 a c) (3 b d) (3 c d))))
  438. (check-equal? (hash->ordered-list (floyd-warshall g0))
  439. '(((a d) . 4.0)
  440. ((c c) . 0.0)
  441. ((b a) . +inf.0)
  442. ((a a) . 0.0)
  443. ((d c) . +inf.0)
  444. ((a c) . 2.0)
  445. ((c b) . +inf.0)
  446. ((d d) . 0.0)
  447. ((c a) . +inf.0)
  448. ((b c) . +inf.0)
  449. ((d a) . +inf.0)
  450. ((c d) . 3.0)
  451. ((b d) . 3.0)
  452. ((b b) . 0)
  453. ((d b) . +inf.0)
  454. ((a b) . 1.0)))
  455. (check-equal? (hash->ordered-list (transitive-closure g0))
  456. '(((a d) . #t)
  457. ((c c) . #t)
  458. ((b a) . #f)
  459. ((a a) . #t)
  460. ((d c) . #f)
  461. ((a c) . #t)
  462. ((c b) . #f)
  463. ((d d) . #t)
  464. ((c a) . #f)
  465. ((b c) . #f)
  466. ((d a) . #f)
  467. ((c d) . #t)
  468. ((b d) . #t)
  469. ((b b) . #t)
  470. ((d b) . #f)
  471. ((a b) . #t)))
  472. (check-equal? (hash->ordered-list (johnson g0))
  473. '(((a d) . 4)
  474. ((c c) . 0)
  475. ((b a) . +inf.0)
  476. ((a a) . 0)
  477. ((d c) . +inf.0)
  478. ((a c) . 2)
  479. ((c b) . +inf.0)
  480. ((d d) . 0)
  481. ((c a) . +inf.0)
  482. ((b c) . +inf.0)
  483. ((d a) . +inf.0)
  484. ((c d) . 3)
  485. ((b d) . 3)
  486. ((b b) . 0)
  487. ((d b) . +inf.0)
  488. ((a b) . 1))))
  489. (test-case "8 Coloring"
  490. (define g0 (undirected-graph '((a b) (b c) (c d) (d a))))
  491. (check-equal? (hash->ordered-list (cast (coloring g0 5)
  492. (Mutable-HashTable Any Number)))
  493. '((a . 0) (b . 1) (c . 0) (d . 1)))
  494. (check-false (coloring g0 1))
  495. (define-values (ncolors colors) (coloring/greedy g0))
  496. (check-equal? ncolors 2)
  497. (check-equal? (hash->ordered-list colors)
  498. '((a . 0) (b . 1) (c . 0) (d . 1)))
  499. (check-equal? (hash->ordered-list (coloring/brelaz g0))
  500. '((a . 0) (b . 1) (c . 0) (d . 1)))
  501. (check-equal? (order-smallest-last g0) '(c d a b)))
  502. (test-case "10 Graphviz"
  503. (define g (directed-graph '((a b) (b c))))
  504. (check-equal? (graphviz g)
  505. "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")))