# Fast way to apply permutations in large list?

I have one Polynomial in the form of FF[x1,x2,x3,x4,x5,x6,x7,x8], where xi pick numbers from {0,1,2,3,4,5,6} and every number has to be appeared in even-numbered times.

For example FF[0, 0, 4, 4, 0, 0, 4, 4] is good term we want and FF[0, 0, 4, 2, 2, 3, 4, 4] is not (because numbers 3 and 4 all appear in odd times).

Assume one Polynomial Poly1 as following (it can be even larger which can be obtain from my early posted question):

Poly1 = FF[0, 0, 0, 0, 0, 0, 0, 0] + FF[0, 0, 0, 0, 1, 1, 1, 1] +
FF[0, 0, 0, 0, 2, 2, 2, 2] + FF[0, 0, 3, 3, 0, 0, 3, 3] +
FF[0, 0, 3, 5, 2, 5, 3, 2] + FF[0, 0, 3, 6, 6, 1, 3, 1] +
FF[0, 0, 4, 4, 0, 0, 4, 4] + FF[0, 0, 4, 5, 1, 5, 1, 4] +
FF[0, 0, 4, 6, 6, 2, 2, 4] + FF[0, 0, 5, 3, 5, 2, 2, 3] +
FF[0, 0, 5, 4, 5, 1, 4, 1] + FF[0, 0, 5, 5, 5, 5, 0, 0] +
FF[0, 0, 6, 3, 1, 6, 1, 3] + FF[0, 0, 6, 4, 2, 6, 4, 2] +
FF[0, 0, 6, 6, 6, 6, 0, 0] + FF[1, 1, 1, 1, 0, 0, 0, 0] +
FF[1, 1, 1, 1, 1, 1, 1, 1] + FF[1, 1, 1, 1, 2, 2, 2, 2] +
FF[1, 3, 1, 3, 1, 3, 1, 3] + FF[1, 3, 1, 4, 2, 3, 4, 2] +
FF[1, 3, 1, 6, 6, 3, 0, 0] + FF[1, 4, 1, 3, 4, 2, 2, 3] +
FF[1, 4, 1, 4, 4, 1, 4, 1] + FF[1, 4, 1, 5, 4, 5, 0, 0] +
FF[1, 5, 1, 4, 0, 0, 4, 5] + FF[1, 5, 1, 5, 1, 5, 1, 5] +
FF[1, 5, 1, 6, 6, 2, 2, 5] + FF[1, 6, 1, 3, 0, 0, 6, 3] +
FF[1, 6, 1, 5, 2, 5, 6, 2] + FF[1, 6, 1, 6, 6, 1, 6, 1] +
FF[2, 2, 2, 2, 0, 0, 0, 0] + FF[2, 2, 2, 2, 1, 1, 1, 1] +
FF[2, 2, 2, 2, 2, 2, 2, 2] + FF[2, 3, 3, 2, 2, 3, 3, 2] +
FF[2, 3, 4, 2, 1, 3, 1, 4] + FF[2, 3, 5, 2, 5, 3, 0, 0] +
FF[2, 4, 3, 2, 4, 1, 3, 1] + FF[2, 4, 4, 2, 4, 2, 2, 4] +
FF[2, 4, 6, 2, 4, 6, 0, 0];


I assume there are Nn=6240 different Polynomials as in the form of Poly1. For simplicity, here I just make a loop to create such huge Polys as following:

Polys={};
Nn=6000;
For[iii= 1, iii<= Nn, iii++,AppendTo[Polys, Poly1];];


Then I want to permute the number sequence in the FF[x1,x2,x3,x4,x5,x6,x7,x8] with replacements such as PermutNum={0->0, 1->1, 2->6, 3->2, 4->4, 5->5, 6->3}. That means FF[0, 0, 6, 3, 1, 6, 1, 3] will become FF[0, 0, 3, 2, 1, 3, 1, 2] after the replacement PermutNum.

For testing: we use the following code just for one time replacement:

Numlist = Range[0, 6];
PermutNumList= Permutations[Numlist];
PolysPermut={};
ReplaceCase=40; (*randomly chose one for test 1~5040*)

Timing[
PermutNum= {};
For[kkk = 1, kkk <= Length[Numlist], kkk++,
AppendTo[PermutNum, Numlist[[kkk]] -> PermutNumList[[ReplaceCase]][[kkk]]];
];

AppendTo[PolysPermut, Polys/.PermutNum];
]



The time is {0.671875, Null} just for once testing.

There will be Length[Permutations[Range[0, 6]]]=5040 replacements in total, then I apply each PermutNum to the huge Polys as following way:

Numlist = Range[0, 6];
PermutNumList= Permutations[Numlist];
PolysPermut={};

For[jj = 1, jj <= Length[PermutNumList], jj++,

(*create current replacement PermutNum*)
PermutNum= {};
For[kkk = 1, kkk <= Length[Numlist], kkk++,
AppendTo[PermutNum, Numlist[[kkk]] -> PermutNumList[[jj]][[kkk]]];
];

AppendTo[PolysPermut, Polys/.PermutNum];

]


The estimated time i assumed it will be roughly 56mins.

So is there any good solution or suggestions to speed up such situation? Any comments or suggestions are appreciated! Thank you very much!

• I didn't look into this too much, but Timing[PolysPermut = Replace[Polys, Dispatch@Thread[Numlist -> #], {3}] & /@ PermutNumList[[{40}]];] is around 3 times faster on my system - the main speedup comes from Dispatch and Replace (with {3} to only replace on the relevant level of the expression). But probably this can be improved even further. For example: Could you somehow directly generate the permuted versions instead of having to do search-and-replace? Apr 21, 2020 at 9:12
• @LukasLang, oh, I don't know Dispatchexists, thanks. Well, in my case is I have in advance a large list with the numbers for xi randomly in the FF[x1,x2,x3,x4,x5,x6,x7,x8]. Then I make the permutations and I am not sure how to merge them together. But good point, I will think a bit. Thank you! Apr 21, 2020 at 9:19
• @LukasLang, as an example: tt = FF[2, 2, 0, 0, 0, 0, 0, 0];; PermutNumList[[{ReplaceCase}]] ={{0, 1, 4, 3, 6, 5, 2}}; yy=Replace[tt, Dispatch@Thread[Numlist -> #], {3}] & /@ PermutNumList[[{ReplaceCase}]] ; the yy is {FF[2, 2, 0, 0, 0, 0, 0, 0]} not {FF[4, 4, 0, 0, 0, 0, 0, 0]}. Seems that the replacement doesn't work. So did I miss any thing in your answer? Thank you very much! Apr 21, 2020 at 16:01
• @LukasLang, probably should not use Replace but ReplaceAll? Apr 21, 2020 at 16:27
• Sorry, I missed your other comment - as noted, the Replace[...,{3}] style replacement will only work for expressions of the form FF[...] + FF[...] - for more general expressions, you do in fact need to use ReplaceAll[...] instead. You could e.g. use Replace[...,{2,3}] if you want to cover both sums of FF[...] and FF[...] alone, but I'm not sure what the performance gains are at that point. Apr 22, 2020 at 16:26