I am very interested in the problem that deals with the Pythagorean quadrruples, which are listed in rosettacode. Unfortunately, I have not been able to find any way to compute them with Mathematica. I thought that PowersRepresentations could help me, but I find I do not know how to use it for this problem. To test my ideas, I wrote this code:

simple = Range[50];

factors = PowersRepresentations[#^2, 3, 2]& /@ simple


I don't not know how to continue. I hope that someone can help me finish this task successfully.

• PowersRepresentations[#^2,3,2]&/@Range[50] seems like the right code, so what do you mean by "finish this task"? Commented Sep 5, 2018 at 1:26
• there is also ReduceSumOfSquaresReps[3, #^2] & but it is much slower than PowersRepresentations[#^2,3,2]&
– kglr
Commented Sep 5, 2018 at 1:27
• @JasonB. Hi Jason, with "finish this task" I mean to get the values of d that are requested in the page that I shared. My problem is that I do not know how to debug $factors$ to get { 1, 2, 4, 5, 8, 10, 16, 20, 32, 40, 64, 80, 128, 160, 256, 320, 512, 640, 1024, 1280, 2048}, maybe you can suggest something to get them Commented Sep 5, 2018 at 2:34
• @bullitohappy I have fast compiled implementation of BFS for small permutation spaces. If you're still interested you can undelete your Perform BFS for the 8-puzzle question. Commented Sep 20, 2018 at 21:14
• @jkuczm Thank you very much for the information, I have already undeleted the question about the 8-puzzle game, as you will see my interest in this topic, if you have something respect I would greatly appreciate sharing so we all learn, a greeting and an apology for responding to today. Commented Sep 22, 2018 at 4:10

simple = Range[50];


Since the elements of the quads must be positive, eliminate factors containing zero.

factors =
Select[Flatten[PowersRepresentations[#^2, 3, 2] & /@ simple, 1],
FreeQ[#, 0] &];

quads = Append[#, Sqrt[Total[#^2]]] & /@ factors

(* {{1, 2, 2, 3}, {2, 4, 4, 6}, {2, 3, 6, 7}, {1, 4, 8, 9}, {3, 6, 6,
9}, {4, 4, 7, 9}, {2, 6, 9, 11}, {6, 6, 7, 11}, {4, 8, 8, 12}, {3,
4, 12, 13}, {4, 6, 12, 14}, {2, 5, 14, 15}, {2, 10, 11, 15}, {5, 10,
10, 15}, {1, 12, 12, 17}, {8, 9, 12, 17}, {2, 8, 16, 18}, {6, 12,
12, 18}, {8, 8, 14, 18}, {1, 6, 18, 19}, {6, 6, 17, 19}, {6, 10, 15,
19}, {4, 5, 20, 21}, {4, 8, 19, 21}, {4, 13, 16, 21}, {6, 9, 18,
21}, {7, 14, 14, 21}, {8, 11, 16, 21}, {4, 12, 18, 22}, {12, 12, 14,
22}, {3, 6, 22, 23}, {3, 14, 18, 23}, {6, 13, 18, 23}, {8, 16, 16,
24}, {9, 12, 20, 25}, {12, 15, 16, 25}, {6, 8, 24, 26}, {2, 7, 26,
27}, {2, 10, 25, 27}, {2, 14, 23, 27}, {3, 12, 24, 27}, {7, 14, 22,
27}, {9, 18, 18, 27}, {10, 10, 23, 27}, {12, 12, 21, 27}, {8, 12,
24, 28}, {3, 16, 24, 29}, {11, 12, 24, 29}, {12, 16, 21, 29}, {4,
10, 28, 30}, {4, 20, 22, 30}, {10, 20, 20, 30}, {5, 6, 30, 31}, {6,
14, 27, 31}, {6, 21, 22, 31}, {14, 18, 21, 31}, {1, 8, 32, 33}, {4,
7, 32, 33}, {4, 17, 28, 33}, {6, 18, 27, 33}, {7, 16, 28, 33}, {8,
8, 31, 33}, {8, 20, 25, 33}, {11, 22, 22, 33}, {17, 20, 20,
33}, {18, 18, 21, 33}, {2, 24, 24, 34}, {16, 18, 24, 34}, {1, 18,
30, 35}, {6, 10, 33, 35}, {6, 17, 30, 35}, {10, 15, 30, 35}, {15,
18, 26, 35}, {4, 16, 32, 36}, {12, 24, 24, 36}, {16, 16, 28,
36}, {3, 8, 36, 37}, {3, 24, 28, 37}, {8, 24, 27, 37}, {12, 21, 28,
37}, {2, 12, 36, 38}, {12, 12, 34, 38}, {12, 20, 30, 38}, {2, 19,
34, 39}, {2, 26, 29, 39}, {9, 12, 36, 39}, {10, 14, 35, 39}, {13,
14, 34, 39}, {13, 26, 26, 39}, {14, 22, 29, 39}, {19, 22, 26,
39}, {4, 12, 39, 41}, {4, 24, 33, 41}, {9, 24, 32, 41}, {12, 24, 31,
41}, {23, 24, 24, 41}, {8, 10, 40, 42}, {8, 16, 38, 42}, {8, 26,
32, 42}, {12, 18, 36, 42}, {14, 28, 28, 42}, {16, 22, 32, 42}, {2,
9, 42, 43}, {2, 18, 39, 43}, {6, 7, 42, 43}, {7, 30, 30, 43}, {9,
18, 38, 43}, {18, 25, 30, 43}, {8, 24, 36, 44}, {24, 24, 28,
44}, {4, 28, 35, 45}, {5, 8, 44, 45}, {5, 20, 40, 45}, {6, 15, 42,
45}, {6, 30, 33, 45}, {8, 19, 40, 45}, {13, 16, 40, 45}, {15, 30,
30, 45}, {16, 20, 37, 45}, {20, 20, 35, 45}, {20, 28, 29, 45}, {6,
12, 44, 46}, {6, 28, 36, 46}, {12, 26, 36, 46}, {2, 21, 42, 47}, {6,
18, 43, 47}, {6, 27, 38, 47}, {11, 18, 42, 47}, {18, 21, 38,
47}, {18, 27, 34, 47}, {16, 32, 32, 48}, {4, 9, 48, 49}, {4, 33, 36,
49}, {9, 32, 36, 49}, {12, 24, 41, 49}, {12, 31, 36, 49}, {14, 21,
42, 49}, {15, 24, 40, 49}, {23, 24, 36, 49}, {18, 24, 40, 50}, {24,
30, 32, 50}} *)


Verifying,

And @@ (Total[Most[#]^2] == Last[#]^2 & /@ quads)

(* True *)


EDIT: If you are just looking for the d values not represented

simple = Range[600];

factors = Select[Flatten[PowersRepresentations[#^2, 3, 2] & /@ simple, 1],
FreeQ[#, 0] &];

notRepresented = Complement[simple, Union[Sqrt[Total[#^2]] & /@ factors]]

(* {1, 2, 4, 5, 8, 10, 16, 20, 32, 40, 64, 80, 128, 160, 256, 320, 512} *)

• Thank you very much for helping me solve my doubt, test your code and really return the results I expected, the only thing I notice is that to calculate $factors$ my computer used approximately 9 minutes or so, I do not know if you had to wait for that same time?. I should mention that it was using Range [600] no Range [2200] as requested by the exercise. Thanks again Commented Sep 5, 2018 at 23:33
• The calculation of factors for Range[600] took just under two minutes (114.561 sec) on my laptop. I agree that this does not scale well. For a quick result, evaluate {2^Range[0, 11], 5 2^Range[0, 8]} // Flatten // Sort` Commented Sep 6, 2018 at 1:49
• With the new form of evaluation that you suggested to me, I obtained a significant improvement in time, thank you very much for your help, sorry for the inconvenience that I generate to you. Commented Sep 6, 2018 at 17:31