Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
add comment

5 Answers 5

up vote 5 down vote accepted
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@.

share|improve this answer
    
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 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... –  rasher Jun 22 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 at 0:53
1  
See e.g., Lagrange's four-square theorem... –  rasher Jun 23 at 0:54
    
already proved in 1770. I should go back in time or to school or delete the question. –  eldo Jun 23 at 2:44
show 1 more comment

Shamelessly stealing, but using a built-in function

Block[{n = 1, results}, 
       While[(results = PowersRepresentations[#, n, 2]) == {}, n++]; 
       results] &[999]
share|improve this answer
    
+1 - I'd completely forgotten that function. –  rasher Jun 22 at 23:46
1  
:D You were a little faster, so I had to find another way to keep my edge –  Sektor Jun 22 at 23:56
add comment
f = Module[{n = 1, res}, While[(res = Reduce`SumOfSquaresReps[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}} *)
share|improve this answer
    
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 at 22:02
add comment

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}} *)
share|improve this answer
    
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... –  rasher Jun 22 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 at 0:23
add comment
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}  *)
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.