Rep.nb

A notebook for calculations of central functions of SL(2,C)-character varieties using representative functions.

W.Goldman, 16 December 2003

Preamble:

Turn off the annoying warning messages:

Off[General::"spell1"]
Off[General::"spell"]

A sample matrix:

Mm = {{a, b}, {c, d}};

Here are the heads for monomials in the symmetric algebra:

Protect[pp, PP, qq, QQ];
HHeadQ[x_]  :=  MemberQ[SymHeads = {pp, qq, QQ, PP}, x]

The Fricke slice

Here are the two elements of SL(2,C) which realize the character (x,y,z). We work in the quadratic extension C[x, y, z1, z2]  of  C[x,y,z] with embedding  given by 

	1 = z1 + z2
	z =  z1  z2

Xx  =  {{x, -1}, {1, 0}};  
    Yy  =  {{0, z1}, {-1 z2, y}};

Map[MatrixForm, 
      GeneratorList = {Xx,  Yy,  Zz  =  Xx . Yy}]

These three matrices have the desired traces:

Map[Tr, GeneratorList] /. {z1 z2  -> 1,  
        z2  ->  z - z1}

The function zPoly (defined below) implements this substitution to put all polynomials in terms of  the variables x, y, and z.

Bilinear and linear mappings

One basic operation is tensor product (⊗).  Bilinearity is its defining property:

Make it bilinear:

TensorProduct[X_  +  Y_, Z_ ]  :=  
      TensorProduct[X, Z]  +  TensorProduct[Y, Z]
TensorProduct[X_, Y_  +  Z_]  :=  
      TensorProduct[X, Y]  +  TensorProduct[X, Z]
TensorProduct[s_Integer  X_, Y_]  :=  
      s TensorProduct[X, Y]
TensorProduct[s_Rational  X_, Y_]  :=  
      s TensorProduct[X, Y]
TensorProduct[X_, s_Integer Y_]  :=  
      s TensorProduct[X, Y]
TensorProduct[X_, s_Rational Y_]  :=  
      s TensorProduct[X, Y]

Use this function to display tensor products using ⊗:

DisplayT[x_] := x /. (TensorProduct -> CircleTimes)

Example:

TensorProduct[4 x  +  5 y,  2 z  - 3 w]

TensorProduct[4 x  +  5 y,  2 z  - 3 w] // DisplayT

The bilinear map ScalarProduct implements duality:

ScalarProduct[X_  +  Y_, Z_ ]  :=  
      ScalarProduct[X, Z]  +  ScalarProduct[Y, Z]
ScalarProduct[X_, Y_  +  Z_]  :=  
      ScalarProduct[X, Y]  +  ScalarProduct[X, Z]
ScalarProduct[s_Rational  X_, Y_]  :=  
      s ScalarProduct[X, Y]
ScalarProduct[X_, s_Rational Y_]  :=  
      s ScalarProduct[X, Y]
ScalarProduct[s_Integer  X_, Y_]  :=  
      s ScalarProduct[X, Y]
ScalarProduct[X_, s_Integer Y_]  :=  
      s ScalarProduct[X, Y]

ScalarProduct[TensorProduct[a1_, b1_], TensorProduct[a2_, b2_]] := 
      ScalarProduct[a1, a2] ScalarProduct[b1, b2]

ScalarProduct[s_  f_[a___], Y_]  :=  
      s ScalarProduct[f[a], Y] /; HHeadQ[f]
ScalarProduct[X_, s_ f_[a___]]  :=  
      s ScalarProduct[X, f[a]] /; HHeadQ[f]

ScalarProduct implements the pairing between the symmetric power of a vector space and the symmetric power
of its dual. The (i^th) basic monomial (Subscript[ϕ, i]) in the (m^th) symmetric power (Subscript[V, m]) is the symmetrization of the (i^th) basic monomial in the (m^th) tensor power (⊗^m) V. In Mathematica we denote this element by pp[i,m].

Similarly, the dual (\(TraditionalForm\`\(\(\(⊗\^m 
                V\)\()\)\)\^*\)\ canonically\ identifies\ with\ \(⊗\^m\)\((\(V\^*\))\)\), we obtain a corresponding basis Φ\(TraditionalForm\`\(\(\_\(\(0\)\(,\)\(\ \)\(...\)\(,\)\(\ \)\)\)\(Φ\_\(\(m\)\(\ \)\)\)\)\)of \(TraditionalForm\`\(⊗\^m\((\(V\^*\))\)\)\)
obtained by symmetrizing basic monomials in \(TraditionalForm\`\(⊗\^m\((\(V\^*\))\)\)\) (denoted in Mathematica by PP[0,m], ..., PP[m,m]). However these bases are not dual,  due to the symmetrizations: The scalar product of (Subscript[ϕ, i])with (Subscript[Φ, j ])equals  (({{m}, {i}}))(Subscript[δ, ij]).

ScalarProduct[pp[i_, m_], PP[j_, n_]] := 
      If[i == j && m == n, 1/Binomial[m, i], 
        0]
ScalarProduct[qq[i_, m_], QQ[j_, n_]] := 
      If[i == j && m == n, 1/Binomial[m, i], 0]

GL(2) induces linear maps on the symmetric powers:

InducedMap[Mat_, X_  +  Y_ ]  :=  
      InducedMap[Mat, X ] +  InducedMap[Mat,  Y]
InducedMap[Mat_, s_Integer X_]  :=  s InducedMap[Mat, X]
InducedMap[Mat_, s_Rational X_]  :=  
      s InducedMap[Mat, X]

Internal tensor multiplication

The next function implement  internal multiplication of symmetric tensors:

TensorTimes[TensorProduct[a_[i1_, m1_], b_[j1_, n1_]], 
        TensorProduct[a_[i2_, m2_], 
          b_[j2_, n2_]]] := 
TensorProduct[
          a[i1 + i2, m1 + m2], b[j1 + j2, n1 + n2]] /; 
        HHeadQ[a] && HHeadQ[b]

TensorTimes[TensorProduct[pp[0, 0], QQ[1, 1]], 
        TensorProduct[pp[3, 3], QQ[4, 4]]] // DisplayT

Make it bilinear:

TensorTimes[X_ + Y_, Z_] := 
      TensorTimes[X, Z] + TensorTimes[Y, Z]
TensorTimes[X_, Y_ + Z_]  := 
      TensorTimes[X, Y] + TensorTimes[X, Z]
TensorTimes[s_ X_,  Y_]  :=  
      s TensorTimes[X, Y]
TensorTimes[X_, s_  Y_]  :=  s TensorTimes[X, Y]

Later on, we will want the following function to be linear:

EvalMatCoeff[X_ + Y_, {pMatrix_, qMatrix_}] := 
      EvalMatCoeff[X, {pMatrix, qMatrix}] + 
        EvalMatCoeff[Y, {pMatrix, qMatrix}]
EvalMatCoeff[s_Integer  X_, {pMatrix_, qMatrix_}] :=  
      s EvalMatCoeff[X, {pMatrix, qMatrix}]
EvalMatCoeff[s_Rational X_, {pMatrix_, qMatrix_}] := 
      s EvalMatCoeff[X, {pMatrix, qMatrix}]

Symmetric powers

The function SymmetricPower returns the action of an element of GL(2) on the (m^th) symmetric power (Subscript[V, m]). First we compute the induced map on the basis pp[i,m] of (Subscript[V, m]), and then we use the basis PP[i,m] of \(TraditionalForm\`\((\(V\^*\))\)\_m\) to compute matrix coefficients.

The next function provides a list corresponding to the basis of the symmetric monomials:

LList[f_, m_] := Map[f[#, m] &, Range[0, m]]

LList[pp, 3]

The function supplied by Mathematica for obtaining the coefficients of a polynomial
is inadequate if the polynomial has missing terms:

{CoefficientList[0 x^4  +  2 x^3  +  3 x  , x], 
      CoefficientList[0 x^4  +  2 x^3  +  3 x  +  4, x], 
      CoefficientList[x^4  +  2 x^3  +  3 x  +  4, x]}

NewCoefficientList[f_, xxx_, n_] :=  
      Map[Coefficient[xxx f, xxx^#] &, Range[1, n + 1]]

NewCoefficientList[0 x^4  +  2  x^3  +  3  x, x, 4]

The next function computes the map induced on a symmetric power by a 2x2 matrix Mat:

InducedMap[Mat_, f_[i_, m_]] := 
      Inner[Times, 
        NewCoefficientList[
          Expand[((Mat . {1, xx})[[1]])^(m - 
                    i) ((Mat . {1, xx})[[2]])^i], xx, m], 
        Map[f[#, m] &, Range[0, m]]]

InducedMap[Mm, pp[0, 2]]

InducedMap[Mm, pp[1, 1]]

The next function gives the symmetric power in terms of the bases of (Subscript[V, m])  and \(TraditionalForm\`\((\(V\^*\))\)\_m\).

SymmetricPower[Mat_, m_] := 
      Outer[ScalarProduct, Map[InducedMap[Mat, #] &, LList[pp, m]], 
        LList[PP, m]]

Map[MatrixForm[SymmetricPower[Mm, #]] &, Range[0, 3]]

Recall that the (((i, j))^th) entry (Subscript[M, i j ])  =  
        M[[i, j]]  ((i^(th )) row,  
        (j^(th )) column)  of a matrix M equals the (i^(th ))basic covector evaluated on the image of the (j^(th )) basis vector under M.

(P2 = {0, 1}) . MatrixForm[Mm] . MatrixForm[p1]  == 
      MatrixForm[P2 . Mm . (p1 = {1, 0})]

Mm[[2, 1]]

The Clebsch-Gordan Summand

Suppose integers m, n, and r satisfy  0 ≤ m, n, r. Then the representation (Subscript[V, r]) includes into (Subscript[V, m])⊗ (Subscript[V, n]) if and only if  |m-n| ≤  r ≤  m+n and  m+n-r even. In that case the inclusion is
unique, and the Clebsch-Gordan summand (Subscript[V, r]^(m, n)) is the image of the inclusion
of  the representation (Subscript[V, r]) into (Subscript[V, m])⊗ (Subscript[V, n]).

The following tests whether a summand exists.

ClebschGordanQ[{m_, n_, r_}] := 
      IntegerQ[m] && IntegerQ[n] && IntegerQ[r] && m ≥ 0 && 
        n ≥ 0 && r ≥ 0 &&  
        IntegerQ[(m + n - r)/2] &&  (r ≤  m + n)  &&  
        Abs[m - n] ≤ r

ClebschGordanQ[{2, 2, 2}]

The following is the syntax for including summands in the tensor product

IncludeSummand[{m_, n_, r_}, k_] := 
      IncludeSummand[{m, n, r}, k, {pp, qq}] /; 
        ClebschGordanQ[{m, n, r}] &&  0 ≤ k && 
          k ≤ r
IncludeSummand[{m_, n_, r_}] := 
      Map[IncludeSummand[{m, n, r}, #] &, Range[0, r]]

Denote the basis of (Subscript[V, m]) by (Subscript[φ, 0]) , ..., (Subscript[φ, m]) , \(\(the\)\(\ \)\(basis\)\(\ \)\(of\)\(\ \)\(V\_n\)\(\ \)\(by\)\(\ \)\)\(TraditionalForm\`ψ\_\(\(0\)\(,\)\(\ \)\) ... , ψ\_n\ \ \ and\ the\ basis\ of\) (Subscript[V, r]) by 
\(TraditionalForm\`τ\_\(\(0\)\(,\)\(\ \)\)\  ... , \ \(\(τ\_r\)\(.\)\(\ \ \)\)\) If r = m + n,  the inclusion (Subscript[V, r]) into (Subscript[V, m])⊗ (Subscript[V, n]) is given by

                                        (({{m + n}, {k}}))(Subscript[τ, k       ])↦  (∑_( 0 ≤  i ≤ 
                m

               0 ≤ j ≤ n

               i + j = k))    (({{m}, {i}}))  (Subscript[φ, i])  ⊗   (({{n}, {j}}))(Subscript[ψ, j ])

IncludeSummand[{m_, n_, r_}, k_, {a_, b_}] := 
      Apply[Plus, 
          Map[
Binomial[m, #] 
                Binomial[n, k - #]/Binomial[m + n, k] TensorProduct[a[#, m], 
                  b[k - #, n]]
 &, Range[0, m + n]]] /; 
        ClebschGordanQ[{m, n, r}] && (r == m + n) && HHeadQ[a] && 
          HHeadQ[b]

IncludeSummand[{1, 1, 2}] // DisplayT // MatrixForm

In general the inclusion (Subscript[V, r]) into (Subscript[V, m])⊗ (Subscript[V, n]) is given by
 (({{r}, {k}}))(Subscript[τ, k ])↦  (  (∑_( 0 ≤  i ≤ 
              m - s

             0 ≤ j ≤ n - s

             i + j = k))   (({{m - s}, {i}})) (Subscript[φ, i])  ⊗   (({{n - s}, {j}}))(Subscript[ψ, j ])) ((( (Subscript[φ, 0])⊗ (Subscript[ψ, 1 ])-  (Subscript[φ, 1])⊗ (Subscript[ψ, o ])))^s)
      where 0 ≤ k ≤ r,  s = (m + n - r) /2 and multiplication is internal mutiplication of tensors.

SymDetTensor[{a_, b_}] := 
      TensorProduct[a[0, 1], b[1, 1]] - TensorProduct[a[1, 1], b[0, 1]] /; 
        HHeadQ[a] && HHeadQ[b]

TensorTimesSymDetTensor[t_, n_, {a_, b_}]  :=  
      Nest[TensorTimes[SymDetTensor[{a, b}], #] &, t, n] /; 
        HHeadQ[a] && HHeadQ[b]

IncludeSummand[{m_, n_, r_}, k_, {a_, b_}] := 
      Module[{s  =  (m + n  - r)/
                2},  
TensorTimesSymDetTensor[
            IncludeSummand[{m - s, n - s, r}, k, {a, b} ], s, {a, b}] ] /; 
        HHeadQ[a] && HHeadQ[b]

Including the Dual Summand

DualSummandsInnerProduct[{m_, n_, r_}, k_] := 
      ScalarProduct[IncludeSummand[{m, n, r}, k], 
        IncludeSummand[{m, n, r}, k, {PP, QQ}]]

Map[DualSummandsInnerProduct[{2, 1, 3}, #] &, Range[0, 3]]

IncludeDualSummand[{m_, n_, r_}] := 
      Map[IncludeDualSummand[{m, n, r}, #] &, Range[0, r]]

IncludeDualSummand[{m_, n_, r_}, k_] := 
      Expand[IncludeSummand[{m, n, r}, k, {PP, QQ}]/
          DualSummandsInnerProduct[{m, n, r}, k]]

IncludeDualSummand[{m_, n_, r_}] := 
      Map[IncludeDualSummand[{m, n, r}, #] &, Range[0, r]]

Computing Central Functions

EvalMatCoeff[
        TensorProduct[TensorProduct[pp[i1_, m_], qq[j1_, n_]], 
          TensorProduct[PP[i2_, m_], 
            QQ[j2_, n_]] 
]] := SymmetricPower[Xx, 
            m][[i2 + 1, i1 + 1]] SymmetricPower[Yy, n][[j2 + 1, 
            j1 + 1]]

EvalMatCoeff[
        TensorProduct[TensorProduct[pp[i1_, m_], qq[j1_, n_]], 
          TensorProduct[PP[i2_, m_], 
            QQ[j2_, n_]] 
], {pMatrix_, qMatrix_}] := 
      pMatrix[[i2 + 1, i1 + 1]] qMatrix[[j2 + 1, j1 + 1]]

pqMatrix[{m_, n_, r_}] := {SymmetricPower[Xx, m], 
        SymmetricPower[Yy, n]}

The sample matrices X, Y are defined over the quadratic extension  of the polynomial ring
C[x,y,z] generated by  z1, z2 such that   z1 z2 = 1 and z1 + z2 = z. The routine zPoly expresses a polynomial in x, y, z1, z2 which is symmetric in z1 and z2 as a polynomial in x, y, z.

The next routine gives the term without any z's.

ConstantTerm[f_] := 
      Coefficient[Coefficient[f, z1, 0], z2, 0]

The (n^th) Chebychev polynomial Cheb[n,z] expresses \(TraditionalForm\`\((z1)\)\^n\  + \ \((z2)\)\^n\ as\ a\ polynomial\ in\ z\  = \ z1\  + \ z\)2 where z1 z2 = 1.

Cheb[0, z_] = 2;
Cheb[1, z_]  =  z;
Cheb[n_, z_]  :=  
      Expand[z Cheb[n - 1, z]  -  Cheb[n - 2, z]]

zPoly[f_] :=  
      Module[{f1 = f /. { z2  ->  1/z1}}, 
        Expand[ConstantTerm[f1] + 
            Apply[Plus, 
              Map[Cheb[#, z] Coefficient[f1, z1, #] &, 
                Range[Exponent[f, z1]]]]]]

Put it all together:

Casimir[{m_, n_, r_}] := 
      Inner[TensorProduct, IncludeSummand[{m, n, r}], 
        IncludeDualSummand[{m, n, r}]]

CentralFunction[{m_, n_, r_}] := 
      zPoly[EvalMatCoeff[Casimir[{m, n, r}], pqMatrix[{m, n, r}]]]

Central[m_, n_, r_] := CentralFunction[{m, n, r}]

Some Calculations:

{c000, c101, c011} = {Central[0, 0, 0], Central[1, 0, 1], 
        Central[0, 1, 1]}

({c202, c112, c110, c022} = {Central[2, 0, 2], Central[1, 1, 2], 
            Central[1, 1, 0], Central[0, 2, 2]}) // MatrixForm

({c303, c213, c211, c123, c121, c033} = {Central[3, 0, 3], 
            Central[2, 1, 3], Central[2, 1, 1], Central[1, 2, 3], 
            Central[1, 2, 1], Central[0, 3, 3]}) // MatrixForm

MatrixForm[{c404, c044} = {Central[4, 0, 4], 
          Central[0, 4, 4]}]

Central[3, 1, 2]

MatrixForm[{c314, c312} = {Central[3, 1, 4], 
          Central[3, 1, 2]}]

MatrixForm[{c224, c222, c220} = {Central[2, 2, 4], Central[2, 2, 2], 
          Central[2, 2, 0]}]

MatrixForm[{c134, c132} = {Central[1, 3, 4], 
          Central[1, 3, 2]}]

Central[0, 5, 5]

{(Map[Central[1, 4, #] &, {5, 3}] // 
          MatrixForm), (Map[Central[2, 3, #] &, {5, 3, 1}] // 
          MatrixForm)}

Map[Central[2, 3, #] &, {5, 3, 1}] // MatrixForm

Here are some  trace polynomials, written as linear combinations of central functions:

Map[Expand, {c101, c011, c112 - c110}]

Map[
      Expand, {2 c110, c213 -  1/2 c211  -  1/2 c011, 
        c123  -  1/2 c121  -  1/2 c101}]

Expand[-c222  +  3/2  c220  +  1/2 c202  +  
        1/2 c022  +  1/2]

New Stuff

c112  +  c110

c112

ToC[x] = Cent[{1, 0, 1}]; ToC[y] = Cent[{0, 1, 1}]; 
    ToC[x^2] = Cent[{2, 0, 2}] + Cent[{0, 0, 0}]; 
    ToC[1]  =  Cent[{0, 0, 0}]; ToC[z] = Cent[{1, 1, 2}] - Cent[{1, 1, 0}]; 
    ToC[y^2]  =  Cent[{0, 2, 0}]  +  Cent[{0, 0, 0}];  
    ToC[x y] = Cent[{1, 1, 2}] + Cent[{1, 1, 0}];

c213  +  c211  +  c011

ToC[x z]  =  
        Cent[{2, 1, 3}]  - 1/2 Cent[{2, 1, 1}]  +  
          1/2 Cent[{0, 1, 1}];

ToC[y z]  =  
      Cent[{1, 2, 3}]  -  1/2 Cent[{1, 2, 1}]  +  
        1/2 Cent[{1, 0, 1}]

{c110, c220, c330 = Central[3, 3, 0], 
      c440 = Central[4, 4, 0]}

RestrictToDiagonal[f_] := 
      Expand[f /. {y -> x, z -> x^2 - 2}]

RestrictToDiagonal[c213]

RestrictToX[f_] := Expand[f /. {y -> 2, z -> x}]

Map[RestrictToX, {c110, c112, c213, c211, c123, c121}]

Map[
      RestrictToDiagonal, {c110, c112, c213, c211, c123, c121}]

XRes[m_, n_, r_] := 
      Expand[ RestrictToX[
            Central[m, n, r]]  - (r + 1)/(m + 1) Central[m, 0, 
              m]]

XRes[5, 5, 6]

{3 c123, 3 c121} // Expand

Expand[c011 c112  -  3/4 c121]

Expand[c011 c112]

c123

Expand[c011 c112 - 3/2 c123]

ToC[y z]

c101  -  c121  +  2 c123 // Expand

Expand[
      c011 c112 - 3/2 c123  - c101  +  1/4 c101  -  1/4 c121  +  
        1/2 c123]

Expand[
      c011 c112 -  c123  - 3/4 c101   -  1/4 c121 ]

Expand[{c011 c110 ,  c121} ]

Expand[{c011 c110   - 3/4 c121} ]

Expand[{c011 c220 , c231}] // MatrixForm

Expand[{c011 c220  - 2/3 c231 - 1/3  c211}]

c321 = Central[3, 2, 1]

c330

Expand[{y c330, c341 = Central[3, 4, 1]}] // MatrixForm

Expand[{y c330  - 5/8 c341, c321}] // MatrixForm

Expand[y c330  - 5/8 c341  - 3/8  c321]

MatrixForm[Expand[{y c211, c222, c220, c202}]]

Expand[y c211  -  c220  -  2/3  c222  -  1/3 c202]

MatrixForm[Expand[{y c121, c132}]]

MatrixForm[Expand[{y c121 - 8/9 c132, c112, c110}]]

Central[2, 5, 7]

Expand[y c202  -  c213  -  c211]

Expand[
      y c303  -  (c314 =  Central[3, 1, 4])  -  (c312 = 
            Central[3, 1, 2])]

Expand[y c121  - 8/9 c132  - 1/9 c112  -  c110]

MatrixForm[
      Expand[{y c213, c222, c220, c202,  2 c222  +  3 c220,  c224, 
          c112}]]

MatrixForm[Expand[{3 y c213  + c220}]]

MatrixForm[Expand[{y c213,  c224,  c222,  c220}]]

Collect[
      Expand[ y c213  -  a c224  -  b c222  -  c c220], {x, y, 
        z}]

Solve[{((1/3) - (a/6) - (b/2) - (c/3)) == 
          0, ((2/3) - ((2 a)/3) + ((2 c)/3)) == 
          0, (-(a/6) + (b/2) - (c/3)) == 0}, {a, b, 
        c}]

Expand[ 
      y c213  -   c224  -  1/3 c222   -  2/3 c202]

MatrixForm[
      Expand[{y c123,  c134  =  Central[1, 3, 4], c132, c112, 
          c110}]]

Collect[y c123    -  a c134  -  b c132, {x, y, z}]

Solve[{((1/3) - (a/4) - ((3 b)/4)) == 
          0, ((2/3) - ((3 a)/4) + ((3 b)/4)) == 0}, {a, 
        b, }]

Expand[y c123  -  c134  -  1/9 c132 -  8/9 c112]

Test[m_, 
        n_] := (0 ==  
          Expand[Central[0, n, n] Central[m, 0, m] ] - 
            Expand[Apply[Plus, 
                Map[Central[m, n, #] &, 
                  Range[Abs[m - n], m + n, 2]]]])

{Test[7, 5], Test[6, 6]}

Recursion limit 256 exceeded for larger values