1
$\begingroup$

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

3 Answers 3

1
$\begingroup$

Without fully understanding your question I want to answer this:

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] 

yields your result:

{{{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]]]

enter image description here

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]}
$\endgroup$
3
  • $\begingroup$ 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 $\endgroup$
    – arynhard
    Jan 15, 2015 at 16:26
  • $\begingroup$ The edit is nice. In my third edit I show what I want. Which is what you have achieved. Thank you for the help! $\endgroup$
    – arynhard
    Jan 15, 2015 at 16:54
  • $\begingroup$ Is there any way to show the permutations that go along with the squares? $\endgroup$
    – arynhard
    Jan 15, 2015 at 17:03
2
$\begingroup$

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}}
$\endgroup$
4
  • $\begingroup$ 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 $\endgroup$
    – Sektor
    Jan 15, 2015 at 13:19
  • $\begingroup$ 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. $\endgroup$
    – arynhard
    Jan 15, 2015 at 15:18
  • $\begingroup$ 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). $\endgroup$
    – Wouter
    Jan 15, 2015 at 16:38
  • $\begingroup$ @Wouter I want to explicitly show the sum and square of each permutation. $\endgroup$
    – arynhard
    Jan 15, 2015 at 18:32
0
$\begingroup$
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]

enter image description here

$\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.