# 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? – Philipp Jan 15 '15 at 8:05
• @Philipp see my edit please. – arynhard Jan 15 '15 at 15:09
• Sorry, I cannot understand yet. Can you explain what goes in and what should result. – Philipp Jan 15 '15 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. – arynhard Jan 15 '15 at 15:25
• Maybe edit 2 helps? – arynhard Jan 15 '15 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


{{{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, 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, 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 – arynhard Jan 15 '15 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! – arynhard Jan 15 '15 at 16:54
• Is there any way to show the permutations that go along with the squares? – arynhard Jan 15 '15 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 – Sektor Jan 15 '15 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. – arynhard Jan 15 '15 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). – Wouter Jan 15 '15 at 16:38
• @Wouter I want to explicitly show the sum and square of each permutation. – arynhard Jan 15 '15 at 18:32
n = 4;

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

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

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

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