{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses #-} | |
module Puzzle where | |
import Data.List | |
-------------------------------------------------------------------------------- | |
-- Specific to this puzzle | |
main :: IO () | |
main = print $ solve Row rules | |
data Girl = Ellie | Emily | Jessica | |
deriving (Show, Eq, Enum, Bounded) | |
data Animal = Elephant | Zebra | Giraffe | |
deriving (Show, Eq, Enum, Bounded) | |
data Lolly = Grunge | Plooper | Zinger | |
deriving (Show, Eq, Enum, Bounded) | |
data Adult = Aunt | Grandma | Mum | |
deriving (Show, Eq, Enum, Bounded) | |
data Row = Row { girl :: Girl, animal :: Animal, | |
lolly :: Lolly, adult :: Adult } | |
deriving Show | |
instance Atom Row Girl where get = girl | |
instance Atom Row Animal where get = animal | |
instance Atom Row Lolly where get = lolly | |
instance Atom Row Adult where get = adult | |
rules = [ Ellie `With` Grandma | |
, Ellie `NotWith` Zinger | |
, Mum `With` Elephant | |
, Giraffe `NotWith` Plooper | |
, Aunt `With` Grunge | |
, Aunt `NotWith` Jessica | |
] | |
-------------------------------------------------------------------------------- | |
-- Generic solver | |
class (Enum a, Bounded a, Eq a) => Atom r a where | |
get :: r -> a | |
data Rule r = forall a b . (Atom r a, Atom r b) => With a b | |
| forall a b . (Atom r a, Atom r b) => NotWith a b | |
enums :: (Enum a, Bounded a) => [a] | |
enums = [minBound .. maxBound] | |
solve :: (Atom r a, Atom r b, Atom r c, Atom r d) => | |
(a -> b -> c -> d -> r) -> [Rule r] -> [[r]] | |
solve mkRow rules = | |
[ table | |
| ans <- permutations enums | |
, lols <- permutations enums | |
, ads <- permutations enums | |
, let table = zipWith4 mkRow enums ans lols ads | |
, all (flip check table) rules | |
] | |
check :: Rule r -> [r] -> Bool | |
check (With l r) = any (\row -> get row == l && get row == r) | |
check (NotWith l r) = all (\row -> not (get row == l && get row == r)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment