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.

323 lines
14 KiB

1 year ago
1 year ago
1 year ago
9 months ago
9 months ago
1 year ago
1 year ago
9 months ago
9 months ago
2 years ago
1 year ago
9 months 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. (provide (struct-out graph) has-vertex? has-edge? vertex=? add-vertex! remove-vertex!
  21. rename-vertex! add-edge! add-directed-edge! remove-edge!
  22. remove-directed-edge! get-vertices in-vertices get-neighbors
  23. in-neighbors get-edges in-edges edge-weight transpose graph-copy
  24. graph-union!
  25. unweighted-graph? unweighted-graph/undirected
  26. unweighted-graph/directed unweighted-graph/adj
  27. weighted-graph? weighted-graph/undirected weighted-graph/directed
  28. undirected-graph directed-graph
  29. matrix-graph?
  30. bfs fewest-vertices-path
  31. dfs dfs/generalized
  32. graphviz)
  33. ;; Wrap the opaque graph structure coming from the generic
  34. ;; graph library.
  35. (struct graph (g))
  36. (define gg graph-g)
  37. ;; 1 Generic Graph Interface
  38. (define (has-vertex? g v)
  39. (g:has-vertex? (gg g) v))
  40. (define (has-edge? g u v)
  41. (g:has-edge? (gg g) u v))
  42. (define (vertex=? g u v)
  43. (g:vertex=? (gg g) u v))
  44. (define (add-vertex! g v)
  45. (g:add-vertex! (gg g) v))
  46. (define (remove-vertex! g v)
  47. (g:remove-vertex! (gg g) v))
  48. (define (rename-vertex! g u v)
  49. (g:rename-vertex! (gg g) u v))
  50. (define (add-edge! g u v [weight 'default-value])
  51. (g:add-edge! (gg g) u v weight))
  52. (define (add-directed-edge! g u v [weight 'default-value])
  53. (g:add-directed-edge! (gg g) u v weight))
  54. (define (remove-edge! g u v)
  55. (g:remove-edge! (gg g) u v))
  56. (define (remove-directed-edge! g u v)
  57. (g:remove-directed-edge! (gg g) u v))
  58. (define (get-vertices g)
  59. (g:get-vertices (gg g)))
  60. (define (in-vertices g)
  61. (g:in-vertices (gg g)))
  62. (define (get-neighbors g v)
  63. (g:get-neighbors (gg g) v))
  64. (define (in-neighbors g v)
  65. (g:in-neighbors (gg g) v))
  66. (define (get-edges g)
  67. (g:get-edges (gg g)))
  68. (define (in-edges g)
  69. (g:in-edges (gg g)))
  70. (define (edge-weight g u v #:default [default +inf.0])
  71. (g:edge-weight (gg g) u v #:default default))
  72. (define (transpose g)
  73. (graph (g:transpose (gg g))))
  74. (define (graph-copy g)
  75. (graph (g:graph-copy (gg g))))
  76. (define (graph-union! g other)
  77. (g:graph-union! (gg g) (gg other)))
  78. ;; 2 Graph constructors
  79. ;; 2.1 Unweighted Graphs
  80. (define (unweighted-graph? g)
  81. (g:unweighted-graph? (gg g)))
  82. (define (unweighted-graph/undirected edges)
  83. (graph (g:unweighted-graph/undirected edges)))
  84. (define (unweighted-graph/directed edges)
  85. (graph (g:unweighted-graph/directed edges)))
  86. (define (unweighted-graph/adj edges)
  87. (graph (g:unweighted-graph/adj edges)))
  88. ;; 2.2 Weighted Graphs
  89. (define (weighted-graph? g)
  90. (g:weighted-graph? (gg g)))
  91. (define (weighted-graph/undirected edges)
  92. (graph (g:weighted-graph/undirected edges)))
  93. (define (weighted-graph/directed edges)
  94. (graph (g:weighted-graph/directed edges)))
  95. (define (undirected-graph es [ws #f])
  96. (graph (g:undirected-graph es ws)))
  97. (define (directed-graph es [ws #f])
  98. (graph (g:directed-graph es ws)))
  99. ;; 2.3 Matrix Graphs
  100. (define (matrix-graph? g)
  101. (g:matrix-graph? (gg g)))
  102. ;; 4 Basic Graph Functions
  103. ;; 4.1 Breadth-first Search
  104. (define (bfs g source)
  105. (g:bfs (gg g) source))
  106. (define (fewest-vertices-path G source target)
  107. (g:fewest-vertices-path (gg G) source target))
  108. ;; 4.2 Depth-first Search
  109. (define (dfs g)
  110. (g:dfs (gg g)))
  111. (define (dfs/generalized
  112. g
  113. #:order [order (λ (x) x)]
  114. #:break [break (λ (g from to acc) #f)]
  115. #:init [init void]
  116. #:inner-init [inner-init (λ (acc) acc)]
  117. #:visit? [custom-visit?-fn #f]
  118. #:prologue [prologue (λ (G u v acc) acc)]
  119. #:epilogue [epilogue (λ (G u v acc) acc)]
  120. #:process-unvisited? [process-unvisited?
  121. (λ (G u v) #f)]
  122. #:process-unvisited [process-unvisited
  123. (λ (G u v acc) acc)]
  124. #:combine [combine (λ (x acc) x)]
  125. #:return [finish (λ (G acc) acc)])
  126. (g:dfs/generalized
  127. (gg g)
  128. #:order order
  129. #:break break
  130. #:init init
  131. #:inner-init inner-init
  132. #:visit? custom-visit?-fn
  133. #:prologue prologue
  134. #:epilogue epilogue
  135. #:process-unvisited? process-unvisited?
  136. #:process-unvisited process-unvisited
  137. #:combine combine
  138. #:return finish))
  139. ;; 10 Graphviz
  140. (define (graphviz g #:output [output #f] #:colors [colors #f])
  141. (g:graphviz (gg g) #:output output #:colors colors)))
  142. (require/typed/provide 'graph-wrapper
  143. [#:opaque Graph graph?]
  144. ;; 1 Generic Graph Interface
  145. [has-vertex? (-> Graph Any Boolean)]
  146. [has-edge? (-> Graph Any Any Boolean)]
  147. [vertex=? (-> Graph Any Any Boolean)]
  148. [add-vertex! (-> Graph Any Void)]
  149. [remove-vertex! (-> Graph Any Void)]
  150. [rename-vertex! (-> Graph Any Any Void)]
  151. [add-edge! (->* (Graph Any Any) (Any) Void)]
  152. [add-directed-edge! (->* (Graph Any Any) (Any) Void)]
  153. [remove-edge! (-> Graph Any Any Void)]
  154. [remove-directed-edge! (-> Graph Any Any Void)]
  155. [get-vertices (-> Graph (Listof Any))]
  156. [in-vertices (-> Graph (Sequenceof Any))]
  157. [get-neighbors (-> Graph Any (Listof Any))]
  158. [in-neighbors (-> Graph Any (Sequenceof Any))]
  159. [get-edges (-> Graph (U (Listof (List Any Any)) (Listof (List Any Any Any))))]
  160. [in-edges (-> Graph (Sequenceof (U (List Any Any) (List Any Any Any))))]
  161. [edge-weight (->* (Graph Any Any) (#:default Any) Any)]
  162. [transpose (-> Graph Graph)]
  163. [graph-copy (-> Graph Graph)]
  164. [graph-union! (-> Graph Graph Void)]
  165. ;; 2 Graph constructors
  166. ;; 2.1 Unweighted Graphs
  167. [unweighted-graph? (-> Graph Boolean)]
  168. [unweighted-graph/undirected (-> (Listof (List Any Any)) Graph)]
  169. [unweighted-graph/directed (-> (Listof (List Any Any)) Graph)]
  170. [unweighted-graph/adj (-> (Listof (Listof Any)) Graph)]
  171. ;; 2.2 Weighted Graphs
  172. [weighted-graph? (-> Graph Boolean)]
  173. [weighted-graph/undirected (-> (Listof (List Any Any Any)) Graph)]
  174. [weighted-graph/directed (-> (Listof (List Any Any Any)) Graph)]
  175. [undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  176. [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  177. ;; 2.3 Matrix Graphs
  178. [matrix-graph? (-> Graph Boolean)]
  179. ;; 4 Basic Graph Functions
  180. ;; 4.1 Breadth-first Search
  181. [bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
  182. (Mutable-HashTable Any Any)))]
  183. [fewest-vertices-path (-> Graph Any Any (U (Listof Any) False))]
  184. ;; 4.2 Depth-first Search
  185. [dfs (-> Graph (Values (Mutable-HashTable Any Number)
  186. (Mutable-HashTable Any Any)
  187. (Mutable-HashTable Any Number)))]
  188. [dfs/generalized (->* (Graph)
  189. (#:order (-> (Listof Any) (Listof Any))
  190. #:break (-> Graph Any Any Any Boolean)
  191. #:init (-> Graph Void)
  192. #:inner-init (-> Any Any)
  193. #:visit? (-> Graph Any Any Boolean)
  194. #:prologue (-> Graph Any Any Any Any)
  195. #:epilogue (-> Graph Any Any Any Any)
  196. #:process-unvisited? (-> Graph Any Any Boolean)
  197. #:process-unvisited (-> Graph Any Any Any Any)
  198. #:combine (-> Any Any Any)
  199. #:return (-> Graph Any Any))
  200. Any)]
  201. ;; 10 Graphviz
  202. [graphviz (->* (Graph)
  203. (#:output Output-Port
  204. #:colors (HashTable Any Natural))
  205. String)])
  206. (module+ test
  207. ;; The goal of the tests is to check that all of the provided
  208. ;; functions can be invoked without errors. The tests do not check
  209. ;; whether the results make sense.
  210. (require typed/rackunit)
  211. ;; TODO: Submit an update to hash->list in Racket and then remove
  212. ;; this function.
  213. (: hash->ordered-list (All (a b) (-> (HashTable a b) (Listof (Pairof a b)))))
  214. (define (hash->ordered-list h)
  215. (hash-map h (inst cons a b) #t))
  216. (test-case "1 Generic Graph Interface"
  217. (define g (directed-graph '((a b) (b c))))
  218. (check-false (has-edge? g 'a 'c))
  219. (check-true (has-vertex? g 'a))
  220. (check-false (vertex=? g 'a 'c))
  221. (add-vertex! g 'd)
  222. (remove-vertex! g 'a)
  223. (rename-vertex! g 'd 'a)
  224. (add-edge! g 'a 'c)
  225. (add-edge! g 'a 'c "a->c")
  226. (add-directed-edge! g 'a 'c)
  227. (add-directed-edge! g 'a 'c "a->c")
  228. (remove-edge! g 'a 'c)
  229. (remove-directed-edge! g 'a 'c)
  230. (check-equal? (get-vertices g) '(c b a))
  231. (check-equal? (sequence->list (in-vertices g)) '(c b a))
  232. (check-equal? (get-neighbors g 'b) '(c))
  233. (check-equal? (sequence->list (in-neighbors g 'b)) '(c))
  234. (check-equal? (get-edges g) '((b c)))
  235. (check-equal? (sequence->list (in-edges g)) '((b c)))
  236. (check-equal? (edge-weight g 'a 'c) +inf.0)
  237. (check-equal? (edge-weight g 'a 'c #:default 'none) 'none)
  238. (check-equal? (graphviz (transpose g))
  239. "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")
  240. (check-equal? (graphviz (graph-copy g))
  241. "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")
  242. (graph-union! g (transpose g)))
  243. (test-case "2 Graph Constructors"
  244. ;; 2.1 Unweighted Graphs
  245. (check-true (unweighted-graph? (directed-graph '((a b) (b c)))))
  246. (check-equal? (graphviz (unweighted-graph/undirected '((a b) (b c))))
  247. "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")
  248. (check-equal? (graphviz (unweighted-graph/directed '((a b) (b c))))
  249. "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")
  250. (check-equal? (graphviz (unweighted-graph/adj '((a b c) (b c d))))
  251. "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")
  252. ;; 2.2 Weighted Graphs
  253. (check-false (weighted-graph? (directed-graph '((a b) (b c)))))
  254. (check-equal? (graphviz (weighted-graph/undirected '((10 a b) (20 b c))))
  255. "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")
  256. (check-equal? (graphviz (weighted-graph/directed '((10 a b) (20 b c))))
  257. "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")
  258. (check-equal? (graphviz (undirected-graph '((a b) (b c))))
  259. "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")
  260. (check-equal? (graphviz (undirected-graph '((a b) (b c)) '(1 "hello")))
  261. "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")
  262. (check-equal? (graphviz (directed-graph '((a b) (b c))))
  263. "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")
  264. (check-equal? (graphviz (directed-graph '((a b) (b c)) '(1 "hello")))
  265. "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")
  266. ;; 2.3 Matrix Graphs
  267. (check-false (matrix-graph? (directed-graph '((a b) (b c))))))
  268. (test-case "4 Basic Graph Functions"
  269. ;; 4.1 Breadth-first Search
  270. (define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
  271. (check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
  272. (check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b)))
  273. (check-equal? (fewest-vertices-path (directed-graph '((a b) (b c) (c d))) 'a 'd)
  274. '(a b c d))
  275. ;; 4.2 Depth-first Search
  276. (define-values (dfs-discovery dfs-pred dfs-finish)
  277. (dfs (directed-graph '((a b) (a c) (b d) (c d)))))
  278. (check-equal? (hash->ordered-list dfs-discovery)
  279. '((a . 4) (b . 5) (c . 0) (d . 1)))
  280. (check-equal? (hash->ordered-list dfs-pred)
  281. '((a . #f) (b . a) (c . #f) (d . c)))
  282. (check-equal? (hash->ordered-list dfs-finish)
  283. '((a . 7) (b . 6) (c . 3) (d . 2)))
  284. (check-equal? (dfs/generalized (directed-graph '((a b) (a c) (b d) (c d))))
  285. (void)))
  286. (test-case "10 Graphviz"
  287. (define g (directed-graph '((a b) (b c))))
  288. (check-equal? (graphviz g)
  289. "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")))