Friday, September 14, 2007

Enigma 1460

Here is how Mathematica can be used to solve New Scientist Enigma number 1460 in the 15 September 2007 issue.

This problem is designed to make brute force attack difficult because the set of candidate solutions starts off with (9!)^2=131681894400 elements, i.e. it is the Cartesian product of 2 sets of 9! elements. However, a methodical approach can be used to prune this set down until there is only one case left, i.e. the solution. The main trick is to prune each of the 9! element sets as much as possible before forming the Cartesian product of the residual sets, and keeping track of how many candidate solutions remain at each stage.

Create a list of digits 1,...,9 and a list of all permutations of this.
digits=Range[9]
(digitperms=Permutations[digits])//Length

{1,2,3,4,5,6,7,8,9}
362880

Create a list of the 9 colours and a list of all permutations of this.
colours={"grey","hazel","indigo","jade","khaki","lemon","mauve","navy","orange"};
(colourperms=Permutations[colours])//Length

362880

Without loss of generality, assume that "grey" is at circular position 1, and select all digit permutations where each circular position 2, ... , 9 (i.e. not including the "grey" position) has an odd and even digit on its neighbours.
(digitperms2=Select[digitperms,Apply[And,Map[OddQ[#[[1]]+#[[3]]]&,Most[Partition[#,3,1,{1,1}]]]]&])//Length
2880

Select the colour permutations where "hazel", "indigo", "jade" and "khaki" are in consecutive clockwise circular positions. There is no need to look for wrapped-round cases because "grey" is locked in circular position 1.
(colourperms2=Cases[colourperms,{"grey",___,"hazel","indigo","jade","khaki",___}])//Length
120

Build a Cartesian product list of all remaining digit permutations and colour permutations.
(digitcolourperms=Flatten[Outer[List,digitperms2,colourperms2,1],1])//Length

345600

Select the cases where the "hazel", "indigo" and "jade" digits add up to give the "khaki" digit.
(digitcolourperms2=Select[digitcolourperms,Total[Transpose[Cases[#,{_,"hazel""indigo""jade"}]][[1]]]==Cases[#,{_,"khaki"}][[1,1]]&[Transpose[#]]&])//Length
8640

Select the colour permutations where "lemon", "mauve" and "navy" are in consecutive clockwise circular positions. There is no need to look for wrapped-round cases because "grey" is locked in circular position 1.
(digitcolourperms3=Cases[digitcolourperms2,{_,{"grey",___,"lemon","mauve","navy",___}}])//Length
432

Select the cases where the "lemon" and "mauve" digits add up to give 2 times the "navy" digit.
(digitcolourperms4=Select[digitcolourperms3,Total[Transpose[Cases[#,{_,"lemon""mauve"}]][[1]]]==2Cases[#,{_,"navy"}][[1,1]]&[Transpose[#]]&])//Length
24

Select the cases where the "hazel" digit is the same as the number of times you can find a digit equal to the sum of the digits on its neighbours. This leaves just one possibility which is the required solution.
Select[digitcolourperms4,(x=Transpose[#];Length[Select[Partition[x,3,1,{1,1}],#[[1,1]]+#[[3,1]]==#[[2,1]]&]]==Cases[x,{_,"hazel"}][[1,1]])&][[1]]//Transpose
{{1,grey}, {3,hazel}, {2,indigo}, {4,jade}, {9,khaki}, {5,orange}, {8,lemon}, {6,mauve}, {7,navy}}

No comments: