Boy Plankton

Haskell is an interesting language.  Forces you to break the problem up into small pieces.  Haskell is the seventh language featured in Seven Languages in Seven Weeks and the fifth problem for day 1 of Haskell has kept me stumped for a couple of days now.  You are expected to write a Haskell version of the map-coloring problem from the Prolog chapter.

You are given a map of the southeast corner of the United States.  You have to write a program to color the five states so that no two states that border each other are colored the same.

First you have to setup the problem.

states = [ "Tennessee", "Mississippi", "Alabama", "Georgia", "Florida" ]
 
borders = [ [ "Mississippi", "Tennessee" ], [ "Mississippi", "Alabama" ], [ "Alabama", "Tennessee" ], [ "Alabama", "Mississippi" ], [ "Alabama", "Georgia" ], [ "Alabama", "Florida" ], [ "Georgia", "Florida" ], [ "Georgia", "Tennessee" ] ]
 
colors = [ "red", "green", "blue" ]

This is a quick function to get a list of the states that border one of the states.

getBorders y = [ last x | x <- borders, head x == y ]

I needed a list of the colors of bordering states that had already been assigned colors.

getBorderColors y z = [ last x | x <- y, any ( == head x ) ( getBorders z ) ]

This function takes a list of colors and figures out which colors are still available for a state.

colorsLeft :: [[Char]] -> [[Char]]
colorsLeft [] = colors
colorsLeft (x:xs) = [ y | y <- colorsLeft xs, x /= y ]

Finally, we iterate through the list of states and assign them colors.

mapColors xs = helper [] xs
   where helper sol (x:xs) = helper ([ x, head ( colorsLeft ( getBorderColors sol x ))] : sol ) xs
         helper sol _ = sol

Load and execute …

*Main> mapColors states
[["Florida","red"],["Georgia","green"],["Alabama","blue"],["Mississippi","green"],["Tennessee","red"]]

I’m certain that this solution is less than optimal. Still, it’s the first one I came up with that produced the correct answer.