4
$\begingroup$

Legendre's three-square theorem states that

$n=a^{2}+b^{2}+c^{2}$

if and only if $n$ is not of the form $n = 4^a(8b + 7)$ for integers $a$ and $b$.

There are numbers like 54 which can be represented as the sum of three perfect squares in two different ways:

$1^2+2^2+7^2\\ 3^2+3^2+6^2$

I would really appreciate if someone could guide me through the code so that I could find the next number.

$\endgroup$
5
$\begingroup$
f[n_] := Block[{sol}, 
  sol = FindInstance[
    n == a^2 + b^2 + c^2 && a > 0 && b > 0 && c > 0, {a, b, c}, 
    Integers, 10];
  If[sol == {}, {}, 
   If[Length@DeleteDuplicates@(Sort /@ ({a, b, c} /. sol)) < 3, {}, 
    DeleteDuplicates@(Sort /@ ({a, b, c} /. sol))]]]

i = 167;
While[f[i] == {}, i++]
i
f[i]

171

{{3, 9, 9}, {1, 7, 11}, {1, 1, 13}, {5, 5, 11}}


t = Join[##] & @@@ 
  Select[Table[{{i}, f[i]}, {i, 167, 300}] /. {{} -> Nothing[]}, 
   Length@# > 1 &];

TableForm[t, TableDepth -> 2]

enter image description here

$\endgroup$
5
$\begingroup$

IntegerPartitions works well for numbers of reasonable size, where "reasonable" depends on your computing resources.

SumOfThreeSquares[n_Integer] := 
   Sqrt[IntegerPartitions[n, {3}, Range[Sqrt[n]]^2]]

SetAttributes[SumOfThreeSquares, Listable]

As in:

SumOfThreeSquares[166]
(* {{11, 6, 3}, {9, 9, 2}, {9, 7, 6}} *)

Find numbers up to 200 which are the sum of three squares in exactly three different ways:

With[{n = Range[200]},
   Pick[n, Map[Length, SumOfThreeSquares[n]], 3]]

(* {54, 66, 81, 86, 89, 99, 101, 110, 114, 126, 131, 149, 150, 162, 166,
    173, 174, 179, 182, 185, 186} *)
$\endgroup$
4
$\begingroup$

Here's a brute force method that generates all distinct 3-tuples up to some aMax, groups them into an association based on the value a^2+b^2+c^2 and selects those keys with three or more tuples matching the requirement:

aMax=12;
distinctTuples=DeleteDuplicates[Sort/@Tuples[Range[aMax],3]];
groupedTuples=GroupBy[distinctTuples,Total[#^2]&];
ans=Select[groupedTuples,Length[#]>=3&];

TableForm@Normal@KeySort@ans

enter image description here

$\endgroup$
4
$\begingroup$

Here's another way to pick out integers that are the sum of exactly three squares:

Select[Table[{k, Select[PowersRepresentations[k, 3, 2], FreeQ[#, 0] &]},
             {k, 101, 200}], Length[Last[#]] == 3 &]
   {{101, {{1, 6, 8}, {2, 4, 9}, {4, 6, 7}}}, {110, {{1, 3, 10}, {2, 5, 9}, {5, 6, 7}}},
    {114, {{1, 7, 8}, {4, 7, 7}, {5, 5, 8}}}, {126, {{1, 2, 11}, {1, 5, 10}, {3, 6, 9}}},
    {131, {{1, 3, 11}, {1, 7, 9}, {5, 5, 9}}}, {149, {{1, 2, 12}, {2, 8, 9}, {6, 7, 8}}},
    {150, {{1, 7, 10}, {2, 5, 11}, {5, 5, 10}}},
    {162, {{3, 3, 12}, {4, 5, 11}, {7, 7, 8}}},
    {166, {{2, 9, 9}, {3, 6, 11}, {6, 7, 9}}},
    {173, {{2, 5, 12}, {3, 8, 10}, {4, 6, 11}}},
    {174, {{1, 2, 13}, {2, 7, 11}, {5, 7, 10}}},
    {179, {{1, 3, 13}, {3, 7, 11}, {7, 7, 9}}},
    {182, {{1, 9, 10}, {2, 3, 13}, {5, 6, 11}}},
    {185, {{2, 9, 10}, {4, 5, 12}, {6, 7, 10}}},
    {186, {{1, 4, 13}, {1, 8, 11}, {4, 7, 11}}}}
$\endgroup$

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.