-- Here's an enumerated type for representing colors.  In the rest of the
-- code you write, these constructors should NOT be used explicitly.  One
-- should be able to add or remove Color values in the type definition
-- without having to modify any other code.

data Color = Red | Green | Blue | Yellow | Purple | Brown
             deriving (Eq, Enum, Show, Bounded)

-- We also need a structure for associating a color with an item.  Note 
-- that this type is parameterized, and can associate colors with items
-- of ANY type.

data Binding a = CB a Color
                 deriving (Eq, Show)


-- An Edge represents the connection between two items of a given type.
-- For our purposes we'll consider these to be undirected edges.

data Edge a = E a a
	      deriving (Eq, Show)

-- A Graph is a list of Edges

type Graph a = [Edge a]


-- Returns the color of an item as specified in a list of color bindings.
-- Uses the built-in Maybe so we can gracefully handle the case where a 
-- binding for the item isn't found.

color_of :: Eq a => a -> [Binding a] -> Maybe Color

color_of _ [] = Nothing
color_of node ((CB n color):ps) 
 | node == n	= Just color
 | otherwise	= color_of node ps

-- Alternate def:
-- color_of node bs
--  | null result = Nothing
--  | otherwise   = head result
--	where result = [ Just m | (CB n m) <- bs, n==node ]

 

-- Returns true if there's a conflict at this edge given the list of
-- color bindings.  (That is, the nodes at either end of the edge
-- have the same color.)

nodes_clash :: Eq a => [Binding a] -> Edge a -> Bool

nodes_clash bindings (E n1 n2) = 
  same (color_of n1 bindings) (color_of n2 bindings)
  where
	same (Just a) (Just b) =  a == b
	same _ _ = False
	
	
-- This function checks ALL edges in a graph to see if there are
-- conflicts.  It uses "filter" to keep only the edges that have
-- conflicts, then tests the resulting list to see if it's empty.

no_clashes :: Eq a => [Binding a] -> Graph a -> Bool

no_clashes bindings graph =
    null (filter (nodes_clash bindings) graph)

-- can also write it as:
--
-- no_clashes bs g = and (map (not . nodes_clash bs) g)

 
-- Builds a list containing the nodes in a graph without duplicates.  
-- The basic approach is to build a list for the "rest" of the graph
-- via a recursive call, then filter out occurrences of the nodes in
-- the first edge.  It's a little more complex, since we need to 
-- handle the case where an edge connects two identical nodes (just
-- to be safe).  

unique_nodes :: Eq a => Graph a -> [a]

unique_nodes [] = []
unique_nodes (E n1 n2 : edges) = 
	n1 : filter (/=n1) 
	         (n2 : (filter (/=n2) (unique_nodes edges)))



-- This is the heart of the graph-coloring code.  We make a recursive
-- call to color all but the first node, then consider colors for the 
-- first node that avoid conflicts.  We generate a list of all colors
-- and use "filter" to keep those that would work.  We then take the 
-- first color in the resulting list and produce a new binding.

assign_colors :: Eq a => [a] -> Graph a -> [Binding a]

assign_colors [] _ = []
assign_colors (n:ns) graph = (CB n (head safe_colors)) : bindings
  where
	bindings = assign_colors ns graph
	safe_colors = filter (\c-> no_clashes ((CB n c):bindings) graph) 
	  	 	     [minBound::Color ..]
	  	 	     


-- This is the top-level call.  We compute the list of unique nodes
-- in the graph, then call "assign_colors" to find colors for each
-- of the nodes such that conflicts are avoided.

color_graph :: Eq a => Graph a -> [Binding a]

color_graph g = assign_colors (unique_nodes g) g


-- Some test data

g = [E "NW" "NE", E "NE" "SE", E "SE" "SW", E "SW" "NW"]
g2 = [E "NW" "NE", E "NE" "E", E "E" "SE", E "SE" "SW", E "SW" "NW"]
g3 = [E 1 2, E 2 3, E 3 4, E 4 5, E 5 1]
g4 = [E 1 2, E 2 3, E 3 4, E 4 5, E 5 6, E 6 7, E 7 8, E 8 9, E 9 1, E 5 9]

us = [E "wa" "or", E "or" "ca", E "wa" "id", E "or" "id", E "ca" "nv", 
	E "id" "nv", E "or" "nv", E "id" "mt", E "id" "wy", E "id" "ut", 
	E "nv" "ut", E "nv" "az", E "ca" "az", E "ut" "az", E "mt" "wy", 
	E "wy" "ut", E "wy" "co", E "co" "ut", E "co" "nm", E "nm" "az", 
	E "mt" "nd", E "mt" "sd", E "nd" "mn", E "nd" "sd", E "sd" "wy", 
	E "sd" "ne", E "ne" "co", E "sd" "mn", E "sd" "ia", E "ne" "ia", 
	E "ne" "ks", E "ne" "mo", E "nm" "tx", E "nm" "ok", E "tx" "ok", 
	E "co" "ok", E "co" "ks", E "ks" "ok", E "ks" "mo", E "ok" "ar", 
	E "ar" "la", E "ar" "tx", E "mo" "ar", E "ia" "mo", E "mn" "ia"]