Hi,
I'm trying to convert polynomial representation of
z=log(exp(x)exp(y)) into nested commutators representation.
Polynomial representation can be obtained by Goldbergs method.
(The code below is taken from
Michael Weyraucha, Daniel Scholz, Computing the BakerCampbellHausdorff series and the Zassenhaus product)
g[1] = 1;
g[s_] := g[s] = Expand[1/s*D[t*(t - 1)*g[s - 1], t]];
c[w_] := c[w] = Module[
{m, m1, m2, k},
m = Length[w];
m1 = Floor[m/2];
m2 = Floor[(m - 1)/2];
Integrate[t^m1*(t - 1)^m2*Product[g[w[[k]]], {k, m}], {t, 0, 1}]
];
BCH[n_Integer, alph_List] := Module[
{p},
p = Flatten[Permutations /@ IntegerPartitions[n], 1];
Plus @@ (c[Sort[#]]*(words[#, alph] -
(-1)^n*words[#, Reverse[alph]]) & /@ p) // Expand];
words[p_List, alph_List] := StringJoin @ (ConstantArray @@@
Partition[Riffle[p, alph, {1, 2*Length[p], 2}], 2]);
For example:
In[2458]:= BCH[3, {"x", "y"}]
Out[2458]= ("xxy")/12 - ("xyx")/6 + ("xyy")/12 + ("yxx")/12 -("yxy")/6 + ("yyx")/12
The output is a polynomial of the form:
P(x,y) = Sum a(x1,x2,..,xk) x1 x2 ... xk with
xi = x or
yIn the same article (
eq.14) the map that converts polynomial representation into commutators is given:
F(P) = Sum a(x,y,x3,x4,...,xk)/(nx(x3,x4,...,xk)+1) [[...[[ [x,y],x3],x4],...,],xk],here
nx(x3,x4,...,xk) is a number of
x in a monomial after
xy, for e.g.
n(xy)=1, n(xyx)=2, ...Here is the algorithm I need to code:
1) for given n find BCH[n, {"x", "y"}]
2) remove all monomials (words) not starting with xy
3) for xy... monomials find a(x1,x2,..,xk) and nx(x3,x4,...,xk)
4) build [[...[[ [x,y],x3],x4],...,],xk]
Example for z3:
1) ("xxy")/12 - ("xyx")/6 + ("xyy")/12 + ("yxx")/12 - ("yxy")/6 +("yyx")/122) - ("xyx")/6 + ("xyy")/12
3) - ("xyx")/6: a(x,y,x)=-1/6 and n(x)=1
("xyy")/12: a(x,y,y)=1/12 and n(y)=0
4) a(x,y,x)/(n(x)+1) [[x,y],x] + a(x,y,y)/(n(y)+1) [[x,y],y] = -1/12[[x,y],x]+1/12[[x,y],y]Any tips on how to implement this map in Mathematica?
Thanks in advance,
I.M.
