public
Created

  • Download Gist
Puzzle.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
module Puzzle where
 
import Data.List
 
 
data Girl = Ellie | Emily | Jessica deriving (Bounded, Enum, Eq, Show)
data Animal = Elephant | Zebra | Giraffe deriving (Bounded, Enum, Eq, Show)
data Lolly = Grunge | Plooper | Zinger deriving (Bounded, Enum, Eq, Show)
data Adult = Aunt | Grandma | Mum deriving (Bounded, Enum, Eq, Show)
 
type Row = (Girl, Animal, Lolly, Adult)
type Table = [Row]
type Rule = Row -> Bool
 
rules :: [Rule]
rules = [ \(g, a, l, w) -> g /= Ellie || w == Grandma && l /= Zinger
, \(g, a, l, w) -> w /= Mum || a == Elephant
, \(g, a, l, w) -> a /= Giraffe || l /= Plooper
, \(g, a, l, w) -> w /= Aunt || l == Grunge && g /= Jessica
]
 
solution :: Table
solution = head $ filter rowsMatchRules allCombinations
 
allCombinations :: [Table]
allCombinations = [ table
| as <- permsOfEnum
, ls <- permsOfEnum
, ws <- permsOfEnum
, let table = zip4 [minBound .. maxBound] as ls ws
]
 
permsOfEnum :: (Bounded a, Enum a) => [[a]]
permsOfEnum = permutations [minBound .. maxBound]
 
rowsMatchRules :: Table -> Bool
rowsMatchRules combinations = all matchesRules combinations
 
matchesRules :: Row -> Bool
matchesRules combination = all (\r -> r combination) rules
 
{-
alternative: specify rules in the list comprehension:
 
[ table
| ...
let table = ...
, any (\(g, a, l, w) -> g == Ellie && w == Grandma) table
, all (...)
...
]
this can then be generalised to a generic solver
-}
 
{-
ExistentialQuantification:
data Rule = forall a b . (Eq a, Eq b) => Is (Row -> a, a) (Row b -> b)
 
when forall is "inside", it's an existential, if "outside", universal
-}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.