4
$\begingroup$

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.

$\endgroup$
  • 2
    $\begingroup$ PowersRepresentations[#^2,3,2]&/@Range[50] seems like the right code, so what do you mean by "finish this task"? $\endgroup$ – Jason B. Sep 5 '18 at 1:26
  • $\begingroup$ there is also Reduce`SumOfSquaresReps[3, #^2] & but it is much slower than PowersRepresentations[#^2,3,2]& $\endgroup$ – kglr Sep 5 '18 at 1:27
  • $\begingroup$ @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 $\endgroup$ – bullitohappy Sep 5 '18 at 2:34
  • $\begingroup$ @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. $\endgroup$ – jkuczm Sep 20 '18 at 21:14
  • $\begingroup$ @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. $\endgroup$ – bullitohappy Sep 22 '18 at 4:10
7
$\begingroup$
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} *)
$\endgroup$
  • $\begingroup$ 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 $\endgroup$ – bullitohappy Sep 5 '18 at 23:33
  • $\begingroup$ 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 $\endgroup$ – Bob Hanlon Sep 6 '18 at 1:49
  • $\begingroup$ 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. $\endgroup$ – bullitohappy Sep 6 '18 at 17:31

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.