Skip to content

Instantly share code, notes, and snippets.

Last active Aug 29, 2015
What would you like to do?
A translation of Norvig's solution to the Cheryl's Birthday problem from Python to Haskell. Original:
-- A list of possible dates Cheryl's birthday might be on.
possibilities = [(May, 15), (May, 16), (May, 19),
(June, 17), (June, 18),
(July, 14), (July, 16),
(August, 14), (August, 15), (August, 17)]
-- We say we know the actual date when the list of possibilities is singular.
know ps = length ps == 1
-- Telling someone the month or day will reduce the possibilities.
tell f date = filter (\date' -> f date' == f date)
-- List of statements made about the birthday. Each is a function that takes
-- a single date, and checks if all statements hold for that date.
statements = [statement3, statement4, statement5]
-- Albert: I don't know when Cheryl's birthday is, and I know that Bernard
-- also does not know.
statement3 date = iDon'tKnow && bernardDoesn'tKnow where
told = (tell month date) possibilities
iDon'tKnow = (not . know) told
bernardDoesn'tKnow = all (not . know) [(tell day d) possibilities | d <- told]
-- Bernard: At first I didn't know when Cheryl's birthday is, but I know now.
statement4 date = iDidn'tKnow && iNowKnow where
told = (tell day date) possibilities
iDidn'tKnow = (not . know) told
iNowKnow = know (filter statement3 told)
-- Albert: Then I also know when Cheryl's birthday is.
statement5 date = iNowKnow where
told = (tell month date) possibilities
iNowKnow = know (filter statement4 told)
-- Solver. We find birthdays which are consistent with all the statements given.
-- The arguments are uncurried because it makes no sense to provide only one of
-- the possibilities and statements.
birthdays (possibilities, statements) = filter consistent possibilities where
consistent possibility = allTrue statements possibility
allTrue fs x = and $ map ($ x) fs
-- Solve the problem - find the list of possible birthdays, and check if we've
-- successfully narrowed it down to one!
cheryl'sBirthday = case birthdays (possibilities, statements) of
[b] -> Just b
_ -> Nothing
-- That's all, folks!
main = print cheryl'sBirthday
-- Months we used.
data Month = May | June | July | August
deriving (Show, Eq)
-- Nicer named accessors for the tuples.
month = fst
day = snd
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment