# 99 questions/Solutions/86

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

(**) Node degree and graph coloration

Use Welch-Powell's algorithm to paint the nodes of a graph in such a way that adjacent nodes have different colors.

```data Graph a = Graph [a] [(a, a)]
deriving (Show, Eq)

deriving (Show, Eq)

petersen = Graph ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j']
[('a', 'b'), ('a', 'e'), ('a', 'f'), ('b', 'c'), ('b', 'g'),
('c', 'd'), ('c', 'h'), ('d', 'e'), ('d', 'i'), ('e', 'j'),
('f', 'h'), ('f', 'i'), ('g', 'i'), ('g', 'j'), ('h', 'j')]

-- produces graph coloration using Welch-Powell algorithm
kcolor :: (Eq a, Ord a) => Graph a -> [(a, Int)]
kcolor g = kcolor' x [] 1
where
kcolor' [] ys _ = ys
kcolor' xs ys n = let ys' = color xs ys n
in kcolor' [x | x <- xs, notElem (fst x, n) ys']
ys'
(n + 1)
color []          ys n = ys
color ((v, e):xs) ys n = if any (\x -> (x, n) `elem` ys) e
then color xs ys n
else color xs ((v, n) : ys) n

-- determines chromatic number, given graph coloration
chromatic :: [(a, Int)] -> Int
chromatic x = length \$ foldr (\(a, n) xs -> if n `elem` xs then xs else n : xs) [] x

-- converts from graph to adjacency matrix representations
graphToAdj (Graph (x:xs) ys) = Adj ((x, ys >>= f) : zs)
where
f (a, b)
| a == x = [b]
| b == x = [a]
| otherwise = []