# Write any positive integer as a sum of squares

With n = 17 I would like to get

{4, 1}

and with n = 999

{31, 6, 1, 1}

so that, for example,

Total[#^2 & /@ {31, 6, 1, 1}]


gives

999

I don't want to get all possibilities, but only the shortest.

-

Module[{n = 1, results},
While[(results = Sqrt[IntegerPartitions[#, {n}, Range@Floor@Sqrt[#]^2]]) == {},
n++]; results] &[999]

(*
{{31, 6, 1, 1}, {31, 5, 3, 2}, {30, 9, 3, 3}, {30, 7, 7, 1}, {30, 7,
5, 5}, {29, 11, 6, 1}, {29, 10, 7, 3}, {27, 15, 6, 3}, {27, 14, 7,
5}, {27, 13, 10, 1}, {27, 11, 10, 7}, {26, 17, 5, 3}, {26, 15, 7,
7}, {26, 11, 11, 9}, {25, 19, 3, 2}, {25, 18, 7, 1}, {25, 18, 5,
5}, {25, 17, 9, 2}, {25, 17, 7, 6}, {25, 15, 10, 7}, {25, 14, 13,
3}, {25, 13, 13, 6}, {23, 21, 5, 2}, {23, 19, 10, 3}, {23, 18, 11,
5}, {23, 17, 10, 9}, {23, 15, 14, 7}, {22, 21, 7, 5}, {22, 17, 15,
1}, {22, 15, 13, 11}, {21, 21, 9, 6}, {21, 19, 14, 1}, {21, 18, 15,
3}, {21, 17, 13, 10}, {19, 19, 14, 9}, {19, 18, 17, 5}, {18, 15, 15,
15}, {17, 17, 15, 14}}
*)

Total /@ (%^2)

(*
{999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999,
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999,
999, 999, 999, 999, 999, 999, 999, 999, 999, 999, 999}
*)


Assuming you want the "smallest" termed of the "shortest", (and re-stealing from Sektor)...

With[{num = #},
Catch[If[(result = PowersRepresentations[num, #, 2]) !=  {},
Throw[Reverse@First@result]] & /@ Range@4]] &[999]


If the order (e.g., your OP has terms descending) does not matter, you can remove the Reverse@.

-
very nice, but I only want {31, 6, 1, 1} avoiding, if possible, all the other calculations (For me {31, 6, 1, 1} is the most "natural" form). – eldo Jun 22 '14 at 23:37
@eldo: You said "shortest". These are all the "shortest". If you want something else, clarify your question as to what your definition of "shortest" is. If it's the "smallest" total factors, just prepend First@ to either answer... – ciao Jun 22 '14 at 23:38
Extremely fast, plus I like the missing While. My only remaining question: Why Range@4 and not 3 or 5 ? – eldo Jun 23 '14 at 0:53
See e.g., Lagrange's four-square theorem... – ciao Jun 23 '14 at 0:54
already proved in 1770. I should go back in time or to school or delete the question. – eldo Jun 23 '14 at 2:44

Shamelessly stealing, but using a built-in function

Block[{n = 1, results},
While[(results = PowersRepresentations[#, n, 2]) == {}, n++];
results] &[999]

-
+1 - I'd completely forgotten that function. – ciao Jun 22 '14 at 23:46
:D You were a little faster, so I had to find another way to keep my edge – Sektor Jun 22 '14 at 23:56
f = Module[{n = 1, res}, While[(res = ReduceSumOfSquaresReps[n, #]) == {}, n++]; res]&;

f[17]
(* {{1, 4}} *)

f[999][[1]]
(* {1, 1, 6, 31}  *)

f[999]
(* {{1, 1, 6, 31}, {1, 6, 11, 29}, {1, 7, 7, 30}, {1, 7, 18, 25},
{1, 10,13, 27}, {1, 14, 19, 21}, {1, 15, 17, 22}, {2, 3, 5, 31},
{2, 3, 19, 25}, {2, 5, 21, 23}, {2, 9, 17, 25}, {3, 3, 9, 30},
{3, 5, 17, 26}, {3, 6, 15, 27}, {3, 7, 10, 29}, {3, 10, 19, 23},
{3, 13, 14, 25}, {3, 15, 18, 21}, {5, 5, 7, 30}, {5, 5, 18, 25},
{5, 7, 14, 27}, {5, 7, 21, 22}, {5, 11, 18, 23}, {5, 17, 18, 19},
{6, 7, 17, 25}, {6, 9, 21, 21}, {6, 13, 13, 25}, {7, 7, 15, 26},
{7, 10, 11, 27}, {7, 10, 15, 25}, {7, 14, 15, 23}, {9, 10, 17, 23},
{9, 11, 11, 26}, {9, 14, 19, 19}, {10, 13, 17, 21}, {11, 13, 15, 22},
{14, 15, 17, 17}, {15, 15, 15, 18}} *)

-
I suppose this is one of those (in)famous undocumented functions? When omitting the While ... n++ it becomes terribly slow. Excellent answer, though. – eldo Jun 23 '14 at 22:02

Here is another one:

squarePartition[n_] := squarePartition[n, 1, Table[k^2, {k, 1, Floor[Sqrt[n]]}]];
squarePartition[n_, l_, squares_] :=
Module[{result = IntegerPartitions[n, {l}, squares]},
Sqrt[First[result]] /; result =!= {}
];
squarePartition[n_, l_, squares_] := squarePartition[n, l + 1, squares];

squarePartition /@ {17, 999}
(* {{4, 1}, {31, 6, 1, 1}} *)

-
This gives (I think - depends on OP definition of "shortest') incorrect answer. E.g., for 10000000 it returns {3162, 41, 8, 3, 1, 1}, where in fact there are four representations using only two squares... – ciao Jun 22 '14 at 23:45
@rasher I haven't checked that and assumed it does the right thing. Now I have to iterate as you do through all different lengths :-( I tried to do it in pure functional style.. – halirutan Jun 23 '14 at 0:23
k = 1;
m[1] = 999;
While[m[k] =!= 0, n[k] = Floor@Sqrt[m[k]]; k = k + 1;
m[k] = m[k - 1] - (Floor@Sqrt[m[k - 1]])^2];
sol = n[#] & /@ Range[1, k - 1]

(* {31, 6, 1, 1}  *)
`
-