# Solving a system of equations using the data generated by PowersRepresentations and ParallelTable

First of all, it is possible to check the code that I am asking for because I know that $$x=3051$$ must yield at least a solution to the problem.

Well, I have the following system of equations: Now, I need to solve this system for {n1,n2,n3,n4,n5,n6,n7,n8,n9} . The values of $$x$$ that needs to be tried come from the following code:

ParallelTable[
If[TrueQ[Length[
Select[Select[PowersRepresentations[n, 3, 2], Times @@ # != 0 &],
Length[#] == Length[Union[#]] &]] >= 6], n, Nothing], {n, 0,
10000}]

(* {314,329,341,...,9998} *)


Question: How can I loop through the values given by the ParallelTable code ({314,329,341,...,9998}) in order to check if the system of equations gives a solution for a certain value of $$x$$?

So, the first case to check would be when $$x=314$$ and the solutions that has to be tried are given by:

Select[Select[PowersRepresentations[314, 3, 2], Times @@ # != 0 &],
Length[#] == Length[Union[#]] &]

(* {{1, 12, 13}, {3, 4, 17}, {3, 7, 16}, {5, 8, 15}, {7, 11, 12}, {8, 9,
13}} *)


So, we need to try to solve the following system of equations using the possible values, given from the code above ({{1,12,13},{3,4,17},{3,7,16},{5,8,15},{7,11,12},{8,9,13}}):

x=314;
Solve[{x == n1^2 + n2^2 + n3^2, x == n4^2 + n5^2 + n6^2,
x == n7^2 + n8^2 + n9^2, x == n1^2 + n4^2 + n7^2,
x == n2^2 + n5^2 + n8^2, x == n3^2 + n6^2 + n9^2}, {n1, n2, n3, n4,
n5, n6, n7, n8, n9}]

• Not sure I understand what you are doing, but some thoughts: xvals = ParallelTable[...] -- your expression before first question, which gives {314, 329, ...}. Now you can use this to substitute for x in your system of equations: ParallelMap[ Solve[{# == n1^2 + n2^2 + n3^2, # == n4^2 + n5^2 + n6^2, # == n7^2 + n8^2 + n9^2, # == n1^2 + n4^2 + n7^2, # == n2^2 + n5^2 + n8^2, # == n3^2 + n6^2 + n9^2}, {n1, n2, n3, n4, n5, n6, n7, n8, n9}, PositiveIntegers] &, xvals];, or just for limited range xvals[[1;;100]], then for the next range, because of computation time and memory.
– Alx
Apr 20 '20 at 8:17
• @Alx You can test the code, but using $x=3051$ you have to find: $$n_1=29,n_2=41,n_3=23,n_4=1,n_5=37,n_6=41,n_7=47,n_8=1,n_9=29$$
– Jan
Apr 20 '20 at 8:20
• Yes, it gives values from your comment and many other combinations in terms of positive integers.
– Alx
Apr 20 '20 at 8:24
• @Alx Can you show me what you did. Feel free to post your code as an answer. Thank you very much for thinking with me
– Jan
Apr 20 '20 at 8:25
• Crossposted here Apr 20 '20 at 14:24

Post here my comment as an answer (actually I'm not sure this is the right answer). Define table of x values (just as given by OP):

    xvals = ParallelTable[
If[TrueQ[
Length[Select[
Select[PowersRepresentations[n, 3, 2], Times @@ # != 0 &],
Length[#] == Length[Union[#]] &]] >= 6], n, Nothing], {n, 0,
10000}];


Now we can use this to substitute for x when solving the given system of equations, and to speed-up the code we can use ParallelMap:

ParallelMap[
Solve[{# == n1^2 + n2^2 + n3^2, # == n4^2 + n5^2 + n6^2, # ==
n7^2 + n8^2 + n9^2, # == n1^2 + n4^2 + n7^2, # ==
n2^2 + n5^2 + n8^2, # == n3^2 + n6^2 + n9^2}, {n1, n2, n3, n4,
n5, n6, n7, n8, n9}, PositiveIntegers] &, xvals[[;; 50]]];


This gives the solution in terms of positive integer numbers, and because of time and memory consumption one can use several ranges of xvals (here the first 50 values are used).

One can also solve for particular x:

x = 3051;
sol=Solve[{x == n1^2 + n2^2 + n3^2, x == n4^2 + n5^2 + n6^2,
x == n7^2 + n8^2 + n9^2, x == n1^2 + n4^2 + n7^2,
x == n2^2 + n5^2 + n8^2, x == n3^2 + n6^2 + n9^2}, {n1, n2, n3, n4,
n5, n6, n7, n8, n9}, PositiveIntegers]


This gives many solutions and {n1 -> 29, n2 -> 41, n3 -> 23, n4 -> 1, n5 -> 37, n6 -> 41, n7 -> 47, n8 -> 1, n9 -> 29} is among them.

To check if all the solutions are unique we can do:

Select[DeleteDuplicates /@ Values[sol], Length[#] == 9 &]


In the case of x = 3051 we have repeated values (1, 29, 41) and this Select command gives empty list as an output {}, that means there is no unrepeated values.

Using ParallelTable (as OP suggested in comments):

sol = ParallelTable[
Solve[{x == n1^2 + n2^2 + n3^2, x == n4^2 + n5^2 + n6^2,
x == n7^2 + n8^2 + n9^2, x == n1^2 + n4^2 + n7^2,
x == n2^2 + n5^2 + n8^2, x == n3^2 + n6^2 + n9^2,
x == n1^2 + n5^2 + n9^2}, {n1, n2, n3, n4, n5, n6, n7, n8, n9},
PositiveIntegers], {x, 0, 2000}];

Map[Select[Length[#] == 9 &]@*DeleteDuplicates,
Values[sol], {2}] //. {} -> Nothing


We Map at 2nd level (at all sub-lists of sol): composition (@*) of deleting repeated values (DeleteDuplicates) and slecting sub-lists with length of 9 (all distinct values). Finally one can delete empty lists by repeatedly applying rule {} -> Nothing and see if something is left in the end.

• Using your code that is stated after 'One can also solve for particular x:' is there a way to filter those solutions for the ones where: $$n_1\ne n_2\ne n_3\ne n_4\ne n_5\ne n_6\ne n_7\ne n_8\ne n_9$$ This is the ultimate problem that I would like to solve.
– Jan
Apr 20 '20 at 8:40
• They all have distinct values, but some are repeated (as 1, 29, 41 for x=3051). What do you mean?
– Alx
Apr 20 '20 at 8:46
• I am looking for a unique solution such that all the values for n1,n2,...n9 are not equal to each other. In the solved case of x=3051 that is not true because of n1=n9 for example.
– Jan
Apr 20 '20 at 8:49
• Is there a way to filter the solutions to search for the unique solution. I tried: x = 3051; Solve[{x == n1^2 + n2^2 + n3^2, x == n4^2 + n5^2 + n6^2, x == n7^2 + n8^2 + n9^2, x == n1^2 + n4^2 + n7^2, x == n2^2 + n5^2 + n8^2, x == n3^2 + n6^2 + n9^2, x == n1^2 + n5^2 + n9^2, n1 != n2 != n3 != n4 != n5 != n6 != n7 != n8 != n9}, {n1, n2, n3, n4, n5, n6, n7, n8, n9}, PositiveIntegers] But that gave a errormessage
– Jan
Apr 20 '20 at 8:49
• It is possible that there is no solution, but I would like to know how to code that in Mathematica.
– Jan
Apr 20 '20 at 8:52
mm = Partition[Array[Subscript[n, #] &, 9], 3];
TeXForm @ MatrixForm @ mm


$$\left( \begin{array}{ccc} n_1 & n_2 & n_3 \\ n_4 & n_5 & n_6 \\ n_7 & n_8 & n_9 \\ \end{array} \right)$$

We can restate the problem as finding a 3X3 matrix of distinct square integers with identical row and column sums.

### "to check if the system of equations gives a solution for a certain value of x?"

For the related problem, given an integer x find a 3X3 matrix of distinct square integers such that every row and every column sum to x, we can use a semi-brute-force approach using IntegerPartitions of x with 3 elements restricting elements to square numbers.

xx = 314;
ip = IntegerPartitions[xx, {3}, Range[Ceiling[xx^(1/2)]]^2];
{{289, 16, 9}, {256, 49, 9}, {225, 64, 25}, {169, 144, 1}, {169, 81, 64}, {144, 121, 49}}


Construct 3X3 matrices taking 3-subsets of ip and select the duplicate-free ones:

dupFreeMatrices = Select[DuplicateFreeQ[Join @@ #] &]@Subsets[ip, {3}];
MatrixForm /@ dupFreeMatrices The rows in each of these matrices sum to 314 by construction.

We next check if we can re-organize any of these matrices by permuting row elements to get a matrix with desired column sums.

For xx = 314 find that this impossible:

Join @@ ((Select[Total[#] == {xx,xx,xx} &]@Tuples[Permutations /@ #]) & /@ dupFreeMatrices)

{}


Combining the steps into a function:

ClearAll[findMat]
findMat = Module[{cums = ConstantArray[#,3],
mats = Select[DuplicateFreeQ[Join @@ #] &] @
Subsets[Select[DuplicateFreeQ]@IntegerPartitions[#, {3},
Range[Ceiling[#^(1/2)]]^2], {3}]},
Join @@ ((Select[Total[#] == csums &]@Tuples[Permutations /@ #]) & /@ mats)]&;


Checking few entries from the list produced by OP's ParallelTable:

findMat /@ {314, 329, 341, 3051}

 {{}, {}, {}, {}}


For x up to 10000, we find two numbers,3249 and 3969, for which we can find 9 distinct square integers satisfying the constraints in OP's system (1):

sols  = ParallelTable[findMat[n] /. {} -> Nothing, {n, 0, 10000}];

{Total[#[[1, 1]]], MatrixForm /@ #} & /@ sols A faster version is to keep the first row and permute the second and third rows when we take Tuples:

ClearAll[findMat2]
findMat2 = Module[{csums = ConstantArray[#, 3],
mats = Select[DuplicateFreeQ[Join @@ #] &]@
Subsets[Select[DuplicateFreeQ]@
IntegerPartitions[#, {3}, Range[Ceiling[#^(1/2)]]^2], {3}]},
Join @@ ((Select[Total[#] == csums &]@
Tuples[{{#[]}, Permutations[#[]],
Permutations[#[]]}]) & /@ mats)] &;

solsB = ParallelTable[findMat2[n] /. {} -> Nothing, {n, 0, 10000}];

{Total[#[[1, 1]]], MatrixForm /@ #} & /@ solsB If we take all column permutations of matrices in solsB we get the longer lists in sols.

• First of all, thank you so much for your answer. Now if I want to test this at a bigger scale is it possible to use the ParallelTable function, to check many more cases than one each time? Can you maybe show me your method using that?
– Jan
Apr 20 '20 at 9:56
• @Jan, you can try the function findMat in ParallelTable.
– kglr
Apr 20 '20 at 10:04
• I have no idea how to program using Mathematica. Can you help me combine the first and second code from my question, into the method that you're describing? Thanks in advance.
– Jan
Apr 20 '20 at 10:07
• @Jan, I meant you can try ParallelTable[findMat[n] /. {} -> Nothing, {n, 0, 5000}]
– kglr
Apr 20 '20 at 10:11
• Yes I understand, thanks. How can I be sure that my equations are satisfied, because I do not see them being used in your code?
– Jan
Apr 20 '20 at 10:12