# Finding permuations in a specific order

I would like to find the following permutations, but need an elegant way of computing it. Ideally I would like to have a variable determine the highest number in the last element and find all combinations like so:

Permutations[{1, 1, 1}]
Permutations[{1, 1, 2}]
Permutations[{1, 2, 2}]
Permutations[{2, 2, 2}]
Permutations[{1, 1, 3}]
Permutations[{1, 2, 3}]
Permutations[{2, 2, 3}]
Permutations[{2, 3, 3}]
Permutations[{3, 3, 3}]
Permutations[{1, 1, 4}]
Permutations[{1, 2, 4}]
Permutations[{2, 2, 4}]
Permutations[{2, 3, 4}]
Permutations[{3, 3, 4}]
Permutations[{3, 4, 4}]
Permutations[{4, 4, 4}]
...


I have searched the documentation and can't seem to piece together what I might need. Any help would be appreciated.

EDIT: What I am trying to achieve ultimately is forming a list that has all of the permutations above like so:

{{1,1,1},{1,1,2},{1,2,2},...,{3,3,3},...{3,3,4}}


Then for each 3-tuple in that list I would like to sum the square of each element. Moreover I would like to sort the square of each element in ascending order. If you were to take each of the above permutations and find the sum of the elements squared you would see very quickly that there are groups of the same output. I would like to group those outputs in ascending order. This has an application to finding the degenerate energy levels for the 3-D Schrodinger equation.

To elaborate I will use an example of my desired output:

Permutations[{1, 1, 1}] = {{1, 1, 1}}
Permutations[{1, 1, 2}] = {{1, 1, 2}, {1, 2, 1}, {2, 1, 1}}
Permutations[{1, 1, 2}]= {{1, 2, 2}, {2, 1, 2}, {2, 2, 1}}
...
Permutations[{1, 2, 3}] = {{1, 2, 3}, {1, 3, 2}, {2, 1, 3}, {2, 3, 1}, {3, 1, 2}, {3, 2, 1}}
...
Permutations[{n, n, n}] = {...}


In the process I would like one big list with each of the above output, then I access the big list and square the elements of each 3-tuple.

EDIT 2: Using Wouter's answer the following achieves printing all the desired permutations.

n = 3;
L = {};
S = Flatten[Table[{k, j, i}, {i, n}, {j, i}, {k, j}], 2];
For[i = 1, i <= Length[S], i++,
AppendTo[L, Permutations[Part[S, i]]]
]
For[i = 1, i <= Length[L], i++,
Print[Part[L, i]]
]


Now I want to apply my desired outcome in my first edit to this. This just feels like clunky code. Is there a more elegant way?

EDIT 3: The desired output:

1 1 1    3

1 1 2    6
1 2 1    6
2 1 1    6

1 2 2    9
2 1 2    9
2 2 1    9
...

• It is very unclear to me what you want to achieve, can you give an example of the results that you want to create? The command permutations shall be executed with arrays that are to created? Commented Jan 15, 2015 at 8:05
• @Philipp see my edit please. Commented Jan 15, 2015 at 15:09
• Sorry, I cannot understand yet. Can you explain what goes in and what should result. Commented Jan 15, 2015 at 15:23
• What goes in is n and out comes the Permutations above, up to Permutations[{n,n,n}] starting from Permutations[{1,1,1}] in the order of my original post. Commented Jan 15, 2015 at 15:25
• Maybe edit 2 helps? Commented Jan 15, 2015 at 15:33

s[n_] := Flatten[Table[{k, j, i}, {i, n}, {j, i}, {k, j}], 2];
list[nValue_] := Module[{stemp},
stemp = s[nValue];
Table[Permutations[Part[stemp, i]], {i, 1, Length[stemp]}]
]


Now

list[3]


{{{1, 1, 1}}, {{1, 1, 2}, {1, 2, 1}, {2, 1, 1}}, {{1, 2, 2}, {2, 1, 2}, {2, 2, 1}}, {{2, 2, 2}}, {{1, 1, 3}, {1, 3, 1}, {3, 1, 1}}, {{1, 2, 3}, {1, 3, 2}, {2, 1, 3}, {2, 3, 1}, {3, 1, 2}, {3, 2,    1}}, {{2, 2, 3}, {2, 3, 2}, {3, 2, 2}}, {{1, 3, 3}, {3, 1, 3}, {3,    3, 1}}, {{2, 3, 3}, {3, 2, 3}, {3, 3, 2}}, {{3, 3, 3}}}


With TableForm we obtain a nicer structure

Some things to note:

• dont use variable or function names with capital starting letters to avoid trouble with built-in functions of Mathematica
• Use Map, Thread, Apply, Table or alike and avoid loops as much as you can.
• I used Module to evaluate s[n] just once to increase efficiency

Edit:

Maybe I understand. This summing and squaring should be like this:

res = Total[#^2] & /@ Flatten[list[3], 1]
{3, 6, 6, 6, 9, 9, 9, 12, 11, 11, 11, 14, 14, 14, 14, 14, 14, 17, 17, 17, 19, 19, 19, 22, 22, 22, 27}


Maybe you want to know the count of each total, then you go:

{#, Count[ok, #]} & /@ DeleteDuplicates[ok]


{{3, 1}, {6, 3}, {9, 3}, {12, 1}, {11, 3}, {14, 6}, {17, 3}, {19, 3}, {22, 3}, {27, 1}}

BarChart[%[[All, 2]], ChartLabels -> %[[All, 1]]]


As Wouter said, you can have it easier without permutations as the sum doesnt change. But when you want the sum besides the permutations you can go

{#,Total[#^2] & /@ Flatten[list[3], 1]}

• Thank you for the explanation. I would now like to sum the squares of each {a, b, c} in the list and print. For example, {1, 1, 2} is 1^2 + 1^2 +2^2 = 6 Commented Jan 15, 2015 at 16:26
• The edit is nice. In my third edit I show what I want. Which is what you have achieved. Thank you for the help! Commented Jan 15, 2015 at 16:54
• Is there any way to show the permutations that go along with the squares? Commented Jan 15, 2015 at 17:03

it looks like Flatten[Table[{k, j, i}, {i, 4}, {j, i}, {k, j}], 2] but I'm a poor mind reader.

Output:

{{1, 1, 1}, {1, 1, 2}, {1, 2, 2}, {2, 2, 2}, {1, 1, 3},
{1, 2, 3}, {2, 2, 3}, {1, 3, 3}, {2, 3, 3}, {3, 3, 3},
{1, 1, 4}, {1, 2, 4}, {2, 2, 4}, {1, 3, 4}, {2, 3, 4},
{3, 3, 4}, {1, 4, 4}, {2, 4, 4}, {3, 4, 4}, {4, 4, 4}}

• Can you add details explaining why this answers the question at hand ? Not everyone will execute your code trying to figure out what is going on Commented Jan 15, 2015 at 13:19
• This give me what I would like to input into the Permutations command. Will looping over this list and applying Permutations  be the best approach? My initial question was a bit unclear. I have edited it and ,hopefully, it is more clear what I want. Commented Jan 15, 2015 at 15:18
• If you want to add the squares of all permuted triplets, then why permute them? Just do it once and multiply the result by w = the number of permutations (w= 1, 3 or 6). Commented Jan 15, 2015 at 16:38
• @Wouter I want to explicitly show the sum and square of each permutation. Commented Jan 15, 2015 at 18:32
n = 4;

tuples = Sort /@ Tuples[Range[1, n], {3}] // DeleteDuplicates

perms = Permutations /@ tuples // Flatten[#, 1]&

out = {#, Total[#^2]} & /@ perms // SortBy[#, #[[2]] &]&

TableForm[#, TableDepth -> 3]& @ Partition[out, 8, 8]