From: Jan Wedekind <jan@wedesoft.de>
To: General Guile related discussions <guile-user@gnu.org>
Subject: Re: Graph coloring with Scheme
Date: Tue, 18 Nov 2014 12:27:25 +0000 (GMT) [thread overview]
Message-ID: <alpine.DEB.2.02.1411181223090.9015@wedemob.home> (raw)
In-Reply-To: <alpine.DEB.2.02.1411141737190.9404@wedemob.home>
Forgot to use the ordering actually. It needs to be:
(define (coloring graph nodes) (assign-colors graph (nodes graph) (order graph (nodes graph))))
Or one can do the ordering directly within the "assign-colors" function:
(define (assign-colors graph nodes colors)
(if (null? nodes) '()
(let* [(target (argmin (lambda (node) (length (adjacent graph node))) 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))
On Fri, 14 Nov 2014, Jan Wedekind wrote:
> 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
>
>
next prev parent reply other threads:[~2014-11-18 12:27 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-11-14 18:16 Graph coloring with Scheme Jan Wedekind
2014-11-18 12:27 ` Jan Wedekind [this message]
2016-06-20 13:09 ` Andy Wingo
2016-06-20 20:30 ` Jan Wedekind
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=alpine.DEB.2.02.1411181223090.9015@wedemob.home \
--to=jan@wedesoft.de \
--cc=guile-user@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).