last day (28 days later) » 

05:51
@martin I've figured out how to get the coefficients for arbitrary exponent sets, not sure it's very practical, but it has no practical limit on number of terms/sizes of exponents, perhaps might serve to spur other thoughts: consider the internal and external powers as defining a multiset, where there are external power of internal power entries, e.g. for (a^2+b^2)^3 (a^3+b^3)^2, the multiset w/b {2,2,2,3,3}.
Now, take some exponent set, say {10,2}. Find the distinct ways 10 can be formed from elements selected from the multiset w/o replacement. For each of those, find the same for 2. In this trivial case, we'd have {3,3,2,2} and {2}. Now, starting with the first, we took 2 of the 2 threes, and two of the 3 twos. For the second, we took 1 of the remaining 1 twos.
Binomial[2,2]*Binomial[3,2]*Binomial[1,1]=3, the coefficient of {10,2}. When there is more than the one way shown here, enumerate the distinct ones, sum the results.
 
9 hours later…
14:57
@rasher I'm not sure I do understand actually. So for
Gather[CoefficientRules@
Expand[Tr[#^3]^2*Tr[#^1]^2*Tr[#^2]^3 &@Array[x, 7]],
Sort[#1[[1]]] == Sort[#2[[1]]] &][[All, 1]][[36]]
I got
{{{3, 3}, {2, 2, 1}, {2, 1}},
{{1, 1, 2, 2}, {2, 3}, {3}},
{{2, 2, 2}, {1, 1, 3}, {3}},
{{1, 2, 3}, {2, 3}, {1, 2}}}
which I translated to
Binomial[2, 2] Binomial[3, 2] Binomial[2, 1] Binomial[1, 1] Binomial[
1, 1] +
Binomial[2, 2] Binomial[3, 2] Binomial[1, 1] Binomial[2, 1] Binomial[
1, 1] +
Binomial[3, 3] Binomial[2, 2] Binomial[2, 1] Binomial[1, 1] +
Binomial[2, 1] Binomial[3, 1] Binomial[2, 1] Binomial[2, 1] Binomial[
1, 1] Binomial[1, 1] Binomial[1, 1]
which gives 38 instead of 50. Have I misunderstood?
 
2 hours later…
17:10
@rasher apologies - it works now :)
 
3 hours later…
20:39
@martin It's a interesting transformation, have not spent much time thinking about how to do it efficiently... but going through my computer algebra books & combinatorics books has led to nowhere so far for alternatives.
21:07
@rasher have been playing around wioth it a bit - & have got as far as ...
Select[Gather[
CoefficientRules@
Expand[Tr[#^3]^2*Tr[#^1]^2*Tr[#^2]^3 &@Array[x, 7]],
Sort[#1[[1]]] == Sort[#2[[1]]] &][[All, 1]],
Take[#[[1]], 3] == {6, 5, 3} &]

subs[num_, list_] :=
DeleteDuplicates[Sort[#] & /@ Select[Subsets[list], Total@# == num &]]
removeFrom[b_List, a_List] := Module[{f}, f[_] = 0;
(f[#] = -#2) & @@@ Tally[a];
Pick[b, UnitStep[f[#]++ & /@ b], 1]]
doub[list1_, list2_] :=
If[Length[#[[2]]] > 0,
Transpose[{Table[#[[1]], {x, Length[#[[2]]]}], #[[2]]}], #] & /@
Partition[Riffle[list1, list2], 2]
Just trying to find a way to automate the lists in the middle part ...
...Very messy, but woking at least!
21:34
@martin Whoa! That's a lotta code ;-) I'll be lounging later, will ponder this, my gut tells me there's an efficient way of doing this, though I'm not sure so efficient that getting all for all valid sets will be nearly as fast as the earlier simpler case. I'm also playing with "truncating" results - that is, doing one poly multiplication, pulling distinct terms, multiplying by next, pulling distinct... rinse and repeat
. If I can get it to work (right now most coeff. are fine, some are < than actual from truncation, so need to figure out correction) this c/b quite fast.
21:52
@rasher that sounds much cleaner than what I've been doing! Looking forward to seeing what you come up with - meanwhile, I'll keep plugging away ;)

  last day (28 days later) »