Construct the Hamiltonian

Brett van de Sande
June 20, 2001

The notation used in this notebook corresponds to the notation introduced in the LaTeX notes "endpoint.tex" and to Simon's paper, hep-ph/0101318.

Definitions

Off[General::"spell1"]

All symbols are considered to be c-number unless specified otherwise:

cnumberq[x_] := FreeQ[x, sigma[_]] && FreeQ[x, a[__]] && 
        FreeQ[x, b[__]] && FreeQ[x, d[__]] && 
        FreeQ[x, zeta[_]]
freelistq[x_, y_List] := Apply[And, Map[FreeQ[x, #] &, y]]

prodexpand = {(a__) ** b_Plus :> 
            Map[(a ** #) &, b], 
          b_Plus ** (a__) :> 
            Map[(# ** a) &, b], 
a_ ** 
              b_Times :> 
            Select[b, cnumberq] a ** Select[b, ! cnumberq[#] &], 
          b_Times ** a_ :> 
            Select[b, cnumberq] Select[b, ! cnumberq[#] &] ** 
                a};

intsumexpand = {a_  **  int[b_, c_] :> 
            int[a ** b, c] /; freelistq[a, c], 
          int[b_, c_] ** a_ :> 
            int[b ** a, c] /; freelistq[a, c], 
a_  **  
              sum[b_, c_] :> sum[a ** b, c] /; freelistq[a, c],  
          sum[b_, c_] ** a_ :> 
            sum[b ** a, c] /; freelistq[a, c], 
int[
              a_Times, b_] :> 
            Module[{vars = Select[a, freelistq[#, b] &]}, 
              vars int[Select[a, ! freelistq[#, b] &], b] /; 
                vars =!= 1], 
sum[a_Times, 
              b_] :> 
            Module[{vars = Select[a, freelistq[#, b] &]}, 
              vars sum[Select[a, ! freelistq[#, b] &], b] /; 
                vars =!= 1], 
int[a_Plus, b_] :> 
            Map[int[#, b] &, a], 
sum[a_Plus, b_] :> 
            Map[sum[#, b] &, a], 
int[d_.  sum[a_, b_], 
              c_] -> sum[int[d a, c], b], 
int [
              a_.  int[b_, c_], d_] :> 
            int[Expand[a b], Join[c, d]] /; 
              freelistq[a, c], 
sum [a_.  sum[b_, c_], 
              d_] :> sum[Expand[a b], Join[c, d]] /; 
              freelistq[a, c], 
int[a_, b_] :> 
            int[Expand[a], b] /; Expand[a] =!= a};

prodfactor = {a_.  c_NonCommutativeMultiply + 
              b_.  c_NonCommutativeMultiply :> 
            Simplify[Factor[Expand[a] + Expand[b]]] c};

sigmazeta = {a[b__] ** sigma[c_] -> sigma[c] ** a[b], 
          Conjugate[a[b__]] ** sigma[c_] -> 
            sigma[c] ** Conjugate[a[b]], 
a[b__] ** 
              zeta[c_] -> zeta[c] ** a[b], 
          Conjugate[a[b__]] ** zeta[c_] -> 
            zeta[c] ** Conjugate[a[b]], 
a[b__] ** 
              Conjugate[zeta[c_]] -> Conjugate[zeta[c]] ** a[b], 
          Conjugate[a[b__]] ** Conjugate[zeta[c_]] -> 
            Conjugate[zeta[c]] ** Conjugate[a[b]]};

Relabel the parameters for implicit sums and integrations.  It acts on an expression that is linear in NonCommutativeMultiply[...].

relabel[a_Plus] := Map[relabel, a];
\(relabel[ain_\ bin_NonCommutativeMultiply] := 
      Block[{i1 = 1, i2 = 1, j = 1, krules, kcrules, srules, ops, cops}, 
        ops = Cases[Apply[List, bin], 
            a[_Symbol, _] | b[_Symbol, ___] | d[_Symbol, ___]]; 
        cops = Cases[Apply[List, bin], 
            Conjugate[a[_Symbol, _] | b[_Symbol, ___] | d[_Symbol, ___]]]; 
        krules = 
          Map[\((First[#] -> 
                  Symbol["kr" <> ToString[\(i2++\)]])\) &, Reverse[ops]]; 
        kcrules = 
          Map[\((First[First[#]] -> 
                  Symbol["kl" <> ToString[\(i1++\)]])\) &, cops]; 
        srules = 
          Map[\((# -> Symbol["s" <> ToString[\(j++\)]])\) &, 
            Union[Map[Last, 
                Cases[
\(Apply[List, bin] /. 
                      Conjugate[ex_] -> ex\) /. 
                    a[_, \(-b_Symbol\)] -> a[0, b], 
                  a[_, _Symbol] | zeta[_Symbol] | 
                    sigma[_Symbol]
]]]]; 
\(ain\ bin /. Join[krules, kcrules]\) /. 
          srules]\)

simplify an integration over x, assuming the variable is in a delta-function.  It acts on an expression that is linear in delta[...] and NonCommutativeMultiply[...].

simpint[a_Plus, x_] := 
        Map[simpint[#, x] &, a];
simpint[a_ b_, x_] := 
        a simpint[b, x] /; FreeQ[a, x];
simpint[a_  delta[-x_ + c_], x_] := 
        simpint[a delta[x - c], x];
simpint[a_  delta[x_ + c_], x_] := 
      Simplify[a /. x -> -c]
simpint[a_ , x_] := a /; FreeQ[a, x];

Unprotect[Conjugate];
Conjugate[a_Plus] := Map[Conjugate, a];
Conjugate[a_Times] := Map[Conjugate, a];
Conjugate[a_ ** b_] := 
        Conjugate[b] ** Conjugate[a];
Protect[Conjugate];
sigma /: Conjugate[sigma[a_]] = 
        sigma[a];
sigma /: sigma[a_Integer] ** sigma[a_Integer] ** b_ = 
        b;
sigma /: b ** sigma[a_Integer] ** sigma[a_Integer] = 
        b;
zeta /: Conjugate[zeta[a_]] := zeta[a];
int /: Conjugate[int[a_, b_]] := 
        int[Conjugate[a] /. Map[(Conjugate[#] -> #) &, b], 
          b];
sum /: Conjugate[sum[a_, b_]] := 
        sum[Conjugate[a] /. Map[(Conjugate[#] -> #) &, b], 
          b];

intconv[
        x_] := (int[a_, b_] :> 
          int[Integrate[a, x], Complement[b, {x}]] /; 
            MemberQ[b, x])

A variable x is defined to be positive[x]=True if it is *always* positive.

Unprotect[Positive];
Positive[a_ + b_] := 
        False /; ! Positive[a] && ! Positive[
                b];
Positive[a_?Positive + b_?Positive] = 
        True;
Positive[a_?Negative b_?Positive] = 
        False;
Protect[Positive];
neverzero[a_] := If[Positive[a], True, True, False];

On[General::"spell1"]

Find Yukawa terms (OLD)

u[x_] := 
      1/Sqrt[2 Pi] int[
          b[kf] Exp[-I kf x] + 
            sigma[1] ** Conjugate[d[kf]] Exp[
                I kf x], {kf}]
m[x_, rho_] := 
      1/Sqrt[4 Pi] int[(a[ka, -rho] Exp[-I ka x] +  
                Conjugate[a[ka, rho]] Exp[I ka x])/
            Sqrt[ka], {ka}]
kappaa /: Conjugate[kappaa] := kappaa
kappas /: Conjugate[kappas] := kappas
muf /: Conjugate[muf] := muf

xi =  
      Expand[muf/Sqrt[2] sigma[1] ** u[x] + 
            kappaa/Sqrt[2] sigma[1] ** zeta[rr] ** m[x, rr] ** u[x] - 
            kappas/Sqrt[2] sum[sigma[1] ** m[x, rr] ** u[x], {rr}] //. 
          prodexpand  ]

cxi = Conjugate[xi] /. {Conjugate[x] -> x, 
                Conjugate[ka^n_] -> ka^n} /. {ka -> kka, 
              kf -> kks, rr -> ll} //. prodexpand //. 
        sigmazeta

expr = 
      Collect[Expand[(-I cxi ** int[xi, {x}] + 
                        I int[cxi, {x}] ** xi)/2 //. prodexpand /. 
                intconv[x] //. prodexpand //. sigmazeta], {muf, kappaa, 
          kappas}]

int[expr, {x}] //. prodexpand

Find terms in the Hamiltonian

This version leaves all of the integrations over momenta and position implicit.  Also, sums are implicit.

u[x_] := 
      1/Sqrt[2 Pi] (b[kf] Exp[-I kf x] + 
            sigma[1] ** Conjugate[d[kf]] Exp[
                I kf x])
m[x_, rho_] := 
      1/Sqrt[4 Pi] (a[ka, -rho] Exp[-I ka x] +  
              Conjugate[a[ka, rho]] Exp[I ka x])/
          Sqrt[ka]
kappaa /: Conjugate[kappaa] := kappaa
kappas /: Conjugate[kappas] := kappas
muf /: Conjugate[muf] := muf

This is to define the momenta variables to be *always * positive.

kl1 /: Positive[kl1] = True; kl2 /: Positive[kl2] = True; 
    kl3 /: Positive[kl3] = True; 
    kl4 /: Positive[kl4] = True;
kr1 /: Positive[kr1] = True; kr2 /: Positive[kr2] = True; 
    kr3 /: Positive[kr3] = True; kr4 /: Positive[kr4] = True;

Find Yukawa terms

xi =  
      Expand[muf/Sqrt[2] sigma[1] ** u[x] + 
                kappaa/Sqrt[2] sigma[1] ** zeta[rr] ** m[x, rr] ** u[x] - 
                kappas/Sqrt[2] sigma[1] ** m[x, sumrr] ** u[x] //. 
              prodexpand /. {zeta[rho_] ** 
                  a[c_, -rho_] -> -zeta[rho] ** a[c, rho], 
              a[b_, -sumrr] -> a[b, sumrr]} //. 
          prodexpand]

cxi = Conjugate[xi] /. {Conjugate[x] -> x, 
                Conjugate[ka] -> ka, Conjugate[kf] -> kf, 
                Conjugate[ka^n_] -> ka^n} /. {ka -> kka, 
              kf -> kks, rr -> ll, sumrr -> sumll} //. 
          prodexpand //. sigmazeta

expr1 = 
        Collect[relabel[
              Expand[(-I cxi ** Integrate[xi, x] + 
                          I Integrate[cxi, x] ** xi)/2 //. prodexpand //. 
                  sigmazeta]], {muf, kappaa, kappas}] //. 
          prodfactor;

Since the delta[...] is removed in the following, the integration region can be complicated.  expr2 contians all of the interactions in the Hamiltonian.

expr2 = 
      simpint[int[expr1, {x}] //. intsumexpand /. 
              Exp[x_] :> Exp[Factor[x]] /. 
            int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a] /. 
          delta[_?neverzero] -> 0, k11]

These are the 1->1 particle interactions:

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 2 || 
              Count[non, Conjugate[_]] != 1]

These are the 2->1 particle interactions

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 3 || 
              Count[non, Conjugate[_]] != 1]

These are the 1->2 particle interactions:

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 3 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 3->1 particle interactions:

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

expr2 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

Find gauge terms

jplus =  
      Expand[I m[x, rr] ** D[m[x, -rr] /. ka -> kaa, x] - 
                  I D[m[x, rr], 
                        x] ** (m[x, -rr] /. 
                          ka -> kaa) - (Conjugate[
                          u[x]] /. {Conjugate[x] -> x, 
                          Conjugate[kf] -> kf}) ** (u[x] /. 
                        kf -> kff) //. prodexpand /. 
              a[b_, -lambda_] ** Conjugate[a[c_, -lambda_]] -> 
                a[b, lambda] ** Conjugate[a[c, lambda]] //. prodexpand] //. 
        prodfactor

I don't use Expand[...] because it makes too many terms.

expr3 = 
        g^2/4 relabel[(jplus /. {ka -> la, kaa -> laa, 
                        rr -> ll, kf -> lf, 
                        kff -> lff}) ** (I Integrate[
                        I Integrate[jplus, x], x]) //. prodexpand] //. 
          prodfactor;

For the gauge interactions, the evaluation of the color indices is implicit and obeys the following rules:
If there are four adjoint fields, the color indices are evaluated as traces:
(Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 3]) (Subscript[a, 4])  ->  
        Tr {(Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 3]) (Subscript[a, 4])} - 
          Tr {(Subscript[a, 1]) (Subscript[a, 2])} Tr {(Subscript[a, 3]) (Subscript[a, 4])}/N
If there are two adjoint fields and two fundamental fields, the color indices are evaluated as:
(Subscript[a, 1]) (Subscript[a, 2]) (Subscript[b, 1]) (Subscript[b, 2])  ->  
        (Subscript[b, 1])·(Subscript[a, 1])·(Subscript[a, 2])·(Subscript[b, 2])  - 
          Tr {(Subscript[a, 1]) (Subscript[a, 2])}  (Subscript[b, 1])·(Subscript[b, 2])/N
If there are four fundamental fields, the color indices are evaluated as:
\(TraditionalForm\`\(\(\ \)\(b\ c\ d\ e\  -> \ 
        b\_i\ c\_j\ d\_k\ e\_l\ \((δ\_il\ δ\_kj\  - \ δ\_ij\ δ\_kl/N)\)\)\)\)

expr4 = 
      Distribute[int[expr3, {x}] //. intsumexpand /. 
              Exp[x_] :> Exp[Factor[x]] /. 
            int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
        delta[_?neverzero] -> 0

These are the 3->1 particle interactions:

expr4 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

expr4 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

expr4 /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

Gluon effective potential

I only include the terms that act on meson strings in the large N limit.

ka /: Positive[ka] = True; kb /: Positive[kb] = True; 
    kc /: Positive[kc] = True; kd /: Positive[kd] = True;

The (Subscript[µ, B]) term

The factor of 1/2 is from the fact that lambda is summing over four values

term = 
        mub^2/2 m[x, s1] ** (m[x, s1] /. ka -> kb);

expr = 
        relabel[Expand[term //. prodexpand /. {Conjugate[x] -> x, 
                  Conjugate[kk_?Positive] -> kk, 
                  Conjugate[kk_?Positive^n_] -> kk^n}] /. 
            aa_a ** Conjugate[b_] -> Conjugate[b] ** aa];

expr2 = 
      Distribute[int[expr, {x}] //. intsumexpand /. 
              Exp[x_] :> Exp[Factor[x]] /. 
            int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
        delta[_?neverzero] -> 0

The box term β

The implicit sums are s1={-1,1} and s2={-2,2}.  There is an overall factor of 1/4 since there are no sums in the original expression.

term = 
        m[x, sa] ** (m[x, sb] /. ka -> kb) ** 
          Conjugate[m[x, sa] /. ka -> kc] ** 
          Conjugate[m[x, -sb] /. ka -> kd];

exprb = 
        relabel[Expand[-beta/4 (term + Conjugate[term]) //. 
                  prodexpand /. {Conjugate[x] -> x, 
                  Conjugate[kk_?Positive] -> kk, 
                  Conjugate[kk_?Positive^n_] -> 
                    kk^n}] //. {c_ aa_a  **  b_ :> 
                c b ** aa /; MemberQ[b, Conjugate[_]], 
              c_ aa_  **  b_Conjugate :> 
                c b ** aa /; MemberQ[aa, a[__]]}];

exprbb = 
        Distribute[int[exprb, {x}] //. intsumexpand /. 
                Exp[x_] :> Exp[Factor[x]] /. 
              int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
          delta[_?neverzero] -> 0;

These are the 3->1 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

The (Subscript[λ, 1]) term

There is an implicit sum over the whole expression for s1={1,2,-1,-2}.  The factor of 1/2 is because s1 takes on all four values

term = 
        lambda1/2 m[x, sa] ** 
            Conjugate[
              m[x, sa] /. ka -> kb] ** (m[x, sa] /. ka -> kc) ** 
            Conjugate[m[x, sa] /. ka -> kd];

exprb = 
        relabel[Expand[term //. prodexpand /. {Conjugate[x] -> x, 
                  Conjugate[kk_?Positive] -> kk, 
                  Conjugate[kk_?Positive^n_] -> 
                    kk^n}] //. {c_ aa_a  **  b_ :> 
                c b ** aa /; MemberQ[b, Conjugate[_]], 
              c_ aa_  **  b_Conjugate :> 
                c b ** aa /; MemberQ[aa, a[__]]}];

exprbb = 
        Distribute[int[exprb, {x}] //. intsumexpand /. 
                Exp[x_] :> Exp[Factor[x]] /. 
              int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
          delta[_?neverzero] -> 0;

These are the 3->1 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

The (Subscript[λ, 2]) term

There is an implicit sum over the whole expression for s1={1,2,-1,-2}.  The factor of 1/2 is because s1 takes on all four values

term = 
        lambda2/2 m[x, sa] ** (m[x, sa] /. ka -> kb) ** 
            Conjugate[m[x, sa] /. ka -> kc] ** 
            Conjugate[m[x, sa] /. ka -> kd];

exprb = 
        relabel[Expand[term //. prodexpand /. {Conjugate[x] -> x, 
                  Conjugate[kk_?Positive] -> kk, 
                  Conjugate[kk_?Positive^n_] -> 
                    kk^n}] //. {c_ aa_a  **  b_ :> 
                c b ** aa /; MemberQ[b, Conjugate[_]], 
              c_ aa_  **  b_Conjugate :> 
                c b ** aa /; MemberQ[aa, a[__]]}];

exprbb = 
        Distribute[int[exprb, {x}] //. intsumexpand /. 
                Exp[x_] :> Exp[Factor[x]] /. 
              int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
          delta[_?neverzero] -> 0;

These are the 3->1 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

The (Subscript[λ, 4]) term

The implicit sums are s1={-1,1} and s2={-2,2}.

term = 
        lambda4 m[x, sa] ** 
            Conjugate[
              m[x, sa] /. ka -> kb] ** (m[x, sb] /. ka -> kc) ** 
            Conjugate[m[x, sb] /. ka -> kd];

exprb = 
        relabel[Expand[term //. prodexpand /. {Conjugate[x] -> x, 
                  Conjugate[kk_?Positive] -> kk, 
                  Conjugate[kk_?Positive^n_] -> 
                    kk^n}] //. {c_ aa_a  **  bb_ :> 
                c bb ** aa /; MemberQ[bb, Conjugate[_]], 
              c_ aa_  **  bb_Conjugate :> 
                c bb ** aa /; MemberQ[aa, a[__]]}];

exprbb = 
        Distribute[int[exprb, {x}] //. intsumexpand /. 
                Exp[x_] :> Exp[Factor[x]] /. 
              int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
          delta[_?neverzero] -> 0;

These are the 3->1 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

The (Subscript[λ, 4]) term (done more explicitly)

The implicit sums are s1={-1,1} and s2={-2,2}.

term = 
        lambda4 Sum[
            m[x, sa] ** 
              Conjugate[
                m[x, sa] /. ka -> kb] ** (m[x, sb] /. 
                  ka -> kc) ** 
              Conjugate[m[x, sb] /. ka -> kd], {sa, -1, 1, 
              2}, {sb, -2, 2, 4}];

exprb = 
        relabel[Expand[term //. prodexpand /. {Conjugate[x] -> x, 
                    Conjugate[kk_?Positive] -> kk, 
                    Conjugate[kk_?Positive^n_] -> 
                      kk^n}] //. {c_ aa_a  **  bb_ :> 
                  c bb ** aa /; MemberQ[bb, Conjugate[_]], 
                c_ aa_  **  bb_Conjugate :> 
                  c bb ** aa /; MemberQ[aa, a[__]]}] //. 
          prodfactor;

exprbb = 
        Distribute[int[exprb, {x}] //. intsumexpand /. 
                Exp[x_] :> Exp[Factor[x]] /. 
              int[Exp[a_ b_], {b_}] -> 2 Pi delta[I a]] /. 
          delta[_?neverzero] -> 0;

These are the 3->1 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 1]

These are the 2->2 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 2]

These are the 1->3 particle interactions:

exprbb /. 
      a_NonCommutativeMultiply :> 
        Block[{non = 
              a //. {sigma[_] ** c_ -> c, zeta[_] ** c_ -> c}}, 
          0 /; Length[non] ≠ 4 || 
              Count[non, Conjugate[_]] ≠ 3]

Junk