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.

I have a function that generates lists:

f[n_] := Join @@ Permutations /@ PadLeft@IntegerPartitions[n];

For example

f[3]
{{0, 0, 3}, {0, 3, 0}, {3, 0, 0}, {0, 2, 1}, {0, 1, 2}, 
 {2, 0, 1}, {2, 1, 0}, {1, 0, 2}, {1, 2, 0}, {1, 1, 1}}

f[3] returns 10 lists of three elements, which I want to classify this according to certain laws;

{0, 0, 3}, {0, 3, 0} and {3, 0, 0} belong one class with 3 members because RotateLeft can transform any one of these into any of the others.

Similarly, {0,1,2}, {1,2,0} and {2,0,1} belong one class with 3 members.

{0, 2, 1}, {2, 1, 0} and {1, 0, 2} belong one class with 3 members.

{1, 1, 1} belongs to a class of which it is the only member.

So the result I want is

enter image description here

I have code that will generate the desired result

m = AbsoluteTime[];
f[n_Integer] := Join @@ Permutations /@ PadLeft@IntegerPartitions[n];
f2[list_] := Module[{n = 1, m = 0},
  While[n <= Length[data1], 
   If[Or @@ (SameQ[data1[[n, 1]], #] & /@ 
       NestList[RotateLeft, list, Length[list] - 1]), data1[[n, 2]]++;
     m++; Break[]];
   n++];
  If[m == 0, AppendTo[data1, {list, 1}]]]
data1 = {{First@f[7], 1}};
f2 /@ Drop[f[7], 1];
Length[f[7]]
data1 // Length
AbsoluteTime[] - m

but it's too slow. When n = 7, it takes about 11 seconds, but I want to work with n is the range from 14 to 20. how can I improve efficiency the efficiency of my code?

share|improve this question
    
Notice, that there is unscoped data1 in f2 definition. –  Kuba Oct 25 '13 at 8:59
add comment

1 Answer

up vote 4 down vote accepted

I believe I'm missing some basic function that can easily reproduce the test here. But that's a detail, the main thing is to use Tally with the second argument specification:

test[x_List] := Sort@Array[RotateLeft[x, #] &, Length[x]]

Tally[f[3], test[#1] == test[#2] &] // MatrixForm

$\left( \begin{array}{cc} \{0,0,3\} & 3 \\ \{0,2,1\} & 3 \\ \{0,1,2\} & 3 \\ \{1,1,1\} & 1 \\ \end{array} \right)$

It's not the optimal way, for n = 10 it takes about 5 sec on my old pc. I will think about improvements.

share|improve this answer
    
@user10193 Please hold on with an accept a little, it is a good habit in order to not discourage others. I'm 100% sure that better answers will appear here. :) –  Kuba Oct 25 '13 at 8:57
    
Tkx very much.I considered about tally but I just know use Tally[list] but Tally[list, test].so thank you. –  Chenminqi Oct 25 '13 at 9:01
    
@Kuba do you mean First@Sort in test? Now you end up comparing lists of lists, whereas you only need to compare one representative. I agree there should probably be some trick to do this step :) –  Jacob Akkerboom Oct 25 '13 at 10:58
    
@JacobAkkerboom No I didn't, but good idea with First it may help with long lists. I was thinking about something like built in testing if two lists are related with an odd/even permutation. But I must admit my math skils are not existant in this area. I don't even know if what I'm thinking about is called even permutation in english :). I was trying to avoid to many Sorting with MemberQ[test[#],#2]& as the second argument but it seems it is longer. –  Kuba Oct 25 '13 at 11:10
    
@Kuba it is an interesting problem. Odd/even permutations are a big thing, so its probably the right word ;). If you can tackle it like that I'd be curious. For me the main problem becomes finding that the "lowest subsequence" of length 3 of {0,1,2,0,0,3} is {0,0,3} and not {0,1,2}. Hrm :P –  Jacob Akkerboom Oct 25 '13 at 11:38
show 4 more comments

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.