-- Sergio Antoy
-- Mon 28 Sep 2020 02:09:19 PM PDT

{- The Problem

Color a political map so that two states that share a border
have a different color.  For a simple map of the Pacific Northwest,
use only 3 colors.

-}

-- enable default rules
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}

import Test.Prop

-- The states of the Pacific Northwest
data State = OR | WA | ID | BC deriving (Show, Eq)
states :: [State]
states = [OR, WA, ID, BC]

-- Adjacency, CAREFUL about order, since the graph is undirected
-- Always list pairs of states in the order of the type definition
type Adiacency = [(State, State)]
adiacency :: Adiacency
adiacency = [(OR,WA),(OR,ID),(WA,ID),(WA,BC),(ID,BC)]

-- The colors being used in the map
data Color = Red | Green | Blue deriving (Show, Eq)

-- Produce all colored maps.
-- Pair each state with a non-det chosen color
-- e.g., coloredmap returns [(OR,Red),(WA,Green),(ID,Green),(BC,Blue)]
-- e.g., coloredmap produces 3*3*3*3
type ColoredMap = [(State,Color)]
coloredmap :: ColoredMap
coloredmap = map (\x -> (x,pick)) states
prop_coloredmap_example = coloredmap ~> [(OR,Red),(WA,Green),(ID,Green),(BC,Blue)]
prop_coloredmap_count = coloredmap # 3*3*3*3

-- Pick a color, non-det
pick :: Color
pick = Red ? Green ? Blue
prop_pick_example = pick ~> Green
prop_pick_count = pick # 3

-- If two colored states (elements of coloredmap)
-- are adjacent (an element of the adjacency list)
-- and have the same color, then discard.
-- Otherwise, no adjacent states have the same color
-- and the colored map is a solution
-- E.g., a map with (OR,Red) and (ID,Red) fails
-- because (OR,ID) is in the adjacency list.
check :: ColoredMap -> Adiacency -> ColoredMap
check (_++[(s1,c)]++_++[(s2,c)]++_) (_++[(s1,s2)]++_) = failed
check'default c _ = c
prop_check_fail = failing (check [(OR,Red),(WA,Green),(ID,Red),(BC,Blue)] adiacency)
prop_check_succeed = check x adiacency -=- x where x = [(OR,Green),(WA,Red),(ID,Blue),(BC,Green)]

-- Color the map, solve the problem
main :: ColoredMap
main = check coloredmap adiacency

-- Test main computes all and only the solutions
prop_main = main <~> (
    [(OR,Red),(WA,Green),(ID,Blue),(BC,Red)] ?
    [(OR,Red),(WA,Blue),(ID,Green),(BC,Red)] ?
    [(OR,Green),(WA,Red),(ID,Blue),(BC,Green)] ?
    [(OR,Green),(WA,Blue),(ID,Red),(BC,Green)] ?
    [(OR,Blue),(WA,Red),(ID,Green),(BC,Blue)] ?
    [(OR,Blue),(WA,Green),(ID,Red),(BC,Blue)]
  )