4
$\begingroup$

I want to define the sum $$\sum_I p_1^{i_1}\cdots p_k^{i_k} \qquad \text{where}\qquad I=\left\{(i_1,\ldots,i_k)\mid \sum_{j=1}^k i_j=n\right\}$$ In other words, I want to define a sum in which the entries must satisfy a certain condition.

For example, if $k=2$ and $n=3$ then $I=\{(0,3),(1,2),(2,1),(3,0)\}$ and the sum would be

$$p^0q^3+p^1q^2+p^2q^1+p^3q^0$$

(To simplify the notation I took $p=p_0$ and $q=p_1$)

The product part is easy. My problem is defining an assumption on the sum that chooses only lists of exponents that satisfies the condition in $I$.

Thanks in advance.

$\endgroup$
  • 2
    $\begingroup$ Take a look at IntegerPartitions. $\endgroup$ – Kuba Feb 28 '17 at 21:41
  • 2
    $\begingroup$ e.g., ii =Flatten[Permutations /@ IntegerPartitions[3, {2}, Range[0, 3]], 1] $\endgroup$ – kglr Feb 28 '17 at 21:43
5
$\begingroup$
ClearAll[f1]
f1 [vars_, n_] := Sum[Times @@ (vars^i), {i, Flatten[Permutations /@ 
     IntegerPartitions[n, {Length@vars}, Range[0, n]], 1]}]

f1[{p, q}, 4]

Mathematica graphics

f1[{p, q, r}, 3]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thank you! That was perfect and straight to the point $\endgroup$ – user46971 Mar 1 '17 at 14:32
1
$\begingroup$
Clear@fun;
fun[n_, l_] := Plus @@ Function[x,Times @@ (n^x)] /@ (Select[Tuples[
Range[0, l], {Length@n}], Total@# == l && Length@# == Length@n &])

fun[{p, q}, 4]
(* p^4 + p^3 q + p q^3 + q^4 *)

fun[{p, q, r}, 3]
(*p^3 + p^2 q + p q^2 + q^3 + p^2 r + p q r + q^2 r + p r^2 + q r^2 + r^3*)
$\endgroup$
1
$\begingroup$
 f3[k_, n_] := With[ {var1 = FrobeniusSolve[Table[1, k], n]},
    array = 
   If[ Dimensions[var1][[2]] < Length[Alphabet[]], 
    Take[Alphabet[], Dimensions[var1][[2]]], Null]   ;

   Total@Table[
    Apply[Times, array^var1[[i]]], {i, 1, Dimensions[var1][[1]]}]  

  ]

f[3, 4] gives

(a)^4+(a)^3 b+(a)^3 c+(a)^2 (b)^2+(a)^2 b c+(a)^2 (c)^2+a (b)^3+a (b)^2 c+a b (c)^2+a (c)^3+(b)^4+(b)^3 c+(b)^2 (c)^2+b (c)^3+(c)^4

some further analysis

BarChart[{AbsoluteTiming[f1[{p, q, r, c, d}, 8]][[1]], 
  AbsoluteTiming[fun[{p, q, r, c, d}, 8]][[1]], 
  AbsoluteTiming[f3[5, 8]][[1]]}, ChartLabels -> {"f1", "fun", "f3"}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy