Mathematica Asked on April 18, 2021
Divide the 14 elements {A, B, C, C, C, C, D, D, D, D, E, E, E, E}
into 7 groups (one group all have two elements), and I want to find out how many kinds of methods there are without repetition.
(Sort /@ Map[
Sort@# &, (Partition[#, 2] & /@
Permutations[{A, B, c, c, c, c, d, d, d, d, e, e, e,
e}]), {2}]) // DeleteDuplicates
The above code is very slow, I want to know how to use generating function to solve this problem?
GeneratingFunction
CycleIndexPolynomial
1*1*(1 + x + x^2/2 + x^3/3! + x^4/4!) (1 + x + x^2/2 + x^3/3! + x^4/
4!) (1 + x + x^2/2 + x^3/3! + x^4/4!) // ExpandAll
You could try the following code that produces elements each with 7 groups of ```{A, B, C, C, C, C, D, D, D, D, E, E, E, E}``
data = {"A", "B", "C", "C", "C", "C", "D", "D", "D", "D", "E", "E",
"E", "E"};
IntegerPartitions[Length[data], {7}];
Permutations /@ %;
Join @@ %;
Internal`PartitionRagged[data, #] & /@ %
This is based an answer from Mr.Wizard: Subsets of a list.
Answered by Ferca on April 18, 2021
This is not an answer to your modified request for a method that uses GeneratingFunction
but does address the title question about making the process more efficient.
Using your working code and because A
only occurs once there are many permutations that need to be generated but then tossed. And because the resulting 96 combinations must start with either {A,B}
, {A,c}
, {A,d}
, or {A,e}
, one can make your code more computationally efficient (although maybe not humanly more efficient as it takes time to write down the efficient code):
AB = Join[{{A, B}}, #] & /@ (Sort /@ Map[Sort@# &, (Partition[#, 2] & /@
Permutations[{c, c, c, c, d, d, d, d, e, e, e, e}]), {2}]) // DeleteDuplicates;
Ac = Join[{{A, c}}, #] & /@ (Sort /@ Map[Sort@# &, (Partition[#, 2] & /@
Permutations[{B, c, c, c, d, d, d, d, e, e, e, e}]), {2}]) // DeleteDuplicates;
Ad = Join[{{A, d}}, #] & /@ (Sort /@ Map[Sort@# &, (Partition[#, 2] & /@
Permutations[{B, c, c, c, c, d, d, d, e, e, e, e}]), {2}]) // DeleteDuplicates;
Ae = Join[{{A, e}}, #] & /@ (Sort /@ Map[Sort@# &, (Partition[#, 2] & /@
Permutations[{B, c, c, c, c, d, d, d, d, e, e, e}]), {2}]) // DeleteDuplicates;
results = Join[AB, Ac, Ad, Ae]
This takes around 4 seconds of computation time as opposed to around 80 seconds for the original code.
Answered by JimB on April 18, 2021
A feasible method(海洋之心):
set = {a, b, c, d, e};
f = Times @@
DeleteDuplicates[
Flatten[Table[1/(1 - set[[i]]*set[[j]]), {i, 1, 5}, {j, 1, 5}]]]
SeriesCoefficient[f, {a, 0, 1}, {b, 0, 1}, {c, 0, 4}, {d, 0, 4}, {e,
0, 4}]
But I don't understand the specific principle. I hope you can provide more detailed code and explanation.
Answered by A little mouse on the pampas on April 18, 2021
This (also) does not directly answer your question about using GeneratingFunction
but it is about 2,000 times faster than the original code and does generate all of the arrangements. This code is a bit slower to generate the number of arrangements compared to your answer using SeriesCoefficient
.
g[arrangement_, remaining_] := Module[{first, unique, newArrangements, r},
first = remaining[[1]];
unique = remaining[[2 ;;]] // DeleteDuplicates;
newArrangements = Join[arrangement, {{first, #}}] & /@ unique;
r = (Delete[remaining[[2 ;;]], Position[remaining[[2 ;;]], #, 1, 1][[1, 1]]]) & /@ unique;
{newArrangements, r}]
(* Initialize arrangements and remaining items to be assigned *)
arrangements = {};
remaining = {a, b, c, c, c, c, d, d, d, d, e, e, e, e};
(* First pair *)
results = g[arrangements, remaining];
arrangements = results[[1]];
remaining = results[[2]];
(* 2nd through 7th pairs *)
Do[
n = Length[arrangements];
a2 = {};
r2 = {};
Do[results = g[arrangements[[i]], remaining[[i]]];
a2 = Join[a2, results[[1]]];
r2 = Join[r2, results[[2]]],
{i, n}];
arrangements = a2;
remaining = r2,
{j, 2, 7}];
(* Remove duplicates *)
t = (Sort[#] & /@ arrangements) // DeleteDuplicates;
Length[t]
(* 96 *)
Answered by JimB on April 18, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP