Browse Source

Add coloring/greedy.

master
Sergiu Ivanov 10 months ago
parent
commit
6d32fcecfc
  1. 17
      graph.rkt

17
graph.rkt

@ -42,7 +42,7 @@
bellman-ford dijkstra dag-shortest-paths
floyd-warshall transitive-closure johnson
coloring
coloring coloring/greedy
graphviz)
@ -218,6 +218,8 @@
;; 8 Coloring
(define (coloring g num-colors #:order [order (λ (x) x)])
(g:coloring (gg g) num-colors #:order order))
(define (coloring/greedy g #:order [order 'smallest-last])
(g:coloring/greedy (gg g) #:order order))
;; 10 Graphviz
(define (graphviz g #:output [output #f] #:colors [colors #f])
@ -327,6 +329,12 @@
[coloring (->* (Graph Natural)
(#:order (-> (Listof Any) (Listof Any)))
(U (Mutable-HashTable Any Number) False))]
[coloring/greedy (->* (Graph)
(#:order (U (-> (Listof Any) (Listof Any))
'smallest-last))
(Values Number
(Mutable-HashTable Any Number)))]
;; 10 Graphviz
[graphviz (->* (Graph)
@ -534,7 +542,12 @@
(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)))
(check-false (coloring g0 1))
(define-values (ncolors colors) (coloring/greedy g0))
(check-equal? ncolors 2)
(check-equal? (hash->ordered-list colors)
'((a . 0) (b . 1) (c . 0) (d . 1))))
(test-case "10 Graphviz"
(define g (directed-graph '((a b) (b c))))

Loading…
Cancel
Save