What a delight! Thank you for this elegant snippet :) Andy
On Fri 14 Nov 2014 19:16, Jan Wedekind <j...@wedesoft.de> writes: > 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