@ -20,7 +20,11 @@
( module graph-wrapper racket
( require ( prefix-in g: graph ) )
( provide graph? has-vertex? has-edge?
( 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
@ -31,10 +35,47 @@
( 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
@ -48,8 +89,28 @@
( 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
@ -71,7 +132,30 @@
( 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-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 \t node0 [label= \" c \" ]; \n \t node1 [label= \" b \" ]; \n \t node2 [label= \" a \" ]; \n \t subgraph U { \n \t \t edge [dir=none]; \n \t } \n \t subgraph D { \n \t \t node0 -> node1; \n \t } \n } \n " )
( check-equal? ( graphviz ( graph-copy g ) )
" digraph G { \n \t node0 [label= \" c \" ]; \n \t node1 [label= \" b \" ]; \n \t node2 [label= \" a \" ]; \n \t subgraph U { \n \t \t edge [dir=none]; \n \t } \n \t subgraph D { \n \t \t node1 -> node0; \n \t } \n } \n " )
( graph-union! g ( transpose g ) ) )
( test-case " 10 Graphviz "
( define g ( directed-graph ' ( ( a b ) ( b c ) ) ) )