# Solve the "Cheryl's birthday" puzzle using mathematica

The "Cheryl's birthday" puzzle has been circulating around, the backstory is available via wikipedia. The puzzle itself is reproduced here:

Albert and Bernard just became friends with Cheryl, and they want to know when her birthday is. Cheryl gave them a list of 10 possible dates:

    May 15     May 16     May 19
June 17    June 18
July 14    July 16
August 14  August 15  August 17


Cheryl then tells Albert and Bernard separately the month and the day of the birthday respectively.

Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.

Bernard: At first I don't know when Cheryl's birthday is, but I know now.

Albert: Then I also know when Cheryl's birthday is.

So when is Cheryl's birthday?

An iterative iPython solution was posted here: http://nbviewer.ipython.org/url/norvig.com/ipython/Cheryl.ipynb

I played around with it and posted my own procedural solution for mathematica here: https://gist.github.com/lburton/241a8083c5d764708010

Since I very seldom use the "math" part of mathematica, I'm really curious to learn how a more sophisticated user would approach the solution. I guess I'd award the answer to the most up-voted.

Of course I'm interested to know more about this general class of problem, so I can identify instances of it that appear in my real work :)

Here is a webpage I set up which solves Cheryl's Birthday-like problems in full generality (i.e. you can specify any set of possible dates) using Mathematica CDF.

http://cherylsbirthdaysolver.com

• very very nice +1 of course :) May 23, 2015 at 5:21

The following is not particularly inspiring. However,

cand = {{"May", 15}, {"May", 16}, {"May", 19}, {"June", 17}, {"June",
18}, {"July", 14}, {"July", 16}, {"August", 14}, {"August",
15}, {"August", 17}};
c1[n_] :=
With[{rem = Cases[Tally[n[[All, 2]]], {x_, _?(# == 1 &)} :> x]},
DeleteCases[
n, {Alternatives @@ (Cases[n, {_, Alternatives @@ rem}][[All,
1]]), _}]]
c2[n_] :=
With[{rem = Cases[Tally[n[[All, 2]]], {x_, _?(# == 1 &)} :> x]},
Cases[n, {_, Alternatives @@ rem}]]
c3[n_] :=
With[{rem = Cases[Tally[n[[All, 1]]], {x_, _?(# == 1 &)} :> x]},
Cases[n, {Alternatives @@ rem, _}]]
Composition[
Row[{"Cheryl's Birthday is "}~Join~#, Spacer[2]] &, #[[1]] &, c3, c2,
c1][cand]

• cand is candidate birthdays
• c1 to c3 are the clues from the three statements:(i) rule out months that have unique day (ii) rule out birthdays without unique days (iii) find remaining birthday which has unique month
• the rest is for "prettiness"

Run for answer, if not known.