CS 291 Assignment #4

Due Wednesday, February 24th (by 11:59pm)
Not accepted after February 28th

Introduction:

The goal of this assignment is to write a program in Haskell that will solve graph coloring problems. In graph coloring, the objective is to assign each node in a given graph a color such that no two neighboring nodes (connected by an edge in the graph) have the same color. This is not just a contrived toy problem — lots of interesting real-world resource allocation problems can be expressed and solved in this way. Style matters: Try to be as short and concise as possible in your solutions, use pattern-matching when you can, and make an effort to use higher-order functions as much as possible.

The Assignment

The assignment breaks the problem down into a series of steps to help you manage the complexity:
  1. I'll get you started by providing some types. Copy these over to your source file:
    -- 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)
    
  2. Define the type Edge, with a single constructor E, that represents the connection between two items of a given type. (For our purposes, we'll consider edges to be undirected.) Your definition should not restrict the types of the items that can be "connected" by edges. (That is, one should be able to pass two Ints to the constructor, or two Strings, etc.)

  3. Define a type Graph that consists of a list of Edges.

  4. Define the function colorOf, that takes an item and a list of color bindings and looks up the item's color in the list of bindings. (If more than one binding exists for the item, you can use whichever you wish.) Your definition should make use of Haskell's built-in Maybe type to deal gracefully with failure when a color binding for an item isn't found.
    Main> :type colorOf
    colorOf :: Eq a => a -> [Binding a] -> Maybe Color
    Main> colorOf 7 [CB 7 Red]
    Just Red
    Main> colorOf "Brad" [CB "foo" Purple, CB "Brad" Green]
    Just Green
    Main> colorOf "bar" [CB "foo" Purple, CB "Brad" Green]
    Nothing
    

  5. Define the function nodesClash, that takes a list of color bindings and a single Edge and returns a Bool reporting whether or not the nodes connected by the edge have the same color. Don't forget that colorOf returns an item of type Maybe, so you'll need to do some pattern-matching to retrieve the actual color if it exists.
    Main> :type nodesClash
    nodesClash :: Eq a => [Binding a] -> Edge a -> Bool
    Main> nodesClash [] (E "ny" "nj")
    False
    Main> nodesClash [CB "ny" Red, CB "nj" Green] (E "ny" "nj")
    False
    Main> nodesClash [CB "ny" Red, CB "nj" Red] (E "ny" "nj")
    True
    Main> nodesClash [CB "ny" Red] (E "ny" "nj")
    False
    

  6. Define the function uniqueNodes, that takes a Graph as input and returns a list containing the nodes from the graph without duplicates. (The recursive case can be done in one line if you make friends with filter and think recursively.)
    Main> :type uniqueNodes
    uniqueNodes :: Eq a => Graph a -> [a]
    Main> uniqueNodes [E 1 2]
    [1,2]
    Main> uniqueNodes [E 1 1, E 2 2]
    [1,2]
    Main> uniqueNodes [E 1 2, E 1 2]
    [1,2]
    Main> uniqueNodes [E 1 2, E 2 3, E 1 3] 
    [1,2,3]
    Main> uniqueNodes [E "NW" "NE", E "NE" "SE", E "SE" "SW", E "SW" "NW"]
    ["NW","NE","SE","SW"]
    

  7. Define the function noClashes, that takes a list of color bindings and a graph and returns True if there are no clashes. (That is, if none of the edges in the graph connect nodes of the same color.) This can also be done in one line if you continue your friendship with filter and do some partial-application of functions.
    Main> :type noClashes
    noClashes :: Eq a => [Binding a] -> Graph a -> Bool
    Main> noClashes [] [E 1 2]
    True
    Main> noClashes [CB 1 Red, CB 2 Red] [E 1 2]
    False
    Main> noClashes [CB 1 Red, CB 2 Green, CB 3 Blue] [E 1 2, E 2 3, E 1 3]
    True
    Main> noClashes [CB 1 Red, CB 2 Green, CB 3 Red] [E 1 2, E 2 3, E 1 3]
    False
    Main> noClashes [CB 1 Red, CB 2 Green, CB 3 Red, CB 4 Green] [E 1 2, E 2 3, E 3 4, E 4 1]
    True
    

  8. Now for the biggie: Define the function assignColors that takes a list of nodes and a Graph, and returns a list of Bindings such that each node in the graph has been assigned a color, and no two neighboring nodes (connected by an edge in the graph) have been assigned the same color. Don't panic. Think recursively: "Gee. I don't have to solve the whole problem — I'll make a recursive call to color all of the nodes but one, then focus on finding a color for the remaining node that doesn't produce any conflicts." Don't forget about your friend filter — it can help you figure out which colors will work. To reduce the number of colors used, you should use the "smallest" color (closest to minBound) that will work when coloring a node. Your solution need not produce exactly the same bindings that mine does, but it should use the same number of colors:
    Main> :type assignColors
    assignColors :: Eq a => [a] -> Graph a -> [Binding a]
    Main> assignColors ["ny", "nj"] [E "ny" "nj"]
    [CB "ny" Green,CB "nj" Red]
    Main> assignColors [1,2,3] [E 1 2, E 2 3, E 1 3]
    [CB 1 Blue,CB 2 Green,CB 3 Red]
    Main> assignColors [1,2,3,4] [E 1 2, E 2 3, E 3 4, E 4 1]
    [CB 1 Green,CB 2 Red,CB 3 Green,CB 4 Red]
    Main> assignColors [1,2,3,4] [E 1 2, E 2 3, E 3 4, E 4 1, E 1 3]
    [CB 1 Blue,CB 2 Red,CB 3 Green,CB 4 Red]
    

  9. This is anti-climactic, but the final step is to define a function colorGraph that takes a graph as its input and returns a list of color bindings:
    Main> :type colorGraph
    colorGraph :: Eq a => Graph a -> [Binding a]
    Main> colorGraph [E "ny" "nj"]
    [CB "ny" Green,CB "nj" Red]
    Main> colorGraph [E 1 2, E 2 3, E 3 4, E 4 1]
    [CB 1 Green,CB 2 Red,CB 3 Green,CB 4 Red]
    Main> colorGraph [E 1 2, E 2 3, E 3 4, E 4 1, E 1 3]
    [CB 1 Blue,CB 2 Red,CB 3 Green,CB 4 Red]
    
For large-scale testing purposes you can try coloring this graph, which represents adjacencies between US states west of the Mississippi. (Feel free to extend it to the full US — I got tired after the western states...)

Submitting:

Submit the file containing your function definitions by attaching it to an E-mail to me at brichards@pugetsound.edu. Please do not just copy and paste your solutions into the body of the E-mail! (If your E-mail client insists on including the content of text files into the body of the message, please zip the files up and attach the archive.)


Brad Richards, 2010