MathematicaのコードにおいたAGT.zipの中に入っているW3algebra.mの説明。うろ覚えです。

(W_3)代数ののShapovalov行列、例えば(\langle\Delta, w |L_{-2}W_{-1}^2|\Delta,w\rangle)を求めたい時、交換関係を使って、レベルが正の生成子が右に来るように並び替えるが、手でやるのは面倒だ。(A.Marshakov, A.Mironov, A. Morozov [arXiv:0907.3946] の§2.3やA.Mironov, A.Morozov [arXiv:0908.2569] の§3.1など)

この並べ替えをMathematicaに計算させるためにパッケージがW3algebra.mで、Shapovalov.nbで使っている。

使い方

使用例

SetDirectory[NotebookDirectory[]];
  
<< W3algebra.m
  
(\*固有値\*)
  
state /: L[0] ** state[Δ, w\___] :=Δ state[Δ, w];
  
state /: W[0, m\_] ** state[Δ\_, w\___] := {w}[[ m &#8211; 2]] state[Δ, w];

NCSortBy[L[-2] \*\* L[-1] \*\* W[-1, 3] \*\* W[-3, 3] \*\* state[Δ, w],NCOrderedQ,commutator]

使用例の説明

まず、W3algebra.mをノートブックがあるディレクトリに置く。

SetDirectoryでノートブックがあるディレクトリにPathを通す。

<< W3algebra.mでパッケージをロードする。

(\*固有値\*)
  
state /: L[0] ** state[Δ, w\___] :=Δ state[Δ, w];
  
state /: W[0, m\_] ** state[Δ\_, w\___] := {w}[[ m - 2]] state[Δ, w];

で生成子が状態に作用した時の変換規則を設定する。

式で書くと

$$

\begin{aligned}

L_0 |\Delta,w_3,w_4,\dots\rangle &:= \Delta |\Delta,w_3,w_4,\dots\rangle \

w_0^{(m)} |\Delta,w_3,w_4,\dots\rangle &:= w_m |\Delta,w_3,w_4,\dots\rangle

\end{aligned}

$$

な感じ。

(W_4)以上にも、適応できる形で書いたが、交換関係を定義していないので、計算は無理。

この定義もW3algebra.mの中に入れてもいいけど(|V_\alpha\rangle)と書く場合もあるので、外した。

NCSortBy[L[-2] \*\* L[-1] \*\* W[-1, 3] \*\* W[-3, 3] \*\* state[Δ, w],NCOrderedQ,commutator]

でレベルが正の生成子が右に来るように並び替える。

NCSortByは第1引数の非可換積の隣り合う演算子をNCOrderedQで比較し、NCOrderedQがFalseを返したら、commutatorを使って交換する関数。

Mathematicaの組み込み関数SortByを非可換積に拡張するイメージで書いた。NCはNoncommutativeの略。

W3algebra.nbのNCOrderedQとcommutatorを変えたら、他の非可換積の計算にも使える。

W3algeba.mの説明

W3algebra.mの中にはいろいろな記号がでてきて何をやっているかわからないかもしれないが、「_」「__」「___」「/@」「@@」「/:」などといった記号もドキュメントセンターで検索するとちゃんと出る。

それと**をNonCommutativeMultiplyで表したり、+をPlusで表したり、*をTimesで表している箇所がある。FullFormを使うと、記号を用いない関数名がわかる。

ちなみにこのコードはThielemansのOPEdefs.m(メールすればくれると思う)と学位論文(hep-th/9506159)にかなり影響を受けている。興味がある人は読んだ方がいいだろう。

(\*Normal Ordering\*)
  
NO[W1\_[m\_, i\_\\_\_] \*\* W2\_[p\_, j\_\__]] := W1[m, i] \*\* W2[p, j] /; m <= p;
  
NO[W1\_[m\_, i\_\\_\_] \*\* W2\_[p\_, j\_\__]] := W2[p, j] \*\* W1[m, i] /; m > p;

(\*交換関係の定義\*)
  
commutator[L[m\_], L[n\_]] := (m - n) L[m + n] + c/12 (m^3 - m) KroneckerDelta[m + n, 0];
  
commutator[L[n\_], W[m\_, 3]] := (2 n - m) W[m + n, 3];
  
x[n_] := (1 + n/2) (1 - n/2) /; EvenQ[n];
  
x[n_] := (2 + (n - 1)/2) (1 - (n - 1)/2) /; OddQ[n];
  
Λ[n_] := mySum[NO[L[k] ** L[n - k]], {k}] + x[n]/5 L[n];
  
commutator[W[m\_, 3], L[n\_]] := -commutator[L[n], W[m, 3]];
  
commutator[W[n\_, 3], W[m\_, 3]] := 9/2 (c/(3 5!) n (n^2 - 1) (n^2 - 4) KroneckerDelta[n + m, 0] + 16/(22 + 5 c) (n - m) Λ[n + m] + (n - m) (1/15 (n + m + 2) (n + m + 3) - 1/6 (n + 2) (m + 2)) L[n + m]);

NCList = {L[\_], W[\\_\_], state[\_\_]};
  
(\****\*\\*\*NCSortBy\*\*\***\*****)
  
NCQ[A_] := Or @@ (MemberQ[{A}, #] & /@ NCList);
  
CQ[A_] := And @@ (FreeQ[{A}, #] & /@ NCList);

levelOfState[a_ B_] := levelOfState[B] /; CQ[a];
  
levelOfState[state[__]] := 0;
  
levelOfState[NonCommutativeMultiply[Null, state[__]]] := 0;
  
levelOfState[NonCommutativeMultiply[state[__]]] := 0;
  
levelOfState[x__ ** state[__]] := -Total[Part[#, 1] & /@ {x}];

mySum /: NonCommutativeMultiply[Op1\_\\_\_, mySum[NO[W1\_[m\_, i\_\_\_] ** W2\_[p\_, j\_\_\_]], {k\_}], Op2 : (L[\_] | W[\_\_]) ..., state[a__]] :=
  
Module[{l}, l = levelOfState[Op2 ** state[a]];
     
(\*level以上の演算子は要らない\*)
     
NonCommutativeMultiply[
      
Sum[NonCommutativeMultiply[Op1, NO[W1[m, i] ** W2[p, j]], Op2,
        
state[a]], {m, p + m - l, l}]]
     
];

(\*消えるのもを先に定義した方が無駄な計算をしなくて済む\*)
  
state /: NonCommutativeMultiply[(L[n\_] | W[n\_, m\_]), state[a\__]] := 0 /; n > 0;

MyOrder[(L[n\_] | W[n\_, m_])] := Which[Positive[n], 1, n == 0, 0, Negative[n], -1];
  
MyOrder[state] = \[Infinity];
  
NCOrderedQ[A\_, B\_] := If[MyOrder[A] <= MyOrder[B], True, False];(\*正しい順序の時Trueを返す\*)

(\*普通の積の場合\*)
  
NCSortBy[a_ h\_NonCommutativeMultiply, f\_, commutator_] := a NCSortBy[h, f, commutator];
  
(\*和の場合\*)
  
NCSortBy[a\_Plus, f\_, commutator_] := NCSortBy[# , f, commutator] & /@ a;

(\*非可換積の線形性\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b\_Plus, c\\_\_\_], f\_, commutator_] :=
  
Distribute[h[a, b, c], Plus, h, Plus, NCSortBy[h[##], f, commutator] &];
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b_ c\_, d\\_\_\_], f\_, commutator_] := b NCSortBy[h[a, c, d], f, commutator] /; CQ[b];

(\*0が含まれるときは0。下のc-numberとは別に定義したのは余分なNCSortByを計算させないため\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, 0 , c\_\_\_], f\_, commutator_] := 0;
  
(\*非可換積の引数が一つの時\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_], f\_, commutator_] := a;
  
(\*c-numberは非可換積の外に\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, s_ , c\_\_\_], f\_, commutator_] := s NCSortBy[h[a, c], f, commutator] /; CQ[s]

(\*NonCommutativeMultiplyの引数が一つのときは引数そのもの\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_], f\_, commutator_] := NCSortBy[a, f, commutator];

(\*交換子を使った並び替え\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b\_, c\_, d\_\_\_], f\_, commutator_] := (NCSortBy[h[a, b , c, d], f, commutator] =
       
NCSortBy[h[a, c, b, d], f, commutator] + NCSortBy[h[a, commutator[b , c], d], f, commutator]) /; !f[b, c];
  
(\*orderが逆なら\*)

NCSortBy[a\_, f\_, commutator_] := Expand[a];

まずはNormal Orderingの設定

(\*Normal Ordering\*)
  
NO[W1\_[m\_, i\_\\_\_] \*\* W2\_[p\_, j\_\__]] := W1[m, i] \*\* W2[p, j] /; m <= p;
  
NO[W1\_[m\_, i\_\\_\_] \*\* W2\_[p\_, j\_\__]] := W2[p, j] \*\* W1[m, i] /; m > p;

W1_[m_, i___]はL[m]とかW[m,3]とかにマッチするので、生成子(L_m)と(W_m)に対するNormal Orderingを同時に定義できる。

しかしこれだと関数にマッチしすぎるので危ない気がする。

(*交換関係の定義*)の所でmySumという自分で定義した関数を使っている。これについての説明は後述する。

NCList = {L[\_], W[\\_\_], state[\_\_]};

で非可換にしたい演算子を定義する。

NCQ[A_] := Or @@ (MemberQ[{A}, #] & /@ NCList);
  
CQ[A_] := And @@ (FreeQ[{A}, #] & /@ NCList);

NCQは非可換演算子かを判定する関数。

MemberQ[list,form]はlist の要素が form にマッチした場合にTrueを,その他の場合にFalseを返す関数。

MemberQ[{1, 3, 4, 1, 2}, 2]だと、listの中に2が入っているのでtrueを返す。

NCQという複雑な関数を作らなくてもMemberQ[NClist,A]でうまく行きそうな気がする。わざわざ定義しているのはNCListの中身にパターンオブジェクトのアンダーバーが入っているためだったと思う。

MemberQ[{A}, #] & /@ NCList

でMemberQをNCListにMapするので、

[MemberQ[{A}, L[_]],MemberQ[{A}, W[__]],MemberQ[{A}, state[__]]]

となり、それそれの要素が、trueかfalseになる。配列の要素に一つでもTrueがあれば、それは非可換演算子なので、OrをApplyさせている。

CQは可換な演算子かを判断する関数。

levelOfStateはstateのレベルを返す関数。

levelOfState[a_ B_] := levelOfState[B] /; CQ[a];

可換な演算子は関係無いので除外。

levelOfState[state[__]] := 0;

stateそのものは0。

levelOfState[NonCommutativeMultiply[Null, state[__]]] := 0;
  
levelOfState[NonCommutativeMultiply[state[__]]] := 0;

これらもstateそのものは0とほぼ同じ意味。下で定義するNCSortByで並び順を変換した時、NonCommutativeMultiplyの引数にNullが入ったり、引数がひとつになることがあるので、この定義が必要。

levelOfState[x__ ** state[__]] := -Total[Part[#, 1] & /@ {x}];

これがlevelOfStateの本質。xはL[m]とかW[m,3]のシーケンス。

たとえばxがL[-m], W[-n,3]だったとき、

Part[#,1] & /@ {L[-m], W[-n,3]}

{Part[L[-m],1],Part[W[-n,3],1]}
  
→ {-m, -n}

のようになる。

これに-Totalを作用させれば、stateのレベルが求まる。

mySumの説明。

mySum /: NonCommutativeMultiply[Op1\_\\_\_, mySum[NO[W1\_[m\_, i\_\_\_] ** W2\_[p\_, j\_\_\_]], {k\_}], Op2 : (L[\_] | W[\_\_]) ..., state[a__]] :=
  
Module[{l}, l = levelOfState[Op2 ** state[a]];
     
(\*level以上の演算子は要らない\*)
     
NonCommutativeMultiply[
      
Sum[NonCommutativeMultiply[Op1, NO[W1[m, i] ** W2[p, j]], Op2,
        
state[a]], {m, p + m - l, l}]]
     
];

ここでやりたい事は

$$

\sum_{k}^\infty : L_{k}L_{n-k}:L_{-l}|\Delta,w\rangle

$$

というような無限和があったとき、(n-k\le l,\quad k\le l)より

$$

\sum_{k=n-l}^2 : L_{k}L_{n-k}:L_{-l}|\Delta,w\rangle

$$

のように有限な和にすることだ。上のコードでは引数をn-kの形にできないので(?)pで表している。引数のmはkでいい気もする。

まず表れる/:はTagSetDelayedというシンボルだ。

異なるシンボルへの定義式の関連付けというページに以下のような文章がある。

ある特定の関数が参照されるとき,Mathematica は,その関数に関連付けられた全定義を試す.g[x_]+g[y_]用の定義をPlusに関する下向きの値として作ると,Plusが現れるたびに,Mathematica はこの定義を使ってしまう.これは,式の加法が行われるたびにこの定義が判定されるため,非常に一般的な演算操作を遅くしてしまうことになる.

ここでの例に当てはめてみると、mySum /:を先頭につけることによって、NonCommutativeMultiplyが現れるたびに、Mathematicaが定義を適応できるか試すのではなく、mySumが現れたときに定義を試すように出来きる。

計算式の中でmySumの出現数の方が、NonCommutativeMultiplyに比べて少ないので、このように定義をしたほうが、効率的だし、NonCommutativeMultiplyは組み込み関数なので新たに定義をするためには、一工夫必要だ(組込み関数の変更)。

Sumではなく、mySumという関数を定義したのは、Sumは組み込みの関数に定義をするには一工夫必要なためと、実際に和の計算をして欲しいわけではなく、シンボル的に使いたいので。

Op2 : (L[_] | W[\_])…の部分はL[]またはW[\__]が0個以上並んでいるパターンにマッチして、それにOp2に名前をつけている(Pattern)。

Op2_\__とするよりも、より厳密にパターンを設定できる。Op2___としてしまうと、Op2の中に和や積が入ってしまい、次のleveleOfStateの時にレベルを正しく計算してくれないのでこのように定義している。

よって和や積が入っているときは、ここでの変換は適応されず、以下のNCSortByによって和と積が展開される。

その下の行では無限和のmySumを有限和にして普通のSumにしている。ただし、Sumで全体を囲っている。なぜか。

NCSortByによってNonCommutativeMultiplyの中に和がある場合はそれを出すように変換される。その変換をひとつ省くために最初からSumを外側でとるようにしたのかと思ったら、さらにその外側にNonCommutativeMultiplyがあるので、最適化されてないかもしれない。

(\*消えるのもを先に定義した方が無駄な計算をしなくて済む\*)
  
state /: NonCommutativeMultiply[(L[n\_] | W[n\_, m\_]), state[a\__]] := 0 /; n > 0;

の所では、(highest weight) stateに正のレベルの生成子を作用すると0という定義をしている。

MyOrder[(L[n\_] | W[n\_, m_])] := Which[Positive[n], 1, n == 0, 0, Negative[n], -1];
  
MyOrder[state] = \[Infinity];
  
NCOrderedQ[A\_, B\_] := If[MyOrder[A] <= MyOrder[B], True, False];(\*正しい順序の時Trueを返す\*)

ここでは、MyOrderの戻り値を、引数が正の生成子の場合は1,負の生成子の場合は-1、stateの場合は無限大と定義している。

NCOrderedQでは2つの演算子を比べて、左側の演算子のMyOrderの値が右側の演算子のMyOrderの値以下ならTrueを返している。これをNCSortByで使って、負のレベルの演算子が左側、正のレベルの演算子が右側、stateが一番右側になるようにソートする。

ここから先は、NCSortByの第一引数をひたすら展開する変換規則が並ぶ。

(\*普通の積の場合\*)
  
NCSortBy[a_ h\_NonCommutativeMultiply, f\_, commutator_] := a NCSortBy[h, f, commutator];
  
(\*和の場合\*)
  
NCSortBy[a\_Plus, f\_, commutator_] := NCSortBy[# , f, commutator] & /@ a;

f_はNCOrderedQが入るけど、長いのでf_にしている。

h_NonCommutativeMultiplyは頭部がNonCommutativeMultiplyの任意の式を表す(Blank)。だから、 a_ h_NonCommutativeMultiplya L[n]**W[m,3]**state[Δ,w]などにマッチして、c-numberをNCSortByの外に出す。

和の場合はL[n]**W[m,3]**state[Δ,w] + L[l]**W[p,3]**state[Δ,w]などにマッチして、マップすると

Plus[NCSortBy[L[n]\*\*W[m,3]\*\*state[Δ,w] , f, commutator],NCSortBy[L[l]\*\*W[p,3]\*\*state[Δ,w] , f, commutator]]

となり、和が外に出る。

上の2つはNonCommutativeMultiplyの外に和と積があった時の展開の仕方で、ここからはNonCommutativeMultiplyの引数に和と積があったときの展開の話。

(\*非可換積の線形性\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b\_Plus, c\\_\_\_], f\_, commutator_] :=
  
Distribute[h[a, b, c], Plus, h, Plus, NCSortBy[h[##], f, commutator] &];
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b_ c\_, d\\_\_\_], f\_, commutator_] := b NCSortBy[h[a, c, d], f, commutator] /; CQ[b];

まず、上の式から。

左辺は割と簡単でNonCommutativeMultiplyの中に和があった時にマッチする。h : NonCommutativeMultiplyと書くと、長ったらしいNonCommutativeMultiplyをhで表すことができて便利。[a___, b_Plus, c___]と書くことによって、NonCommutativeMultiplyの何番目の引数に和があっても展開できる。

右辺は非常にわかりにくい。そもそもドキュメントセンターのDistributeの説明を見ても、引数が5つのDistributeなんて定義されてない!? と、見せかけて「一般化と拡張」を開いてみるとちゃんと定義されている。

In[1]:=Distribute[f[g[a, b], g[ c, d, e]], g, f, gp, fp]
  
(* まず、fを分配。[a,b]と[ c,d,e]のすべての組み合わせがfの引数になる
  
Out[0.5]:=g[f[a,c],f[a,d],f[a,e],f[b,c],f[b,d],f[b,e]]
  
その後g → gp, f → fpに変換 *)
  
Out[1]:=gp[fp[a,c],fp[a,d],fp[a,e],fp[b,c],fp[b,d],fp[b,e]]

今回の場合だと、

In[1]:=Distribute[h[a, b, c], Plus, h, Plus, NCSortBy[h[##], f, commutator] &]
  
(\* bはPlus[b1,b2,...]みたいな形で、a, cの頭部はPlusでないとき \*)
  
Out[0.5]:=Plus[h[a,b1,c],h[a,b2,c],...]
  
その後Plus → Plus, h → NCSortBy[h[##], f, commutator] &
  
Out[1]:=Plus[NCSortBy[h[a,b1,c],f,commutator],NCSortBy[h[a,b2,c],f,commutator],...]

というわけで、めでたくNonCommutativeMultiplyの中の和をNCSortByの外側に出すことができた。

2つ目の式はbがc-numberのときに、外に出しているだけ。

しかしながらDistributeはわかりにくい。

NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b\_+ d\_, c\_\_\_], f\_, commutator_] :=
  
NCSortBy[h[a,b,c],f,commutator]+NCSortBy[h[a,d,c],f,commutator];

の方が断然わかりやすい。しかしこの方法だと、NonCommutativeMultiplyの引数の第一引数にn1個の和、第二引数にn2個の和があった時、分配するのにO(n1 * n2)の時間がかかってしまう。Distributeにすると、一気に分配してくれるので時間はO(1)だ(定義ではbにしかあらわにb_Plusとして書いてないが、aやcの頭部もPlusだった場合は、それも分配してくれることに注意)。

このことについてのベンチマークテストはKris Thielemans(arXiv:hep-th/9506159)のIntermezzo 3.3.4に書いてある。

(\*NonCommutativeMultiplyの引数が一つのときは引数そのもの\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_], f\_, commutator_] := NCSortBy[a, f, commutator];

これは、いらないコードかな。その上で全く同じパターンで違う定義がされているので、そちらが先に実行されるので、問題はでないが、削除したほうがいいと思う。

(\*交換子を使った並び替え\*)
  
NCSortBy[(h : NonCommutativeMultiply)[a\_\\_\_, b\_, c\_, d\_\_\_], f\_, commutator_] := (NCSortBy[h[a, b , c, d], f, commutator] =
       
NCSortBy[h[a, c, b, d], f, commutator] + NCSortBy[h[a, commutator[b , c], d], f, commutator]) /; !f[b, c];
  
(\*orderが逆なら\*)

これがソートする定義。

NCSortBy[a\_, f\_, commutator_] := Expand[a];

これが最後の定義。

定義の適用順によれば

Mathematica は,特殊な定義を一般的な定義より先に置く.

とある。f[n_] := n f[n - 1]f[1]=1という定義があって、f[n_] := n f[n - 1]が先に実行されてしまっては、いつまで経っても終わらないからだ。

どちらがより一般的かは判断することが極めて困難な場合は,Mathematica は与えられた通りの順序で規則を保管する.(ちょっと改変)

とも書いてある。

NCSortBy[a\_, f\_, commutator_] := Expand[a];

は一番一般的だし、最後に記述したので、最後に適応する定義になってるはず。?NCSortByで定義の適応順序が確認できる。

ちょっと前置きが長くなってしまったが、何を言いたいかというと、この定義にたどり着いたということはNCSortByでやるべきことはやり尽くした状態だ。生成子の順番はちゃんと昇順になっており、昇順にする過程で使った交換関係で定数が出てきているだろう。もうNCSortByする必要は無いので単純に

NCSortBy[a\_, f\_, commutator_] := a;

としてしまうと、他の項との足し算がうまくいかない。そこでExpandを使って、aを展開している。