BCH формулы

[sithif]

Подскажите где можно найти формулы Baker–Campbell–Hausdorff
Нужно для $C$ в случае $\exp(A) \exp(B) = \exp(C) $ и $\exp(A+B)=\exp(C) \exp (B)$

[Taus]

В википедии было не суждено посмотреть? http://en.wikipedia.org/wiki/Baker%E2%80%93Campbell%E2%80%93Hausdorff_formula

[sithif]

Taus, спасибо, конечно смотрел, даже google спрашивал, но мне нужно больше членов разложения, а там могут быть ошибки.
Нужна ссылка на проверенный источник или на программы в любых мат. пакетах.

[Taus]

sithif, на той же википедии приведено доказательство, которое вы можете повторить, если не уверены. Также там есть ссылки на статьи.
Ссылки на статьи, где люди численно считали коэффициенты http://www.ehu.es/ccwmuura/research/bch.pdf, http://www.sciencedirect.com/science/article/pii/S0010465509001222.

[sithif]

Taus, спасибо

[sithif]

Используя статью: Michael Weyraucha, Daniel Scholz, Computing the Baker–Campbell–Hausdorff series and the Zassenhaus product, предложенную Taus, и помощь Vince Diesel с операциями в Mathematica, удалось написать код для разложения $z=\log(\exp(x)\exp(y))$ (через коммутаторы). Может кому пригодится. Всем спасибо.

(Оффтоп)

(* M.Weyrauch,D.Scholz/Computer Physics Communications 180 (2009) \
1558\[Dash]1565 *)
(* Goldberg's method *)
(* polynomial generator *)
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]);
(* polynomial converter *)
CircleTimes[a_, b_, c__] := CircleTimes[CircleTimes[a, b], c];
PolyToCom[n_Integer] := Module[
  {
   POLY, LISTA, LISTB, TMP, A, B, WORDS, ANSWER, i
   },
  POLY = Apply[List, BCH[n, {"x", "y"}]];
  LISTA = POLY[[All, 1]];
  LISTB = POLY[[All, 2]];
  TMP = StringCases[LISTB, StartOfString ~~ "xy" ~~ ___] ;
  WORDS = TMP // Flatten;
  A = LISTA[[Take[Position[TMP, x_String] // Flatten, {1, -1, 2}]]];
  B = StringCount[WORDS, "x"];
  ANSWER = A;
  Do[
   {
    ANSWER[[i]] = 
     A[[i]]/B[[i]] Apply[CircleTimes, 
       ToExpression[StringCases[WORDS[[i]], Repeated[_, 1]]], {0}]
    }, {i, 1, Length[WORDS]}
   ];
  Total[ANSWER]
  ]
(* EXAMPLE(S) *)
PolyToCom[2]
PolyToCom[3]
PolyToCom[4]
PolyToCom[5]
PolyToCom[6]

[Утундрий]

sithif
Интересно, спасибо. А можно ли ёе как-нибудь приспособить к вычислению $e^{\alpha _1 A} e^{\beta _1 B} e^{\alpha _2 A} e^{\beta _2 B} ...e^{\alpha _K A} e^{\beta _K B} $?

[sithif]

Утундрий, для такой задачи мне не очевидно как это можно сделать.
Можно попробовать свернуть попарно и при этом работать с полиномами, а результат последней пары привести к коммутаторам.
У вас работает тождество: $\exp(-A) \exp(B) \exp(A) = \exp(\exp(-A)B)$? Последним можно сократить число пар.