Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

Given variables x[i] for i=1,2,...,n I would like to create a list of all possible multivariate monomials of order m. Most conveniently I'd like to have a function monList[vars_,order_] such that for example:

m=2;
myvar={x[1],x[2]};
monList[myvar,m]

{1, x[1], x[2], x[1]^2, x[1]x[2], x[2]^2}

It should also work properly with m>2 and/or more than two variables x[i]. Is there a function in Mathematica that accomplishes the above? If not, can it be implemented efficiently? Thanks for any suggestion!

share|improve this question
up vote 9 down vote accepted

FrobeniusSolve[] is a very convenient function for this task:

monomialList[vars_List, m_Integer?NonNegative] := 
        Flatten[Map[Apply[Times, vars^#] &, 
                    Table[FrobeniusSolve[ConstantArray[1, Length[vars]], k],
                          {k, 0, m}], {2}]]

A demonstration:

monomialList[{x, y, z, w}, 3]
   {1, w, z, y, x, w^2, w z, z^2, w y, y z, y^2, w x, x z, x y, x^2, w^3, w^2 z,
    w z^2, z^3, w^2 y, w y z, y z^2, w y^2, y^2 z, y^3, w^2 x, w x z, x z^2, w x y,
    x y z, x y^2, w x^2, x^2 z, x^2 y, x^3}

A variation using Inner[]:

monomialList[vars_List, m_Integer?NonNegative] := 
      Flatten[Inner[#2^#1 &, #, vars, Times] & /@ 
              Table[FrobeniusSolve[ConstantArray[1, Length[vars]], k], {k, 0, m}]]
share|improve this answer
    
The function FrobeniusSolve[] is interesting indeed. Unfortunately, timeAvg[monomialList[{x[1], x[2], x[3]}, 4]] returns 0.015000 while my rather trivial implementation below has timeAvg[monList[{x[1], x[2], x[3]}, 4]] of 0.000825. – Kagaratsch Feb 17 at 19:43
    
Oh, nevermind! at monomialList[{x[1], x[2], x[3], x[4], x[5]}, 30] your function takes over and becomes two times faster than mine! Thank you! – Kagaratsch Feb 17 at 19:46

This is pretty fast.

allMonoms[n_, deg_, x_] := 
 List @@ Expand[(1 + Total[Array[x, n]])^deg] /. 
  j_Integer*monom : _ :> monom

Quick example:

allMonoms[3, 4, x]

(* Out[89]= {1, x[1], x[1]^2, x[1]^3, x[1]^4, x[2], x[1] x[2], 
 x[1]^2 x[2], x[1]^3 x[2], x[2]^2, x[1] x[2]^2, x[1]^2 x[2]^2, x[2]^3,
  x[1] x[2]^3, x[2]^4, x[3], x[1] x[3], x[1]^2 x[3], x[1]^3 x[3], 
 x[2] x[3], x[1] x[2] x[3], x[1]^2 x[2] x[3], x[2]^2 x[3], 
 x[1] x[2]^2 x[3], x[2]^3 x[3], x[3]^2, x[1] x[3]^2, x[1]^2 x[3]^2, 
 x[2] x[3]^2, x[1] x[2] x[3]^2, x[2]^2 x[3]^2, x[3]^3, x[1] x[3]^3, 
 x[2] x[3]^3, x[3]^4} *)

Here is a timing test.

Timing[mtab = Table[allMonoms[n, d, x], {n, 7}, {d, 14}];]

(* Out[88]= {1.974403, Null} *)
share|improve this answer

To be constructive, here is my own attempt at creating this function:

monList[vars_, order_] := Module[{tmp, tmpsub},
  tmp = MonomialList[Sum[(vars /. List -> Plus)^i, {i, 0, order}] // Expand, vars];
  tmpsub = Table[vars[[i]] -> 1, {i, 1, Length[vars]}];
  tmp/(tmp /. tmpsub)
]

However, I suspect that the above will become very slow for large orders and when many variables are involved.

share|improve this answer

Here's something very fast:

monoms = Function[{vars, degree}, 
  Times @@@ (vars^# & /@ 
     Flatten[Permutations /@ PadRight[#, {Length@#, Length[vars]}] &[
       Flatten[IntegerPartitions[#, Length[vars]] & /@ Range[0, degree], 
        1]], 1])]

monoms[{x, y, z}, 4]
(* {1, x, y, z, x^2, y^2, z^2, x y, x z, y z, x^3, y^3, z^3, x^2 y, 
 x^2 z, x y^2, x z^2, y^2 z, y z^2, x y z, x^4, y^4, z^4, x^3 y, 
 x^3 z, x y^3, x z^3, y^3 z, y z^3, x^2 y^2, x^2 z^2, y^2 z^2, 
 x^2 y z, x y^2 z, x y z^2} *)

monoms[{x,y,z,q,v},30];//Timing
(* {3.35402, Null} *)

The above code is quite fast, but not quite optimal. There's certainly room for improvement. At first I thought, that generating the list of exponents for the variables can be improved, because

explist = Function[{vars, degree}, 
  Flatten[Permutations /@ PadRight[#, {Length@#, Length[vars]}] &[
   Flatten[IntegerPartitions[#, Length[vars]] & /@ Range[0, degree], 1]], 1]]

generates a rectangular array of integers. Perhaps a compilable version, that creates a packed array could have been coded. This is however not the case, as this is already quite fast and takes a minor part of the total computation time. Also, the array would need to be unpacked in the end anyhow. However I can take advantage of the listability of Power:

monoms2 = 
 Function[{vars, degree}, 
  With[{explist = 
     Flatten[Permutations /@ PadRight[#, {Length@#, Length[vars]}] &[
        Flatten[IntegerPartitions[#, Length[vars]] & /@ 
          Range[0, degree], 1]], 1] // Transpose}, 
   Times @@@ Transpose[vars^explist]]]

Timing initially showed a 25% increase, but on further tests the speed-up is not so dramatic.

Time for some benchmarking! - (timings differ, as I'm doing this on a different machine, than last night).

For the record, here's generating the list of exponents, and how it chokes on converting this to an array of symbols:

explist[{x, y, z, q, v}, 30]; // Timing
(* {0.0936006, Null} *)

explist[{x, y, z, q, v}, 30];
(* Null *)
Transpose[{x, y, z, q, v}^Transpose[%]]; // Timing
(* {0.624004, Null} *)

explist[{x, y, z, q, v}, 30];
(* Null *)
Transpose[{x, y, z, q, v}^Transpose[%]];
(* Null *)
Times @@@ %; // Timing
(* {0.764405, Null} *)

And here are the timings for all functions:

monoms[{x, y, z, q, v}, 30]; // RepeatedTiming
(* {1.91, Null} *)

monoms2[{x, y, z, q, v}, 30]; // RepeatedTiming
(* {1.81, Null} *) (* turns out, it isn't so much faster *)

Heeding the warning of @Kagaratsch I didn't risk running @Bob Hanlon's monomialList for such large input and tried a more modest

monomialList[{x, y, z, q}, 10]; // Timing
(* {8.06525, Null} *)

Kagaratsch's implementation is actually not too bad:

monList[{x, y, z, q, v}, 30]; // Timing
(* {9.90606, Null} *)

Daniel Lichtblau has a very smart approach, manipulating symbolic stuff right from the start. I'm somewhat surprised, that it's not faster than mine, but very close.

allMonoms[5, 30, x]; // RepeatedTiming
(* {2.153, Null} *)

J.M's first and second variations (without and with Inner), respectively:

monomialListJM[{x, y, z, q, v}, 30]; // RepeatedTiming
(* {5.60, Null} *)
monomialListJM2[{x, y, z, q, v}, 30]; // RepeatedTiming
(* {5.58, Null} *)

Now there's a to-do, benchmarking memory and timings vs. input size, but I'll leave that to the reader, at least for now.

Addendum

I realized, that this problem is similar to finding the entropy (and enumerating every distinct microstate) of 0 to degree bosons in a Length[vars]-state system. As was established, explist is rather fast, and the slow part is multiplying by the variables, Transposeing, and Applying Times to every sublist. Apparently, this is linear in time with respect to the element count (at level 2) of the size of explist, so all that's left to find is the length of explist[vars, degree]. After realizing the similarity to bosons, this was easy:

Length[explist[vars, degree]] == 
  Divide[(1 + degree)*(degree + Length[vars])!,
    Length[vars]*(1 + degree)!*(Length[vars] - 1)!]

and the element count is of course Length[vars] times that. I then replace the factorials by Stirling's approximation and log-plot the element count vs. degree for Length[vars] == 5.

complexity

The timing of the slow part - transpose, apply, etc. is rougly 1 microsecond per element on the same machine, on which I did the benchmarking, so the above curve also represents the timing in microseconds for my method. I'm not sure, how this will translate to the other methods here, that will need some further investigation.

share|improve this answer
    
That reminds me… I first considered using IntegerPartitions[], but the need to apply an extra Permutations[], was why I settled on FrobeniusSolve[] instead. – J. M. Feb 19 at 7:30
    
@J.M. turns out, Permutations is actually quite a smart move, because generating the list of exponents for the variables is very fast. I'm editing right now, adding benchmarks and stuff. – LLlAMnYP Feb 19 at 7:32
    
@J.M. well, here's the updated post. I wonder, if you'd have a good idea, how to benchmark space and time complexity vs. input size without this taking an atrociously long time. – LLlAMnYP Feb 19 at 8:02
    
Here's a variation of your strategy: monoms = Function[{vars, degree}, Inner[#2^#1 &, Flatten[Permutations /@ PadRight[Flatten[Table[IntegerPartitions[k, Length[vars]], {k, 0, degree}], 1], {Automatic, Length[vars]}], 1], vars, Times]]. As for memory benchmarking, have you seen this? – J. M. Feb 19 at 16:11
    
@J.M. pretty much the same timing. I understand, how to test memory consumption and timing, what's slightly tougher, is benchmarking how the speed and memory consumed change with changing length of vars (extremely rapid growth for timings, by the way, at a glance something like Exp[Sqrt[x]]), and the same rate for growing degree, but with a lower constant. Running a proper benchmark will be very time- and memory-consuming. Five datapoints (Length[vars]==1 thru 5) is simply not enough to determine the behavior accurately. – LLlAMnYP Feb 19 at 16:21

Another alternative

monomialList[vars_?VectorQ, 
  order_Integer?
   Positive] := {1, 
    Outer[Times, Sequence @@ ConstantArray[vars, order]]} // Flatten // 
  Union

n = 3; (* number of variables *)

m = 3; (* ordert of monomial *)

myvar = Array[x, n]; (* define variables *)

Example

monomialList[myvar, m]

(*  {1, x[1]^3, x[1]^2 x[2], x[1] x[2]^2, x[2]^3, x[1]^2 x[3], 
 x[1] x[2] x[3], x[2]^2 x[3], x[1] x[3]^2, x[2] x[3]^2, x[3]^3}  *)
share|improve this answer
1  
This one instantly crashed my laptop at n=5 and m=15. Don't know what happened. Mouse and keyboard became unresponsive. Had to reset-restart. – Kagaratsch Feb 17 at 20:06

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.