2020-12-27 22:56:59 +01:00

;;; Copyright 2021 Sergiu Ivanov <sivanov@colimite.fr>

;;;

;;; 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.

```
```

2020-12-27 22:46:49 +01:00

#lang typed/racket

```
```

2021-01-01 20:48:07 +01:00

;;; This file implements Alex Knauth's solution presented here:

;;;

;;; https://stackoverflow.com/questions/65386334/racket-generic-graph-library-in-typed-racket

2020-12-27 22:46:49 +01:00

```
```

( module graph-wrapper racket

` `( require ( prefix-in g: graph ) )

2021-01-02 22:22:27 +01:00

` `( 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!

2021-01-01 21:46:58 +01:00

```
```

2020-12-27 22:46:49 +01:00

` `directed-graph

2021-01-01 21:46:58 +01:00

```
```

2020-12-27 22:46:49 +01:00

` `graphviz )

```
```

2021-01-01 21:46:58 +01:00

` `;; Wrap the opaque graph structure coming from the generic

` `;; graph library.

2020-12-27 22:46:49 +01:00

` `( struct graph ( g ) )

2021-01-01 21:52:26 +01:00

` `( define gg graph-g )

2020-12-27 22:46:49 +01:00

```
```

2021-01-02 22:22:27 +01:00

` `;; 1 Generic Graph Interface

2021-01-01 21:31:14 +01:00

` `( define ( has-vertex? g v )

2021-01-01 21:52:26 +01:00

` `( g:has-vertex? ( gg g ) v ) )

2020-12-27 22:46:49 +01:00

` `( define ( has-edge? g u v )

2021-01-01 21:52:26 +01:00

` `( g:has-edge? ( gg g ) u v ) )

2021-01-02 22:22:27 +01:00

` `( 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 ) ) )

2021-01-01 21:46:58 +01:00

```
```

` `;; 2 Graph constructors

` `;; 2.2 Weighted graphs

` `( define ( directed-graph es [ ws #f ] )

` `( graph ( g:directed-graph es ws ) ) )

```
```

` `;; 10 Graphviz

2020-12-27 22:46:49 +01:00

` `( define ( graphviz g #:output [ output #f ] #:colors [ colors #f ] )

2021-01-01 21:52:26 +01:00

` `( g:graphviz ( gg g ) #:output output #:colors colors ) ) )

2020-12-27 22:46:49 +01:00

```
```

2021-01-01 21:46:58 +01:00

```
```

( require/typed/provide ' graph-wrapper

2020-12-27 22:46:49 +01:00

` `[ #:opaque Graph graph? ]

2021-01-02 22:22:27 +01:00

```
```

` `;; 1 Generic Graph Interface

2021-01-01 21:31:14 +01:00

` `[ has-vertex? ( -> Graph Any Boolean ) ]

2020-12-27 22:46:49 +01:00

` `[ has-edge? ( -> Graph Any Any Boolean ) ]

2021-01-02 22:22:27 +01:00

` `[ 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 ) ]

2021-01-01 21:46:58 +01:00

```
```

` `;; 2 Graph constructors

` `;; 2.2 Weighted graphs

` `[ directed-graph ( ->* ( ( Listof ( List Any Any ) ) ) ( ( Listof Any ) ) Graph ) ]

```
```

` `;; 10 Graphviz

2020-12-27 22:46:49 +01:00

` `[ graphviz ( ->* ( Graph )

` `( #:output Output-Port

` `#:colors ( HashTable Any Natural ) )

` `String ) ] )

```
```

2021-01-01 21:46:58 +01:00

```
```

( 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 ) ) ) )

2021-01-01 21:56:50 +01:00

` `( check-false ( has-edge? g ' a ' c ) )

2021-01-02 22:22:27 +01:00

` `( 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 ) ) )

2021-01-01 21:46:58 +01:00

```
```

` `( test-case " 10 Graphviz "

` `( define g ( directed-graph ' ( ( a b ) ( b c ) ) ) )

2021-01-01 21:56:50 +01:00

` `( check-equal? ( graphviz 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 \t node2 -> node1; \n \t } \n } \n " ) ) )