Friday, October 12, 2007

Enigma 1464

Here is how Mathematica can be used to solve New Scientist Enigma number 1464 in the 13 October 2007 issue.

Generate a list of leap years in the 20th century during which the births can occur. The year 1900 is excluded because it was not a leap year.
lpyrs = Table[i, {i, 1904, 2000, 4}]
{1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000}

Generate a list of all days during the above leap years in {yyyy, mm, dd} format.
(days = Flatten[Map[Table[Take[DateList[t],3], Evaluate[{t,#,#+365*86400,86400}&[AbsoluteTime[{#}]]]]&, lpyrs], 1]) // Length
9150

Convert this list of days into DDMMYY format.
(days2 = Map[(10000#[[3]] + 100#[[2]] + If[#[[1]]>=2000, #[[1]]-2000, #[[1]]-1900])&, days]) // Length
9150

Select the cases which are square days.
sqrdays=Select[days2, IntegerQ[Sqrt[#]]&]
{300304, 10404, 200704, 40804, 121104, 91204, 60516, 10816, 110224, 101124, 20736, 11236, 150544, 131044, 80656, 70756, 20164, 50176, 30276, 30976, 51076, 240100, 260100, 230400, 270400, 220900, 280900}

Split this list into sublists for each year.
sqrdays2 = Split[sqrdays, Take[IntegerDigits[#1],-2]==Take[IntegerDigits[#2],-2]&]
{{300304, 10404, 200704, 40804, 121104, 91204}, {60516, 10816}, {110224, 101124}, {20736, 11236}, {150544, 131044}, {80656, 70756}, {20164}, {50176, 30276, 30976, 51076}, {240100, 260100, 230400, 270400, 220900, 280900}}

Select the cases that have 6 or more different square days.
sqrdays3 = Select[sqrdays2, Length[#]>=6&]
{{300304, 10404, 200704, 40804, 121104, 91204}, {240100, 260100, 230400, 270400, 220900, 280900}}

Split the list of square days into sublists for each month.
sqrdays4 = Table[Select[sqrdays, FromDigits[Take[IntegerDigits[#],{-4,-3}]]==i&], {i,12}]
{{20164, 50176, 240100, 260100}, {110224, 30276}, {300304}, {10404, 230400, 270400}, {60516, 150544}, {80656}, {200704, 20736, 70756}, {40804, 10816}, {30976, 220900, 280900}, {131044, 51076}, {121104, 101124}, {91204, 11236}}

Select from all of the cases with 6 or more square days only those for which there is but a single square day in that month. These are the cases where the birth and death days are forced to lie in different months. There is one case that satisfies this criterion, which is thus the grandfather's date of birth.
Select[sqrdays3//Flatten, Length[sqrdays4[[Position[sqrdays4,#1][[1,1]]]]]==1&]
{300304}

3 comments:

Anonymous said...

As stated, this problem is not solvable. Your solution assumes that none of the cousins died on the day they were born (aged 0 years).

Stephen Luttrell said...

If by "not solvable" you mean "not solvable uniquely" then strictly I agree with you.

My solution is given for the Enigma problem that the author intended to set, and for which there is a prize for the first correct solution to be drawn.

Your comment reminds me of the joke about the philosophy exam question which read "Is this a question?", to which a student wrote the answer "Is this an answer?". I don't know whether the student was awarded 0% or 100% for this!

Anonymous said...

Re the philosophical whimsy. I had heard this tale many years back, when it was recounted as true, and getting the smartarse 100%. There was one slight variation though; he or she wrote 'If this is an answer'