Add coloring.
This commit is contained in:
parent
709c1360b9
commit
9e778f3fb0
1 changed files with 18 additions and 0 deletions
18
graph.rkt
18
graph.rkt
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue