Last active
August 29, 2015 14:19
-
-
Save hagmonk/241a8083c5d764708010 to your computer and use it in GitHub Desktop.
Cheryl's birthday
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* | |
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