Pythagorean quadruples

Question

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"? — Jason B., Sep 05 '18 at 01:26
there is also Reduce`SumOfSquaresReps[3, #^2] & but it is much slower than PowersRepresentations[#^2,3,2]& — kglr, Sep 05 '18 at 01: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 — bullitohappy, Sep 05 '18 at 02: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. — jkuczm, Sep 20 '18 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. — bullitohappy, Sep 22 '18 at 04:10

Bob Hanlon · Accepted Answer · 2018-09-05T03:47:34.360

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 — bullitohappy, Sep 05 '18 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 — Bob Hanlon, Sep 06 '18 at 01: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. — bullitohappy, Sep 06 '18 at 17:31

Pythagorean quadruples

1 Answers1

Linked