0
$\begingroup$

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:

enter image description here

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}]
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Alx Apr 20 at 8:17
  • $\begingroup$ @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$$ $\endgroup$ – Jan Apr 20 at 8:20
  • $\begingroup$ Yes, it gives values from your comment and many other combinations in terms of positive integers. $\endgroup$ – Alx Apr 20 at 8:24
  • $\begingroup$ @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 $\endgroup$ – Jan Apr 20 at 8:25
  • $\begingroup$ Crossposted here $\endgroup$ – Rohit Namjoshi Apr 20 at 14:24
1
$\begingroup$

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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Jan Apr 20 at 8:40
  • $\begingroup$ They all have distinct values, but some are repeated (as 1, 29, 41 for x=3051). What do you mean? $\endgroup$ – Alx Apr 20 at 8:46
  • $\begingroup$ 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. $\endgroup$ – Jan Apr 20 at 8:49
  • $\begingroup$ 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 $\endgroup$ – Jan Apr 20 at 8:49
  • $\begingroup$ It is possible that there is no solution, but I would like to know how to code that in Mathematica. $\endgroup$ – Jan Apr 20 at 8:52
2
$\begingroup$
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

enter image description here

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

enter image description here

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[{{#[[1]]}, Permutations[#[[2]]], 
            Permutations[#[[3]]]}]) & /@ mats)] &;

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

{Total[#[[1, 1]]], MatrixForm /@ #} & /@ solsB

enter image description here

If we take all column permutations of matrices in solsB we get the longer lists in sols.

| improve this answer | |
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Jan Apr 20 at 9:56
  • $\begingroup$ @Jan, you can try the function findMat in ParallelTable. $\endgroup$ – kglr Apr 20 at 10:04
  • $\begingroup$ 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. $\endgroup$ – Jan Apr 20 at 10:07
  • $\begingroup$ @Jan, I meant you can try ParallelTable[findMat[n] /. {} -> Nothing, {n, 0, 5000}] $\endgroup$ – kglr Apr 20 at 10:11
  • $\begingroup$ 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? $\endgroup$ – Jan Apr 20 at 10:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.