Add coloring.

This commit is contained in:
Sergiu Ivanov 2021-11-01 09:40:22 +01:00
parent 709c1360b9
commit 9e778f3fb0
1 changed files with 18 additions and 0 deletions

View File

@ -42,6 +42,8 @@
bellman-ford dijkstra dag-shortest-paths
floyd-warshall transitive-closure johnson
coloring
graphviz)
;; Wrap the opaque graph structure coming from the generic
@ -213,6 +215,10 @@
(define (johnson g)
(g:johnson (gg g)))
;; 8 Coloring
(define (coloring g num-colors #:order [order (λ (x) x)])
(g:coloring (gg g) num-colors #:order order))
;; 10 Graphviz
(define (graphviz g #:output [output #f] #:colors [colors #f])
(g:graphviz (gg g) #:output output #:colors colors)))
@ -317,6 +323,11 @@
[transitive-closure (-> Graph (Mutable-HashTable (List Any Any) Boolean))]
[johnson (-> Graph (Mutable-HashTable (List Any Any) Number))]
;; 8 Coloring
[coloring (->* (Graph Natural)
(#:order (-> (Listof Any) (Listof Any)))
(U (Mutable-HashTable Any Number) False))]
;; 10 Graphviz
[graphviz (->* (Graph)
(#:output Output-Port
@ -518,6 +529,13 @@
((d b) . +inf.0)
((a b) . 1))))
(test-case "8 Coloring"
(define g0 (undirected-graph '((a b) (b c) (c d) (d a))))
(check-equal? (hash->ordered-list (cast (coloring g0 5)
(Mutable-HashTable Any Number)))
'((a . 0) (b . 1) (c . 0) (d . 1)))
(check-false (coloring g0 1)))
(test-case "10 Graphviz"
(define g (directed-graph '((a b) (b c))))
(check-equal? (graphviz g)