guile-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Graph coloring with Scheme


From: Jan Wedekind
Subject: Graph coloring with Scheme
Date: Fri, 14 Nov 2014 18:16:02 +0000 (GMT)
User-agent: Alpine 2.02 (DEB 1266 2009-07-14)

Hi,
Here is an implementation [1] of Chaitin's graph coloring algorithm using GNU Guile and Graphviz. Any feedback and suggestions are welcome. Let me know if you can make the implementation more concise ;)

Regards Jan

(use-modules (srfi srfi-1)
             (srfi srfi-26))
(define (dot graph colors)
  (apply string-append
         (append (list "graph g {")
                 (map (lambda (color) (format #f " ~a [style=filled, 
fillcolor=~a];" (car color) (cdr color))) colors)
                 (map (lambda (edge) (format #f " ~a -- ~a;" (car edge) (cdr 
edge))) graph)
                 (list " }"))))
(define (graphviz graph colors) (system (format #f "echo '~a' | dot -Tpng | display 
-" (dot graph colors))))
(define (nodes graph) (delete-duplicates (append (map car graph) (map cdr 
graph))))
(define (has-node? edge node) (or (eq? (car edge) node) (eq? (cdr edge) node)))
(define (adjacent graph node) (nodes (filter (cut has-node? <> node) graph)))
(define (remove-node graph node) (filter (lambda (edge) (not (has-node? edge 
node))) graph))
(define (argmin fun lst)
  (let* [(vals   (map fun lst))
         (minval (apply min vals))]
    (list-ref lst (- (length lst) (length (member minval vals))))))
(define (order graph nodes)
  (if (null? nodes) '()
    (let [(target (argmin (lambda (node) (length (adjacent graph node))) 
nodes))]
      (cons target (order (remove-node graph target) (delete target nodes))))))
(define (assign-colors graph nodes colors)
  (if (null? nodes) '()
    (let* [(target    (car nodes))
           (coloring  (assign-colors (remove-node graph target) (delete target 
nodes) colors))
           (blocked   (map (cut assq-ref coloring <>) (adjacent graph target)))
           (available (lset-difference eq? colors blocked))]
      (cons (cons target (car available)) coloring))))
(define (coloring graph colors) (assign-colors graph (nodes graph) colors))
(let [(graph '((b . a) (a . c) (d . c)))] (graphviz graph (coloring graph '(red 
green blue))))

[1] http://wedesoft.de/graph-coloring.html



reply via email to

[Prev in Thread] Current Thread [Next in Thread]