Add coloring.
This commit is contained in:
parent
709c1360b9
commit
9e778f3fb0
18
graph.rkt
18
graph.rkt
|
@ -42,6 +42,8 @@
|
||||||
bellman-ford dijkstra dag-shortest-paths
|
bellman-ford dijkstra dag-shortest-paths
|
||||||
floyd-warshall transitive-closure johnson
|
floyd-warshall transitive-closure johnson
|
||||||
|
|
||||||
|
coloring
|
||||||
|
|
||||||
graphviz)
|
graphviz)
|
||||||
|
|
||||||
;; Wrap the opaque graph structure coming from the generic
|
;; Wrap the opaque graph structure coming from the generic
|
||||||
|
@ -213,6 +215,10 @@
|
||||||
(define (johnson g)
|
(define (johnson g)
|
||||||
(g:johnson (gg 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
|
;; 10 Graphviz
|
||||||
(define (graphviz g #:output [output #f] #:colors [colors #f])
|
(define (graphviz g #:output [output #f] #:colors [colors #f])
|
||||||
(g:graphviz (gg g) #:output output #:colors colors)))
|
(g:graphviz (gg g) #:output output #:colors colors)))
|
||||||
|
@ -317,6 +323,11 @@
|
||||||
[transitive-closure (-> Graph (Mutable-HashTable (List Any Any) Boolean))]
|
[transitive-closure (-> Graph (Mutable-HashTable (List Any Any) Boolean))]
|
||||||
[johnson (-> Graph (Mutable-HashTable (List Any Any) Number))]
|
[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
|
;; 10 Graphviz
|
||||||
[graphviz (->* (Graph)
|
[graphviz (->* (Graph)
|
||||||
(#:output Output-Port
|
(#:output Output-Port
|
||||||
|
@ -518,6 +529,13 @@
|
||||||
((d b) . +inf.0)
|
((d b) . +inf.0)
|
||||||
((a b) . 1))))
|
((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"
|
(test-case "10 Graphviz"
|
||||||
(define g (directed-graph '((a b) (b c))))
|
(define g (directed-graph '((a b) (b c))))
|
||||||
(check-equal? (graphviz g)
|
(check-equal? (graphviz g)
|
||||||
|
|
Loading…
Reference in New Issue