;;; Copyright 2021 Sergiu Ivanov ;;; ;;; 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)) (provide 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! directed-graph 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.2 Weighted graphs (define (directed-graph es [ws #f]) (graph (g:directed-graph es ws))) ;; 10 Graphviz (define (graphviz g #:output [output #f] #:colors [colors #f]) (g:graphviz (gg g) #:output output #:colors colors))) (require/typed/provide 'graph-wrapper [#:opaque Graph 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.2 Weighted graphs [directed-graph (->* ((Listof (List Any Any))) ((Listof Any)) Graph)] ;; 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) (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 "10 Graphviz" (define g (directed-graph '((a b) (b c)))) (check-equal? (graphviz g) "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")))