Skip to main content
added 106 characters in body
Source Link
Michael Seifert
  • 15.3k
  • 35
  • 72

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
{distelements, counts} = DeleteDuplicates[list]Transpose[Tally[list]]
(* { {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} } *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

To see how this scales, I ran this code on a set of 100 randomly-chosen letters of the alphabet (26 distinct elements), with n=7. Mathematica took about 20–30 minutes to return a list of ~3 million subsets on my not-that-powerful laptop.

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
distelements = DeleteDuplicates[list]
(* {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

To see how this scales, I ran this code on a set of 100 randomly-chosen letters of the alphabet (26 distinct elements), with n=7. Mathematica took about 20–30 minutes to return a list of ~3 million subsets on my not-that-powerful laptop.

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
{distelements, counts} = Transpose[Tally[list]]
(* { {a, b, c}, {2, 1, 3} } *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

To see how this scales, I ran this code on a set of 100 randomly-chosen letters of the alphabet (26 distinct elements), with n=7. Mathematica took about 20–30 minutes to return a list of ~3 million subsets on my not-that-powerful laptop.

added 106 characters in body
Source Link
Michael Seifert
  • 15.3k
  • 35
  • 72

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
distelements = DeleteDuplicates[list]
(* {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

To see how this scales, I suspect thatran this idea may not scale well to your problemcode on a set of 100 randomly-chosen letters of the alphabet (26 distinct elements), but it was fun to play around with n=7. Mathematica took about 20–30 minutes to return a list of ~3 million subsets on my not-that-powerful laptop.

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
distelements = DeleteDuplicates[list]
(* {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

I suspect that this idea may not scale well to your problem, but it was fun to play around with.

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
distelements = DeleteDuplicates[list]
(* {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

To see how this scales, I ran this code on a set of 100 randomly-chosen letters of the alphabet (26 distinct elements), with n=7. Mathematica took about 20–30 minutes to return a list of ~3 million subsets on my not-that-powerful laptop.

Source Link
Michael Seifert
  • 15.3k
  • 35
  • 72

An approach based on linear integer programming:

We are given a list of the form $\{a,a,b,c,c,c\}$, and a desired length of resulting multiplets $n$. Generate the list of distinct elements $q_i$ and their multiplicities $m_i$. Then solve the constrained system of equations $$ \sum x_i = n \\ 0 \leq x_i \leq m_i $$ for the $x_i$ over the integers. Each of the resulting solutions for the variables $\{x_i\}$ will be correspond to a multiplet of the appropriate length, where the value of $x_i$ in each solution corresponds to the multiplicity of the element $q_i$ in that multiplet.

n = 3;
list = {a, a, b, c, c, c, c};

(* Create list of distinct elements *)
distelements = DeleteDuplicates[list]
(* {a, b, c} *)

(* Count multiplicity of each distinct element *)
counts = Count[list, #] & /@ distelements
(* {2, 1, 3} *)

(* Create list of dummy variables x_i *)
variables = Array[x, {Length[distelements]}];

(* Open up a can of linear programming *)
soln = soln = variables /. 
  Solve[Join[{Total[variables] == n}, 
    Thread[0 <= variables <= counts]], variables, Integers]
(* {{0, 0, 3}, {0, 1, 2}, {1, 0, 2}, {1, 1, 1}, {2, 0, 1}, {2, 1, 0}} *)

(* Extract the solutions *)
Flatten[Table[ConstantArray[distelements[[i]], #[[i]]], {i, 1, 
     Length[distelements]}]] & /@ soln
(* {{c, c, c}, {b, c, c}, {a, c, c}, {a, b, c}, {a, a, c}, {a, a, b}} *)

I suspect that this idea may not scale well to your problem, but it was fun to play around with.