gistfile1.hs

import Data.List
import Data.Map

-- Aluminum = alum
-- Copper   = copper
-- Iron     = iron
-- Blue     = blue
-- Grey     = grey
-- Textured = textured
-- Coated   = coated

propConstants = [fromList [("alum", alum), ("copper", copper), ("iron", iron), ("blue", blue), ("grey", grey), ("textured", textured), ("coated", coated)] | alum <- [True, False], copper <- [True, False], iron <- [True, False], blue <- [True, False], grey <- [True, False], textured <- [True, False], coated <- [True, False]]

-- material implication
(==>) :: Bool -> Bool -> Bool
(==>) a b
  | a && b = True
  | a && not b = False
  | not a && b = True
  | not a && not b = True
infix 1 ==> -- as && is 3, and || is 2

satisfaction :: [Bool] -> Bool
satisfaction props = length (nub props) <= 1

testSatisfaction :: Map String Bool -> Bool
testSatisfaction propConstantSet =
   let alum = propConstantSet ! "alum"
       copper = propConstantSet ! "copper"
       iron = propConstantSet ! "iron"
       blue = propConstantSet ! "blue"
       grey = propConstantSet ! "grey"
       textured = propConstantSet ! "textured"
       coated = propConstantSet ! "coated"
   in
     satisfaction [(alum || copper) && (copper || iron) && (alum || iron),
                   (blue ==> (not grey)) && (grey ==> (not blue)),
                   coated || textured,
                   alum ==> grey,
                   copper && (not coated) ==> blue,
                   iron ==> coated]

showSatisfaction :: Map String Bool -> Either (Map String Bool) Bool
showSatisfaction propConstantSet
    | testSatisfaction propConstantSet = Left propConstantSet
    | otherwise = Right False

-- > Data.List.filter (\x -> x /= Right False) (Data.List.map showSatisfaction propConstants)
-- [Left (fromList [("alum",True),("blue",False),("coated",True),("copper",True),("grey",True),("iron",True),("textured",True)]),
--  Left (fromList [("alum",True),("blue",False),("coated",True),("copper",True),("grey",True),("iron",True),("textured",False)]),
--  Left (fromList [("alum",True),("blue",False),("coated",True),("copper",True),("grey",True),("iron",False),("textured",True)]),
--  Left (fromList [("alum",True),("blue",False),("coated",True),("copper",True),("grey",True),("iron",False),("textured",False)]),
--  Left (fromList [("alum",True),("blue",False),("coated",True),("copper",False),("grey",True),("iron",True),("textured",True)]),
--  Left (fromList [("alum",True),("blue",False),("coated",True),("copper",False),("grey",True),("iron",True),("textured",False)]),
--  Left (fromList [("alum",False),("blue",True),("coated",True),("copper",True),("grey",False),("iron",True),("textured",True)]),
--  Left (fromList [("alum",False),("blue",True),("coated",True),("copper",True),("grey",False),("iron",True),("textured",False)]),
--  Left (fromList [("alum",False),("blue",False),("coated",True),("copper",True),("grey",True),("iron",True),("textured",True)]),
--  Left (fromList [("alum",False),("blue",False),("coated",True),("copper",True),("grey",True),("iron",True),("textured",False)]),
--  Left (fromList [("alum",False),("blue",False),("coated",True),("copper",True),("grey",False),("iron",True),("textured",True)]),
--  Left (fromList [("alum",False),("blue",False),("coated",True),("copper",True),("grey",False),("iron",True),("textured",False)])]