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.

254 lines
12 KiB

1 year ago
1 year ago
1 year ago
2 years 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. (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
  31. graphviz)
  32. ;; Wrap the opaque graph structure coming from the generic
  33. ;; graph library.
  34. (struct graph (g))
  35. (define gg graph-g)
  36. ;; 1 Generic Graph Interface
  37. (define (has-vertex? g v)
  38. (g:has-vertex? (gg g) v))
  39. (define (has-edge? g u v)
  40. (g:has-edge? (gg g) u v))
  41. (define (vertex=? g u v)
  42. (g:vertex=? (gg g) u v))
  43. (define (add-vertex! g v)
  44. (g:add-vertex! (gg g) v))
  45. (define (remove-vertex! g v)
  46. (g:remove-vertex! (gg g) v))
  47. (define (rename-vertex! g u v)
  48. (g:rename-vertex! (gg g) u v))
  49. (define (add-edge! g u v [weight 'default-value])
  50. (g:add-edge! (gg g) u v weight))
  51. (define (add-directed-edge! g u v [weight 'default-value])
  52. (g:add-directed-edge! (gg g) u v weight))
  53. (define (remove-edge! g u v)
  54. (g:remove-edge! (gg g) u v))
  55. (define (remove-directed-edge! g u v)
  56. (g:remove-directed-edge! (gg g) u v))
  57. (define (get-vertices g)
  58. (g:get-vertices (gg g)))
  59. (define (in-vertices g)
  60. (g:in-vertices (gg g)))
  61. (define (get-neighbors g v)
  62. (g:get-neighbors (gg g) v))
  63. (define (in-neighbors g v)
  64. (g:in-neighbors (gg g) v))
  65. (define (get-edges g)
  66. (g:get-edges (gg g)))
  67. (define (in-edges g)
  68. (g:in-edges (gg g)))
  69. (define (edge-weight g u v #:default [default +inf.0])
  70. (g:edge-weight (gg g) u v #:default default))
  71. (define (transpose g)
  72. (graph (g:transpose (gg g))))
  73. (define (graph-copy g)
  74. (graph (g:graph-copy (gg g))))
  75. (define (graph-union! g other)
  76. (g:graph-union! (gg g) (gg other)))
  77. ;; 2 Graph constructors
  78. ;; 2.1 Unweighted Graphs
  79. (define (unweighted-graph? g)
  80. (g:unweighted-graph? (gg g)))
  81. (define (unweighted-graph/undirected edges)
  82. (graph (g:unweighted-graph/undirected edges)))
  83. (define (unweighted-graph/directed edges)
  84. (graph (g:unweighted-graph/directed edges)))
  85. (define (unweighted-graph/adj edges)
  86. (graph (g:unweighted-graph/adj edges)))
  87. ;; 2.2 Weighted Graphs
  88. (define (weighted-graph? g)
  89. (g:weighted-graph? (gg g)))
  90. (define (weighted-graph/undirected edges)
  91. (graph (g:weighted-graph/undirected edges)))
  92. (define (weighted-graph/directed edges)
  93. (graph (g:weighted-graph/directed edges)))
  94. (define (undirected-graph es [ws #f])
  95. (graph (g:undirected-graph es ws)))
  96. (define (directed-graph es [ws #f])
  97. (graph (g:directed-graph es ws)))
  98. ;; 2.3 Matrix Graphs
  99. (define (matrix-graph? g)
  100. (g:matrix-graph? (gg g)))
  101. ;; 4 Basic Graph Functions
  102. ;; 4.1 Breadth-first Search
  103. (define (bfs g source)
  104. (g:bfs (gg g) source))
  105. ;; 10 Graphviz
  106. (define (graphviz g #:output [output #f] #:colors [colors #f])
  107. (g:graphviz (gg g) #:output output #:colors colors)))
  108. (require/typed/provide 'graph-wrapper
  109. [#:opaque Graph graph?]
  110. ;; 1 Generic Graph Interface
  111. [has-vertex? (-> Graph Any Boolean)]
  112. [has-edge? (-> Graph Any Any Boolean)]
  113. [vertex=? (-> Graph Any Any Boolean)]
  114. [add-vertex! (-> Graph Any Void)]
  115. [remove-vertex! (-> Graph Any Void)]
  116. [rename-vertex! (-> Graph Any Any Void)]
  117. [add-edge! (->* (Graph Any Any) (Any) Void)]
  118. [add-directed-edge! (->* (Graph Any Any) (Any) Void)]
  119. [remove-edge! (-> Graph Any Any Void)]
  120. [remove-directed-edge! (-> Graph Any Any Void)]
  121. [get-vertices (-> Graph (Listof Any))]
  122. [in-vertices (-> Graph (Sequenceof Any))]
  123. [get-neighbors (-> Graph Any (Listof Any))]
  124. [in-neighbors (-> Graph Any (Sequenceof Any))]
  125. [get-edges (-> Graph (U (Listof (List Any Any)) (Listof (List Any Any Any))))]
  126. [in-edges (-> Graph (Sequenceof (U (List Any Any) (List Any Any Any))))]
  127. [edge-weight (->* (Graph Any Any) (#:default Any) Any)]
  128. [transpose (-> Graph Graph)]
  129. [graph-copy (-> Graph Graph)]
  130. [graph-union! (-> Graph Graph Void)]
  131. ;; 2 Graph constructors
  132. ;; 2.1 Unweighted Graphs
  133. [unweighted-graph? (-> Graph Boolean)]
  134. [unweighted-graph/undirected (-> (Listof (List Any Any)) Graph)]
  135. [unweighted-graph/directed (-> (Listof (List Any Any)) Graph)]
  136. [unweighted-graph/adj (-> (Listof (Listof Any)) Graph)]
  137. ;; 2.2 Weighted Graphs
  138. [weighted-graph? (-> Graph Boolean)]
  139. [weighted-graph/undirected (-> (Listof (List Any Any Any)) Graph)]
  140. [weighted-graph/directed (-> (Listof (List Any Any Any)) Graph)]
  141. [undirected-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  142. [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  143. ;; 2.3 Matrix Graphs
  144. [matrix-graph? (-> Graph Boolean)]
  145. ;; 4 Basic Graph Functions
  146. ;; 4.1 Breadth-first Search
  147. [bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
  148. (Mutable-HashTable Any Any)))]
  149. ;; 10 Graphviz
  150. [graphviz (->* (Graph)
  151. (#:output Output-Port
  152. #:colors (HashTable Any Natural))
  153. String)])
  154. (module+ test
  155. ;; The goal of the tests is to check that all of the provided
  156. ;; functions can be invoked without errors. The tests do not check
  157. ;; whether the results make sense.
  158. (require typed/rackunit)
  159. ;; TODO: Submit an update to hash->list in Racket and then remove
  160. ;; this function.
  161. (: hash->ordered-list (All (a b) (-> (HashTable a b) (Listof (Pairof a b)))))
  162. (define (hash->ordered-list h)
  163. (hash-map h (inst cons a b) #t))
  164. (test-case "1 Generic Graph Interface"
  165. (define g (directed-graph '((a b) (b c))))
  166. (check-false (has-edge? g 'a 'c))
  167. (check-true (has-vertex? g 'a))
  168. (check-false (vertex=? g 'a 'c))
  169. (add-vertex! g 'd)
  170. (remove-vertex! g 'a)
  171. (rename-vertex! g 'd 'a)
  172. (add-edge! g 'a 'c)
  173. (add-edge! g 'a 'c "a->c")
  174. (add-directed-edge! g 'a 'c)
  175. (add-directed-edge! g 'a 'c "a->c")
  176. (remove-edge! g 'a 'c)
  177. (remove-directed-edge! g 'a 'c)
  178. (check-equal? (get-vertices g) '(c b a))
  179. (check-equal? (sequence->list (in-vertices g)) '(c b a))
  180. (check-equal? (get-neighbors g 'b) '(c))
  181. (check-equal? (sequence->list (in-neighbors g 'b)) '(c))
  182. (check-equal? (get-edges g) '((b c)))
  183. (check-equal? (sequence->list (in-edges g)) '((b c)))
  184. (check-equal? (edge-weight g 'a 'c) +inf.0)
  185. (check-equal? (edge-weight g 'a 'c #:default 'none) 'none)
  186. (check-equal? (graphviz (transpose g))
  187. "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")
  188. (check-equal? (graphviz (graph-copy g))
  189. "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")
  190. (graph-union! g (transpose g)))
  191. (test-case "2 Graph Constructors"
  192. ;; 2.1 Unweighted Graphs
  193. (check-true (unweighted-graph? (directed-graph '((a b) (b c)))))
  194. (check-equal? (graphviz (unweighted-graph/undirected '((a b) (b c))))
  195. "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")
  196. (check-equal? (graphviz (unweighted-graph/directed '((a b) (b c))))
  197. "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")
  198. (check-equal? (graphviz (unweighted-graph/adj '((a b c) (b c d))))
  199. "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")
  200. ;; 2.2 Weighted Graphs
  201. (check-false (weighted-graph? (directed-graph '((a b) (b c)))))
  202. (check-equal? (graphviz (weighted-graph/undirected '((10 a b) (20 b c))))
  203. "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")
  204. (check-equal? (graphviz (weighted-graph/directed '((10 a b) (20 b c))))
  205. "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")
  206. (check-equal? (graphviz (undirected-graph '((a b) (b c))))
  207. "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")
  208. (check-equal? (graphviz (undirected-graph '((a b) (b c)) '(1 "hello")))
  209. "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")
  210. (check-equal? (graphviz (directed-graph '((a b) (b c))))
  211. "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")
  212. (check-equal? (graphviz (directed-graph '((a b) (b c)) '(1 "hello")))
  213. "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")
  214. ;; 2.3 Matrix Graphs
  215. (check-false (matrix-graph? (directed-graph '((a b) (b c))))))
  216. (test-case "4 Basic Graph Functions"
  217. ;; 4.1 Breadth-first Search
  218. (define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
  219. (check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
  220. (check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b))))
  221. (test-case "10 Graphviz"
  222. (define g (directed-graph '((a b) (b c))))
  223. (check-equal? (graphviz g)
  224. "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")))