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.

163 lines
6.1 KiB

2 years 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 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. directed-graph
  26. graphviz)
  27. ;; Wrap the opaque graph structure coming from the generic
  28. ;; graph library.
  29. (struct graph (g))
  30. (define gg graph-g)
  31. ;; 1 Generic Graph Interface
  32. (define (has-vertex? g v)
  33. (g:has-vertex? (gg g) v))
  34. (define (has-edge? g u v)
  35. (g:has-edge? (gg g) u v))
  36. (define (vertex=? g u v)
  37. (g:vertex=? (gg g) u v))
  38. (define (add-vertex! g v)
  39. (g:add-vertex! (gg g) v))
  40. (define (remove-vertex! g v)
  41. (g:remove-vertex! (gg g) v))
  42. (define (rename-vertex! g u v)
  43. (g:rename-vertex! (gg g) u v))
  44. (define (add-edge! g u v [weight 'default-value])
  45. (g:add-edge! (gg g) u v weight))
  46. (define (add-directed-edge! g u v [weight 'default-value])
  47. (g:add-directed-edge! (gg g) u v weight))
  48. (define (remove-edge! g u v)
  49. (g:remove-edge! (gg g) u v))
  50. (define (remove-directed-edge! g u v)
  51. (g:remove-directed-edge! (gg g) u v))
  52. (define (get-vertices g)
  53. (g:get-vertices (gg g)))
  54. (define (in-vertices g)
  55. (g:in-vertices (gg g)))
  56. (define (get-neighbors g v)
  57. (g:get-neighbors (gg g) v))
  58. (define (in-neighbors g v)
  59. (g:in-neighbors (gg g) v))
  60. (define (get-edges g)
  61. (g:get-edges (gg g)))
  62. (define (in-edges g)
  63. (g:in-edges (gg g)))
  64. (define (edge-weight g u v #:default [default +inf.0])
  65. (g:edge-weight (gg g) u v #:default default))
  66. (define (transpose g)
  67. (graph (g:transpose (gg g))))
  68. (define (graph-copy g)
  69. (graph (g:graph-copy (gg g))))
  70. (define (graph-union! g other)
  71. (g:graph-union! (gg g) (gg other)))
  72. ;; 2 Graph constructors
  73. ;; 2.2 Weighted graphs
  74. (define (directed-graph es [ws #f])
  75. (graph (g:directed-graph es ws)))
  76. ;; 10 Graphviz
  77. (define (graphviz g #:output [output #f] #:colors [colors #f])
  78. (g:graphviz (gg g) #:output output #:colors colors)))
  79. (require/typed/provide 'graph-wrapper
  80. [#:opaque Graph graph?]
  81. ;; 1 Generic Graph Interface
  82. [has-vertex? (-> Graph Any Boolean)]
  83. [has-edge? (-> Graph Any Any Boolean)]
  84. [vertex=? (-> Graph Any Any Boolean)]
  85. [add-vertex! (-> Graph Any Void)]
  86. [remove-vertex! (-> Graph Any Void)]
  87. [rename-vertex! (-> Graph Any Any Void)]
  88. [add-edge! (->* (Graph Any Any) (Any) Void)]
  89. [add-directed-edge! (->* (Graph Any Any) (Any) Void)]
  90. [remove-edge! (-> Graph Any Any Void)]
  91. [remove-directed-edge! (-> Graph Any Any Void)]
  92. [get-vertices (-> Graph (Listof Any))]
  93. [in-vertices (-> Graph (Sequenceof Any))]
  94. [get-neighbors (-> Graph Any (Listof Any))]
  95. [in-neighbors (-> Graph Any (Sequenceof Any))]
  96. [get-edges (-> Graph (U (Listof (List Any Any)) (Listof (List Any Any Any))))]
  97. [in-edges (-> Graph (Sequenceof (U (List Any Any) (List Any Any Any))))]
  98. [edge-weight (->* (Graph Any Any) (#:default Any) Any)]
  99. [transpose (-> Graph Graph)]
  100. [graph-copy (-> Graph Graph)]
  101. [graph-union! (-> Graph Graph Void)]
  102. ;; 2 Graph constructors
  103. ;; 2.2 Weighted graphs
  104. [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)]
  105. ;; 10 Graphviz
  106. [graphviz (->* (Graph)
  107. (#:output Output-Port
  108. #:colors (HashTable Any Natural))
  109. String)])
  110. (module+ test
  111. ;; The goal of the tests is to check that all of the provided
  112. ;; functions can be invoked without errors. The tests do not check
  113. ;; whether the results make sense.
  114. (require typed/rackunit)
  115. (test-case "1 Generic Graph Interface"
  116. (define g (directed-graph '((a b) (b c))))
  117. (check-false (has-edge? g 'a 'c))
  118. (check-true (has-vertex? g 'a))
  119. (check-false (vertex=? g 'a 'c))
  120. (add-vertex! g 'd)
  121. (remove-vertex! g 'a)
  122. (rename-vertex! g 'd 'a)
  123. (add-edge! g 'a 'c)
  124. (add-edge! g 'a 'c "a->c")
  125. (add-directed-edge! g 'a 'c)
  126. (add-directed-edge! g 'a 'c "a->c")
  127. (remove-edge! g 'a 'c)
  128. (remove-directed-edge! g 'a 'c)
  129. (check-equal? (get-vertices g) '(c b a))
  130. (check-equal? (sequence->list (in-vertices g)) '(c b a))
  131. (check-equal? (get-neighbors g 'b) '(c))
  132. (check-equal? (sequence->list (in-neighbors g 'b)) '(c))
  133. (check-equal? (get-edges g) '((b c)))
  134. (check-equal? (sequence->list (in-edges g)) '((b c)))
  135. (check-equal? (edge-weight g 'a 'c) +inf.0)
  136. (check-equal? (edge-weight g 'a 'c #:default 'none) 'none)
  137. (check-equal? (graphviz (transpose g))
  138. "digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"b\"];\n\tnode2 [label=\"a\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1;\n\t}\n}\n")
  139. (check-equal? (graphviz (graph-copy g))
  140. "digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"b\"];\n\tnode2 [label=\"a\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0;\n\t}\n}\n")
  141. (graph-union! g (transpose g)))
  142. (test-case "10 Graphviz"
  143. (define g (directed-graph '((a b) (b c))))
  144. (check-equal? (graphviz g)
  145. "digraph G {\n\tnode0 [label=\"c\"];\n\tnode1 [label=\"b\"];\n\tnode2 [label=\"a\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0;\n\t\tnode2 -> node1;\n\t}\n}\n")))