Finding the spookiest day of the century
Finding the spookiest day of the century
By David Ameneyro. October 18, 2020.
My 8-year old daughter recently asked me, "Dad, what would happen if the full moon was on a Friday the 13th in October?" Instead of talking about all the Halloweeny things things that would probably happen on that day, I immediately thought that the coincidence of those events would probably be rare. I told her I didn't know but we were going to find out with a little programming! Cue her regret
We've been slowly working our way through the Elementary Introduction to the Wolfram Language and I thought this was the perfect opportunity for a "real world" application. We're less than a quarter of the way through the course and so far her highlights have been colors and shapes. My favorite part has been her really groking Table[] as she finally got to apply it to something fun.
We've been slowly working our way through the Elementary Introduction to the Wolfram Language and I thought this was the perfect opportunity for a "real world" application. We're less than a quarter of the way through the course and so far her highlights have been colors and shapes. My favorite part has been her really groking Table[] as she finally got to apply it to something fun.
Side note on teaching a child
Side note on teaching a child
Table[]is the most alien concept to a kid because it is the most fundamentally computational, not physical. Kids get addition and subtraction, words, shapes, and colors because they have experience with those things, but naming a variable and applying a function to that variable repeatedly as it changes is not something a kid has experienced.
My daughter dutifully passed the intro chapter on Table[]where she had to apply it to boring things like Range[]....
My daughter dutifully passed the intro chapter on Table[]where she had to apply it to boring things like Range[]....
Table[Range[n],{n,1,5}]
Out[]=
{{1},{1,2},{1,2,3},{1,2,3,4},{1,2,3,4,5}}
...but she really loved doing colors and shapes, and that's when I saw her start to push herself...
Table[Graphics[Style[RegularPolygon[n],Hue[n/10]]],{n,3,10}]
Out[]=
,
,
,
,
,
,
,
Friday the 13th
Friday the 13th
I’ll be honest, I didn’t have an immediate idea on how to structure an algorithm for finding a list of Friday the 13ths, but after some quick googling I found the following on StackExchange.
(Local) In[]:=
friday13th[year_Integer]:=Select[DayName[#]===Friday&]@Array[DateObject[{year,#,13}]&,12]
Perfect. I just needed to 1) limit answers to October and 2) limit dates that coincide with the full moon.
1) Easy, just modified the initial array to only generate October 13ths for each year (where the original algo generated a list of 13ths for each month)
2) This also turned out easier than expected. The Wolfram Documentation Center is broken up by subject, and I found the function to find the moon phase of a given date (the aptly named MoonPhase[]) with one-click and a hover.
1) Easy, just modified the initial array to only generate October 13ths for each year (where the original algo generated a list of 13ths for each month)
2) This also turned out easier than expected. The Wolfram Documentation Center is broken up by subject, and I found the function to find the moon phase of a given date (the aptly named MoonPhase[]) with one-click and a hover.
My final algorithm ended up as:
My final algorithm ended up as:
(Local) In[]:=
friday13thfullmoon[year_Integer]:=SelectDayName[#]===Friday&&MoonPhase[#,"Name"]===&@{DateObject[{year,10,13}]}
This line of code doesn’t actually give any answers, but it does allow the user to enter a year and will return the the Date object for that Oct 13th if it falls on the full moon. I liked this approach because it allowed my daughter to be able to participate in finding the answer.
Her addition to the effort was the following (with me helping by adding //Flatten):
Her addition to the effort was the following (with me helping by adding //Flatten):
(Local) In[]:=
Table[friday13thfullmoon[year],{year,2020,3020}]//Flatten
(Local) Out[]=
,,
Only three occurrences in the next 1000 years!
Taking it further
Taking it further
At this point she had her fill of programming for the day and wandered away, but I had to keep tinkering.
The documentation center warns that MoonPhase[]is sensitive to the hour of the day that is queried, since the moon will go from waxing gibbous to full moon or full moon to waning gibbous within a full day. Here is the moon phase for each hour of the day on 10/31/2020:
(Local) In[]:=
Table[MoonPhase[DateObject[{2020,10,31,hour}],"Name"],{hour,0,23,1}]
(Local) Out[]=
,,,,,,,,,,,,,,,,,,,,,,,
Since I didn’t specify the hour of the day or time zone within my Date Object, the default is midnight of UTC.
I reviewed the cutoffs between waxing/waning gibbous and full moon and it appears to sit at full moon == .997+ illumination. It also appears that the moon phase will change approximately .002 in the course of the day.
I reviewed the cutoffs between waxing/waning gibbous and full moon and it appears to sit at full moon == .997+ illumination. It also appears that the moon phase will change approximately .002 in the course of the day.
(Local) In[]:=
ListLinePlot[{Table[MoonPhase[DateObject[{2020,10,31,hour}]],{hour,0,23,1}],Table[.997,24]},PlotLabels{"Moon phase","Full moon cutoff"}]
(Local) Out[]=
Using this info I modified my algorithm to return any dates with illumination >= .995
(Local) In[]:=
Select[DayName[#]===Friday&&MoonPhase[#]≥.995&]@Table[DateObject[{year,10,13}],{year,2020,3020}]
(Local) Out[]=
,,,,,
This expanded our spookiest day exposure to six days in the next 1000 years!
Next Time
Next Time
This isn’t the only way I could have found our answer.
I bet that generating a full list of dates and using Select[] iteratively to pare down the list until every condition is met would also be a good way for a kid to better understand what is going on. Alternatively generating several different lists and using Intersection[] to find the common dates could also work.
Expanding the search a few thousand years in either direction, using DateDifference[]and plotting the result might also find something interesting. Next time...
I bet that generating a full list of dates and using Select[] iteratively to pare down the list until every condition is met would also be a good way for a kid to better understand what is going on. Alternatively generating several different lists and using Intersection[] to find the common dates could also work.
Expanding the search a few thousand years in either direction, using DateDifference[]and plotting the result might also find something interesting. Next time...
Did you like this post? Any ideas on other approaches I could have taken or ways to make my code more elegant? I'd love to hear from you!
Hit me up on Twitter (@ahmeneeroe) or email (david.ameneyro@gmail.com)
Hit me up on Twitter (@ahmeneeroe) or email (david.ameneyro@gmail.com)