At work, every Friday we have a mailing list set up where a riddle is announced and then the participants are invited to submit answers to the riddle on Tuesday.

A few weeks ago, there was an interesting riddle presented.

Riddle: On an 8 x 8 chessboard, define two squares to be neighbors if they share a common side. Some squares will have two neighbors, some will have three, and some will have four. Now suppose each square contains a number subject to the following condition: The number in a square equals the average of the numbers of all its neighbors. If the square with coordinates [1, 1] (i.e. a corner square) contains the number 10, then find (with proof) all possible values that the square with coordinates [8, 8] (i.e. opposite corner) can have?

After some consideration, there is an easy proof by contradiction. However, I am trying to learn a new programming language, specifically Mathematica. I thought that attempting to solve this riddle by developing a system of equations in Mathematica would be good practice.

The Mathematica code is located below and also posted on my Github account. By the way, the answer is 10.

(* ::Package:: *)

(* Parameters *)
size = 8;
givenVal = 10;
(* Corners *)
bottemLeftCornerEq[{i_, j_}] := StringJoin[“(c”, ToString[i+1], ToString[j], ” + c”, ToString[i], ToString[j+1], “)/2 == c”, ToString[i], ToString[j]]
topRightCornerEq[{i_, j_}] := StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j-1], “)/2 == c”, ToString[i], ToString[j]]
topLeftCornerEq[{i_, j_}] := StringJoin[“(c”, ToString[i+1], ToString[j], ” + c”, ToString[i], ToString[j-1], “)/2 == c”, ToString[i], ToString[j]]
bottmRightCornerEq[{i_, j_}] := StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j+1], “)/2 == c”, ToString[i], ToString[j]]
(* Edges *)
bottomEdge[{i_, j_}]:= StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j+1], ” + c”, ToString[i+1], ToString[j], “)/3 == c”, ToString[i], ToString[j]]
topEdge[{i_, j_}]:= StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j-1], ” + c”, ToString[i+1], ToString[j], “)/3 == c”, ToString[i], ToString[j]]
leftEdge[{i_, j_}]:= StringJoin[“(c”, ToString[i], ToString[j+1], ” + c”, ToString[i+1], ToString[j], ” + c”, ToString[i], ToString[j-1], “)/3 == c”, ToString[i], ToString[j]]
rightEdge[{i_, j_}]:= StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j+1], ” + c”, ToString[i], ToString[j-1], “)/3 == c”, ToString[i], ToString[j]]
(* Middle *)
middleEq[{i_, j_}] := StringJoin[“(c”, ToString[i-1], ToString[j], ” + c”, ToString[i], ToString[j-1], ” + c”, ToString[i+1], ToString[j],” + c”, ToString[i+1], ToString[j+1], “)/4 == c”, ToString[i], ToString[j]]
equationSelector[{i_, j_}] := Which[ i == 1 && j == 1
, bottemLeftCornerEq[{i, j}]
, i == size && j == 1
, bottmRightCornerEq[{i, j}]
, i == size && j == size
, topRightCornerEq[{i, j}]
, i == 1 && j == size
, topLeftCornerEq[{i, j}]
, i == 1
, leftEdge[{i, j}]
, i == size
, rightEdge[{i, j}]
, j == 1
, bottomEdge[{i, j}]
, j == size
, topEdge[{i, j}]
, i != 1 && i != size && j != 1 && j != size
, middleEq[{i, j}]
]

(* Test All Cases
i = 1; j = 1;
bottemLeftCornerEq[{i, j}] \[Equal] equationSelector[{i, j}]
i = 3; j = 1;
bottmRightCornerEq[{i, j}] \[Equal] equationSelector[{i, j}]
i = 1; j = 3;
topLeftCornerEq[{i, j}] \[Equal] equationSelector[{i, j}]
i = 3; j = 3;
topRightCornerEq[{i, j}] \[Equal] equationSelector[{i, j}]
i = 2; j = 1;
bottomEdge[{i, j}] \[Equal] equationSelector[{i, j}]
i = 2; j = 3;
topEdge[{i, j}] \[Equal] equationSelector[{i, j}]
i = 3; j = 2;
rightEdge[{i, j}] \[Equal] equationSelector[{i, j}]
i = 1; j = 2;
leftEdge[{i, j}] \[Equal] equationSelector[{i, j}]
i = 2; j = 2;
middleEq[{i, j}] \[Equal] equationSelector[{i, j}]
*)
(* Test on simple 2×2 case
eq1 = bottemLeftCornerEq[{1, 1}]
eq2 = bottmRightCornerEq[{2, 1}]
eq3 = topRightCornerEq[{2, 2}]
eq4 = topLeftCornerEq[{1, 2}]
Solve[ToExpression[eq1] && ToExpression[eq2] && ToExpression[eq3] && ToExpression[eq4] && c11 \[Equal] 10, {c11, c12, c21, c22}]
*)

(* Create System *)

(* Iterate over range *)
f[x_, y_] := {x, y}
genVar[{i_, j_}] := StringJoin[“c”, ToString[i], ToString[j]];
varList = Map[genVar, grid];
grid = Flatten[Outer[f, Range[size], Range[size]], 1];
eqPart1 = StringReplace[ToString[Map[equationSelector, grid]], {“{” -> “”, “}” -> “”, “,” -> ” &&”}];
SolveStr = StringJoin[eqPart1, ” && c11 ==”, ToString[givenVal]]

Solve[ToExpression[SolveStr], ToExpression[varList]]

(* Solve without a given value
*)

Solve[ToExpression[eqPart1], ToExpression[varList]]

(*
Solve[(c21 + c12)/2 == c11 && (c22 + c11)/2 == c12 && (c11 + c22)/2 == c21 && (c12 + c21)/2 == c22 && c11\[Equal]10, {c11,c12,c21,c22}] *)

(*
*)
(*
startCell = c11
c11 = 10
bottemLeftCornerEq[1, 1]
topRightCornerEq[8, 8]
topLeftCornerEq[1, 8]
bottmRightCornerEq[8, 1]
bottomEdge[{2,1}]
topEdge[4,8]
leftEdge[1, 4]
rightEdge[8, 4]
Map[bottomEdge, {{2,1}}]
eq1
eq2 *)