# Solving the UK Intelligence Agency's Christmas Puzzle

Posted 6 years ago
12558 Views
|
4 Replies
|
14 Total Likes
|

Dear All,

Just an hour ago I saw this post at Gizmodo:

## Can You Solve the UK Intelligence Agency's Christmas Puzzle?

I was intrigued! The puzzle was given as an image:

Where the numbers before each row/column denotes that there should be n consecutive blocks in that row. Between each block there must be at least one delimiter (a white cell). So I quickly made a solver, to solve this puzzle:

ClearAll[SpacesDistributeOverN, Possibilities, CheckCommons, FilterPossibilities, GetRow, GetColumn, SetRow, SetColumn, TryRow, TryColumn, ShowAdvancedGrid]
SpacesDistributeOverN[s_, p_] := Flatten[Permutations /@ (Join[#, ConstantArray[0, p - Length[#]]] & /@ IntegerPartitions[s, p]), 1]
Possibilities[hint_, len_] := Module[{p = hint, l = len, b = Length[hint]},
Spaces = # + (Prepend[Append[ConstantArray[1, b - 1], 0], 0]) & /@ (SpacesDistributeOverN[l - Total@p - (b - 1), b + 1]);
Flatten /@ (Riffle[#, Map[Table[1, {#}] &, p, {1}]] & /@ Map[Table[0, {#}] &, Spaces, {2}])
]
CheckCommons[possibilities_] := Module[{poss = possibilities, tmp = possibilities[[1]], len = (possibilities[[1]]) // Length, rowequals = Equal @@@ ( possibilities\[Transpose])},
Table[If[rowequals[[i]], tmp[[i]], Null], {i, 1, len}]
]
FilterPossibilities[possibilities_, knowns_] := Cases[possibilities, knowns /. Null -> _]

GetRow[grid_, row_] := grid[[row]]
GetColumn[grid_, column_] := (grid\[Transpose])[[column]]
SetRow[grid_, row_, newrow_] := Module[{tmp = grid}, tmp[[row]] = newrow; tmp]
SetColumn[grid_, column_, newcol_] := Module[{tmp = grid\[Transpose]},
tmp[[column]] = newcol;
tmp\[Transpose]
]

TryRow[grid_, row_, clues_] := Module[{},
tmprow = GetRow[grid, row];
newclues = clues[[row]];
tmppos = Possibilities[newclues, tmprow // Length];
tmpfilpos = FilterPossibilities[tmppos, tmprow];
newrow = CheckCommons[tmpfilpos];
SetRow[grid, row, newrow]
]
TryColumn[grid_, column_, clues_] := Module[{},
tmpcol = GetColumn[grid, column];
newclues = clues[[column]];
tmppos = Possibilities[newclues, tmpcol // Length];
tmpfilpos = FilterPossibilities[tmppos, tmpcol];
newcol = CheckCommons[tmpfilpos];
SetColumn[grid, column, newcol]
]
ShowAdvancedGrid[grid_, hc_, vc_] := Module[{},
tmpgrid = grid /. {1 -> Graphics[{Black, Rectangle[]}, ImageSize -> 16],
Null -> Graphics[{Gray, Rectangle[]}, ImageSize -> 16],
0 -> Graphics[{White, Rectangle[]}, ImageSize -> 16]};
{dimy, dimx} = grid // Dimensions;
maxhlen = Max[Length /@ hc];
newhclues = Join[Table[Null, {maxhlen - Length[#]}], #] & /@ hc;
maxvlen = Max[Length /@ vc];
newvclues = Join[Table[{Null}, {maxhlen}], vc];
newvclues = Join[Table[Null, {maxvlen - Length[#]}], #] & /@ newvclues;
tmpgrid = Table[Join[newhclues[[i]], tmpgrid[[i]]], {i, 1, dimy}];
tmpgrid = tmpgrid\[Transpose];
tmpgrid = Table[Join[newvclues[[i]], tmpgrid[[i]]], {i, 1, dimx + maxhlen}];
tmpgrid = tmpgrid\[Transpose];
Grid[tmpgrid, Frame -> None, Alignment -> Center, ItemSize -> {1, 1}, Spacings -> {0, 0}]
]


Those are the helper and visualisation functions, now we need the clues and the simple algorithm to solve it:

hclues = {
{7, 3, 1, 1, 7},
{1, 1, 2, 2, 1, 1},
{1, 3, 1, 3, 1, 1, 3, 1},
{1, 3, 1, 1, 6, 1, 3, 1},
{1, 3, 1, 5, 2, 1, 3, 1},
{1, 1, 2, 1, 1},
{7, 1, 1, 1, 1, 1, 7},
{3, 3},
{1, 2, 3, 1, 1, 3, 1, 1, 2},
{1, 1, 3, 2, 1, 1},
{4, 1, 4, 2, 1, 2},
{1, 1, 1, 1, 1, 4, 1, 3},
{2, 1, 1, 1, 2, 5},
{3, 2, 2, 6, 3, 1},
{1, 9, 1, 1, 2, 1},
{2, 1, 2, 2, 3, 1},
{3, 1, 1, 1, 1, 5, 1},
{1, 2, 2, 5},
{7, 1, 2, 1, 1, 1, 3},
{1, 1, 2, 1, 2, 2, 1},
{1, 3, 1, 4, 5, 1},
{1, 3, 1, 3, 10, 2},
{1, 3, 1, 1, 6, 6},
{1, 1, 2, 1, 1, 2},
{7, 2, 1, 2, 5}
};
vclues = {{7, 2, 1, 1, 7},
{1, 1, 2, 2, 1, 1},
{1, 3, 1, 3, 1, 3, 1, 3, 1},
{1, 3, 1, 1, 5, 1, 3, 1},
{1, 3, 1, 1, 4, 1, 3, 1},
{1, 1, 1, 2, 1, 1},
{7, 1, 1, 1, 1, 1, 7},
{1, 1, 3},
{2, 1, 2, 1, 8, 2, 1},
{2, 2, 1, 2, 1, 1, 1, 2},
{1, 7, 3, 2, 1},
{1, 2, 3, 1, 1, 1, 1, 1},
{4, 1, 1, 2, 6},
{3, 3, 1, 1, 1, 3, 1},
{1, 2, 5, 2, 2},
{2, 2, 1, 1, 1, 1, 1, 2, 1},
{1, 3, 3, 2, 1, 8, 1},
{6, 2, 1},
{7, 1, 4, 1, 1, 3},
{1, 1, 1, 1, 4},
{1, 3, 1, 3, 7, 1},
{1, 3, 1, 1, 1, 2, 1, 1, 4},
{1, 3, 1, 4, 3, 3},
{1, 1, 2, 2, 2, 6, 1},
{7, 1, 3, 2, 1, 1}};
{hsize, vsize} = {vclues // Length, hclues // Length};

Total[Flatten[vclues]]
Total[Flatten[hclues]] (* should be equal! *)

(*initialize grid*)
grid = Table[Null, {vsize}, {hsize}] ;

(* these two hints are necessary not more... *)
grid[[9, -7]] = 1;
grid[[-9, 12]] = 1;

oldgrid =.;
RowColumn = 1;
first = 0;
While[! (grid === oldgrid),
If[first == 0,
Do[grid = TryRow[grid, i, hclues], {i, vsize}];
Do[grid = TryColumn[grid, i, vclues], {i, hsize}];
first = 1
];
oldgrid = grid;
RowColumn *= -1;
If[RowColumn == 1,
Do[grid = TryColumn[grid, i, vclues], {i, hsize}];,
Do[grid = TryRow[grid, i, hclues], {i, vsize}];
];
]
ShowAdvancedGrid[grid, hclues, vclues]


Giving:

So we solved it! Now let's see where this hint leads us:

BarcodeRecognize[(1 - grid) // Image]


www.gchq.gov.uk/puzz

At this moment the entire website is down, but as soon as it is up, the next puzzle should be there! Happy Puzzling!

Answer
4 Replies
Sort By:
Posted 6 years ago
 Note that 22 cells are given to help you out. As I found out; only 2 are necessary in order to have a unique solution.
Answer
Posted 6 years ago
 This works a bit faster for me; not sure about the algorithm.
Answer
Posted 6 years ago
 Most likely because he/she uses all the hints, I'm just using 2 of them. With all of the hints the solving is much easier of course... I actually solved it without hints first, then there are multiple solutions, which are pinned down' by supplying two hints.That code might have been inspired by mine--which is fine---as some of the choices are really similar and also the exact same options, in the same order, method is exactly the same. Code is just been rewritten in places Plus@@... instead of Total@..., and similar small changes. Especially the last line:BarcodeRecognize[(1 - constraintTable) // Image] gives it away... Could've been BarcodeRecognize@Image[1-constraintTable]` or such, but no exactly like mine ;-)
Answer
Posted 6 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
Answer
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments