Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Cheryl's birthday
(*
Procedural answer to the question posted here:
"http://nbviewer.ipython.org/url/norvig.com/ipython/Cheryl.ipynb"
Doing this in other fun mathematica ways is left as an exercise for the reader :)
*)
In[665]:= str = " May 15 May 16 May 19
June 17 June 18
July 14 July 16
August 14 August 15 August 17" ;
dates = Partition[StringSplit[str], 2]
Out[666]= {{"May", "15"}, {"May", "16"}, {"May", "19"}, {"June",
"17"}, {"June", "18"}, {"July", "14"}, {"July", "16"}, {"August",
"14"}, {"August", "15"}, {"August", "17"}}
(* 3. albert didn't know when cheryl's birthday was, but
knew bernard didn't know either. he has revealed that he's holding a
month that does not permit bernard to immediately know. bernard would
only immediately know if the day was unique in the list *)
In[667]:=
monthsWithUniqueDay =
GatherBy[dates, Last] // Select[Length[#] == 1 &] // Catenate //
Map[First]
Out[667]= {"May", "June"}
(* 4. bernard reveals his initial day was ambiguous, it
mapped to multiple months *)
In[668]:=
ambiguousDays =
GatherBy[dates, Last] // Select[Length[#] > 1 &] // Catenate //
Map[Last] // Union;
bernardInitial = dates // Select[MemberQ[ambiguousDays, Last[#] ] &]
Out[669]= {{"May", "15"}, {"May", "16"}, {"June", "17"}, {"July",
"14"}, {"July", "16"}, {"August", "14"}, {"August",
"15"}, {"August", "17"}}
(* 4.3 bernard has incorporated albert's information,
ruling out any months with unique days *)
In[670]:=
bernardNoUniqueDays =
bernardInitial // Select[! MemberQ[monthsWithUniqueDay, First[#]] &]
Out[670]= {{"July", "14"}, {"July", "16"}, {"August",
"14"}, {"August", "15"}, {"August", "17"}}
(* 4.6 bernard says this is good enough to give him the
answer. so what days are potentially unambiguous for him, that are
unique day numbers in the set? *)
In[671]:=
bernardCandidateDays =
Tally[bernardNoUniqueDays[[All, 2]]] // Select[Last[#] == 1 &] //
Map[First]
Out[671]= {"16", "15", "17"}
(* since these are the unique day numbers bernard has, we
know the final answer must be one of these month/day combinations *)
In[672]:=
bernardCandidateAnswers =
Select[bernardNoUniqueDays, MemberQ[bernardCandidateDays, Last@#] &]
Out[672]= {{"July", "16"}, {"August", "15"}, {"August", "17"}}
(* 5. albert says this is good enough to give *him* the answer. which
means albert sees here an unambiguous month. What month is
unambiguous in this set? because that's our answer *)
Select[
GatherBy[bernardCandidateAnswers, First], Length[#] == 1 &]
Out[673]= {{{"July", "16"}}}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.