From 6d32fcecfc81356eddf71df070bcd20fb9671a30 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 1 Nov 2021 10:00:24 +0100 Subject: [PATCH] Add coloring/greedy. --- graph.rkt | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/graph.rkt b/graph.rkt index c7a84a1..47994ea 100644 --- a/graph.rkt +++ b/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))))