# Graph colouring (2014/11/13)

Currently I am looking into register allocation using graph colouring (also see Chaitinâ€™s paper on the subject). The graph colouring problem also occurs when trying to colour countries in a political world map where adjacent countries must have different colours. I thought it would be interesting to try a minimal implementation in Scheme. Feel free to suggest improvements in the comment section below .

A (undirected) graph is usually represented by a list of nodes (vertices) and a list of edges. If there are no insular nodes, a list of edges is sufficient. In Scheme (here GNU Guile implementation) one can do this as follows.

```'((b . a) (a . c) (d . c))
```

The graph can be visualised on the command line using Graphviz and ImageMagick as follows.

```echo 'graph test { b -- a; a -- c; d -- c; }' | dot -Tpng | display -
```

The following helper function graphviz uses a system call to display a graph from within the REPL.

```(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))))
(graphviz '((b . a) (a . c) (d . c)) '())
```

One can get the nodes of the graph by extracting all elements and suppressing any duplicates. The definition of delete-duplicates is part of SRFI-1 (Scheme Request for Implementation 1).

```(use-modules (srfi srfi-1))
(define (nodes graph) (delete-duplicates (append (map car graph) (map cdr graph))))
(nodes '((b . a) (a . c) (d . c)))
; (b a d c)
```

The adjacency list of a node is simply the list of nodes of the sub-graph obtained by filtering for edges connecting to this node.

```(use-modules (ice-9 curried-definitions))
(define ((has-node? node) edge) (or (eq? (car edge) node) (eq? (cdr edge) node)))
(define (adjacent graph node) (nodes (filter (has-node? node) graph)))
(adjacent '((b . a) (a . c) (d . c)) 'c)
; (a d c)
```

Chaitinâ€™s graph coloring algorithm works by successively removing nodes with a low adjacency count from the graph. Removing a node from our graph can be done as follows.

```(define (remove-node graph node) (filter (compose not (has-node? node)) graph))
(remove-node '((b . a) (a . c) (d . c)) 'c)
; ((b . a))
```

Using the argument of the minimum one can determine the node with lowest adjacency count.

```(define (argmin fun lst)
(let* [(vals   (map fun lst))
(minval (apply min vals))]
(list-ref lst (- (length lst) (length (member minval vals))))))
```

Now one can recursively remove the node with lowest adjacency count and then assign colours starting with the last node and working backwards. If an adjacent node has a colour already, another colour must be used.

```(use-modules (srfi srfi-26))
(define (assign-colors graph nodes colors)
(if (null? nodes) '()
(let* [(target    (argmin (compose length (cut adjacent graph <>)) 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))
(coloring '((b . a) (a . c) (d . c)) '(red green blue))
; ((b . red) (a . green) (d . green) (c . red))
(let [(graph '((b . a) (a . c) (d . c)))] (graphviz graph (coloring graph '(red green blue))))
```

And here is an example of coloring a graph with a few more nodes.

```(let [(graph '((run . intr)
(intr . runbl)
(runbl . run)
(run . kernel)
(kernel . zombie)
(kernel . sleep)
(kernel . runmem)
(sleep . swap)
(swap . runswap)
(runswap . new)
(runswap . runmem)
(new . runmem)
(sleep . runmem)))]
(graphviz graph (coloring graph '(red green blue yellow))))
```