Weaver_examples.nb

(* Content-type: application/vnd.wolfram.mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 10.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       158,          7]
NotebookDataLength[     96981,       2596]
NotebookOptionsPosition[     91777,       2435]
NotebookOutlinePosition[     92185,       2453]
CellTagsIndexPosition[     92142,       2450]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Examples of use for the Weaver package", "Title",
 CellChangeTimes->{{3.621719866329341*^9, 3.6217198751051292`*^9}, {
   3.62309463321507*^9, 3.6230946361153507`*^9}, 3.6264749508949633`*^9}],

Cell[TextData[{
 "In the following, we demonstrate usage of the Weaver package using a few \
examples: the Virasoro algebra and the SW(3/2,2) algebra.\n\nTo begin, verify \
that the file Weaver.m is in ",
 StyleBox["Mathematica",
  FontSlant->"Italic"],
 "\[CloseCurlyQuote]s path or append ",
 "Weaver",
 "\[CloseCurlyQuote]s path to the $Path variable."
}], "Text",
 CellChangeTimes->{{3.62171990055525*^9, 3.6217199126016407`*^9}, {
  3.621719948132114*^9, 3.621720062014834*^9}, {3.621789663118786*^9, 
  3.621789683708486*^9}, {3.621970634200534*^9, 3.621970657262637*^9}, {
  3.623094648543169*^9, 3.623094654324007*^9}, {3.626474950957263*^9, 
  3.62647495108148*^9}}],

Cell[CellGroupData[{

Cell["Virasoro Algebra", "Section",
 CellChangeTimes->{{3.621720091427079*^9, 3.621720095553124*^9}}],

Cell["\<\
Import the package.  This needs to be done with every change of algebra or \
module: reimporting the package clears saved intermediate results.\
\>", "Text",
 CellChangeTimes->{{3.6217201416837673`*^9, 3.621720190850305*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"<<", "Weaver.m"}]], "Input",
 CellChangeTimes->{{3.6217201052529078`*^9, 3.6217201287225723`*^9}, 
   3.621966791282241*^9, 3.6264749511037397`*^9}],

Cell[BoxData["\<\"Weaver: a package for explicit exact-arithmetic \
calculations in W-algebras\"\>"], "Print",
 CellChangeTimes->{3.626476219681512*^9}]
}, Open  ]],

Cell[TextData[{
 "Start by defining the algebra.  Recall that the Virasoro algebra is \
generated by the operator ",
 Cell[BoxData[
  FormBox[
   SubscriptBox["L", "n"], TraditionalForm]]],
 "for integer n.  New fields can be introduced through the command, \
AddOperator[operator_name, fermionness, grading, conformal_weight].  The \
parameters are \n\noperator_name: the symbol indicating the field.\n\
fermionness:\tTrue if the operator is a fermion and False otherwise\ngrading:\
\tis n such that the operator takes components in n+Z\nconformal weight: the \
conformal weight of the field."
}], "Text",
 CellChangeTimes->{{3.621720199847912*^9, 3.621720225603175*^9}, {
  3.621720974529346*^9, 3.621721041666127*^9}, {3.621721200267921*^9, 
  3.62172133106583*^9}, {3.621721408186598*^9, 3.621721511897422*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"AddOperator", "[", 
   RowBox[{"L", ",", "False", ",", "0", ",", "2"}], "]"}], ";"}]], "Input",
 CellChangeTimes->{{3.62172157006824*^9, 3.621721580457041*^9}}],

Cell["\<\
The commutation relations need to be defined explicitly.  The information is \
given by defining Commutator on the symbols of the operators involved.  \
Generating sets need to be provided for the various operators.\
\>", "Text",
 CellChangeTimes->{{3.621721610463179*^9, 3.621721635480475*^9}, {
   3.6217217341177*^9, 3.6217217787755823`*^9}, {3.621724165425214*^9, 
   3.621724190209907*^9}, 3.621884035710866*^9}],

Cell[BoxData[{
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"L", ",", "n_", ",", "L", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"(", 
     RowBox[{"n", "-", "m"}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"L", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    RowBox[{"c", "/", "12"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "3"}], "-", "n"}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"m", "+", "n"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"MinimalGeneratorsCreation", "=", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"L", ",", 
       RowBox[{"-", "1"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"L", ",", 
       RowBox[{"-", "2"}]}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"MinimalGeneratorsAnnihilation", "=", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"L", ",", "1"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"L", ",", "2"}], "}"}]}], "}"}]}], ";"}]}], "Input",
 CellChangeTimes->{{3.621721655164341*^9, 3.621721655434581*^9}, {
   3.62172419206811*^9, 3.62172421702871*^9}, 3.621884035729854*^9}],

Cell["\<\
The modules of the Virasoro algebra are generated by a highest weight \
subspace of dimension 1:\
\>", "Text",
 CellChangeTimes->{{3.621721791860523*^9, 3.6217218289990587`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"HighestWeightDimension", "=", "1"}], ";"}]], "Input",
 CellChangeTimes->{{3.621721783877906*^9, 3.621721788407537*^9}}],

Cell["\<\
This is sufficient to define the algebra.  There are a few basic operations \
that can be explored.  States in the Verma module are written as vectors, \
each of which corresponds to a series of operators acting on the highest \
weight space.  Consider the basis states at level 3:\
\>", "Text",
 CellChangeTimes->{{3.621721841954073*^9, 3.621721918840394*^9}, {
  3.621722034013296*^9, 3.6217221119542627`*^9}, {3.6217221515426273`*^9, 
  3.621722164111129*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"StateNames", "[", "3", "]"}]], "Input",
 CellChangeTimes->{{3.6217221140756483`*^9, 3.621722117609106*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"L", ",", 
        RowBox[{"-", "3"}]}], "}"}], "}"}], ",", "1"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"L", ",", 
         RowBox[{"-", "2"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"L", ",", 
         RowBox[{"-", "1"}]}], "}"}]}], "}"}], ",", "1"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"L", ",", 
         RowBox[{"-", "1"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"L", ",", 
         RowBox[{"-", "1"}]}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"L", ",", 
         RowBox[{"-", "1"}]}], "}"}]}], "}"}], ",", "1"}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{{3.621722118174217*^9, 3.621722124191946*^9}, 
   3.621724217813037*^9, {3.6217242766968813`*^9, 3.621724297419361*^9}, {
   3.6217243466290092`*^9, 3.621724373280995*^9}, {3.6217244036066628`*^9, 
   3.621724412333035*^9}, 3.62178609538748*^9, 3.6219668002116537`*^9, 
   3.621966843014167*^9, 3.626476227851788*^9}]
}, Open  ]],

Cell[TextData[{
 "Each state is described as a pair {operators, i}, which gives the operators \
acting on the ith highest weight state.  For example, the state \
{{{L,-2},{L,-1}},1} is L",
 StyleBox["-2",
  FontSize->12],
 "L",
 StyleBox["-1",
  FontSize->12],
 "|1>.  In order to find the vector associated to this state, you can call"
}], "Text",
 CellChangeTimes->{{3.6217221567454557`*^9, 3.62172227341581*^9}, {
  3.6217223829258003`*^9, 3.6217224437085857`*^9}, {3.621722482250884*^9, 
  3.62172248894683*^9}, {3.621796704511333*^9, 3.621796711997504*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"StateVector", "[", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"L", ",", 
        RowBox[{"-", "2"}]}], "}"}], ",", 
      RowBox[{"{", 
       RowBox[{"L", ",", 
        RowBox[{"-", "1"}]}], "}"}]}], "}"}], ",", "1"}], "}"}], 
  "]"}]], "Input",
 CellChangeTimes->{{3.621722490237096*^9, 3.621722500753948*^9}, {
  3.621722577738958*^9, 3.621722585986986*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", "1", ",", "0"}], "}"}]], "Output",
 CellChangeTimes->{
  3.621722586232367*^9, 3.621724217835835*^9, {3.6217242767237988`*^9, 
   3.621724297468247*^9}, {3.621724346691002*^9, 3.6217243733093147`*^9}, {
   3.621724403640329*^9, 3.621724412356936*^9}, 3.621786095454708*^9, 
   3.6219668002376537`*^9, 3.6219668430742207`*^9, 3.6264762295216722`*^9}]
}, Open  ]],

Cell[TextData[{
 "The action of a given operator on the states at this level is given by the \
Operator[L,n,level] command, which gives the action of the operator L",
 StyleBox["n",
  FontSize->12],
 " acting on the states at level n.  For example, the action of the operator \
L",
 StyleBox["1 ",
  FontSize->12],
 "on the states at level 3 is:"
}], "Text",
 CellChangeTimes->{{3.6217226802681007`*^9, 3.621722694515018*^9}, {
  3.621722742778817*^9, 3.6217227991469717`*^9}, {3.6217228567391157`*^9, 
  3.621722954854298*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"Operator", "[", 
   RowBox[{"L", ",", "1", ",", "3"}], "]"}], "//", "MatrixForm"}]], "Input",
 CellChangeTimes->{{3.62172285790066*^9, 3.621722865421056*^9}, {
  3.621722900462356*^9, 3.62172290212274*^9}}],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {"4", 
      RowBox[{"2", " ", 
       RowBox[{"L", "[", "0", "]"}]}], "0"},
     {"0", "3", 
      RowBox[{
       RowBox[{"2", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"2", " ", 
        RowBox[{"(", 
         RowBox[{"1", "+", 
          RowBox[{"L", "[", "0", "]"}]}], ")"}]}], "+", 
       RowBox[{"2", " ", 
        RowBox[{"(", 
         RowBox[{"2", "+", 
          RowBox[{"L", "[", "0", "]"}]}], ")"}]}]}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{{3.621722895655383*^9, 3.621722902390903*^9}, 
   3.6217242178662148`*^9, {3.621724276766576*^9, 3.6217242975180883`*^9}, {
   3.621724346741082*^9, 3.6217243733537083`*^9}, {3.621724403661731*^9, 
   3.62172441239744*^9}, 3.6217860955630617`*^9, 3.6219668002877283`*^9, 
   3.621966843124154*^9, 3.6264762310220346`*^9}]
}, Open  ]],

Cell[TextData[{
 "Here, L[0] is the L",
 StyleBox["0",
  FontSize->12],
 " eigenvalue of the highest weight state.  There are some useful \
calculations that can be performed easily once the operators are evaluated.  \
The Gram matrix and the Kac Determinant at level 4 are given by"
}], "Text",
 CellChangeTimes->{{3.6217231535293093`*^9, 3.621723189697556*^9}, {
  3.6217233248697033`*^9, 3.621723392654214*^9}, {3.6217764342593203`*^9, 
  3.621776436785411*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"GramMatrix", "[", "4", "]"}], "//", 
  "MatrixForm"}], "\[IndentingNewLine]", 
 RowBox[{"Factor", "@", 
  RowBox[{"Det", "@", "%"}]}]}], "Input",
 CellChangeTimes->{{3.621723395474579*^9, 3.621723412718972*^9}, {
  3.621723459142874*^9, 3.621723459974556*^9}, {3.621723493013047*^9, 
  3.6217234993415127`*^9}}],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      RowBox[{
       RowBox[{"5", " ", "c"}], "+", 
       RowBox[{"8", " ", 
        RowBox[{"L", "[", "0", "]"}]}]}], 
      RowBox[{"14", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"3", " ", "c"}], "+", 
       RowBox[{"24", " ", 
        RowBox[{"L", "[", "0", "]"}]}]}], 
      RowBox[{"36", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{"120", " ", 
       RowBox[{"L", "[", "0", "]"}]}]},
     {
      RowBox[{"14", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"12", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"4", " ", "c", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"12", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{"30", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"20", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"40", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"48", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"192", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}]},
     {
      RowBox[{
       RowBox[{"3", " ", "c"}], "+", 
       RowBox[{"24", " ", 
        RowBox[{"L", "[", "0", "]"}]}]}], 
      RowBox[{"30", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"4", " ", "c"}], "+", 
       FractionBox[
        SuperscriptBox["c", "2"], "2"], "+", 
       RowBox[{"32", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"8", " ", "c", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"32", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"48", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"6", " ", "c", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"48", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"144", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"216", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}]},
     {
      RowBox[{"36", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"20", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"40", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"48", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"6", " ", "c", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"48", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"32", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"2", " ", "c", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"116", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}], "+", 
       RowBox[{"4", " ", "c", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}], "+", 
       RowBox[{"32", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "3"]}]}], 
      RowBox[{
       RowBox[{"96", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"336", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}], "+", 
       RowBox[{"288", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "3"]}]}]},
     {
      RowBox[{"120", " ", 
       RowBox[{"L", "[", "0", "]"}]}], 
      RowBox[{
       RowBox[{"48", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"192", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"144", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"216", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}]}], 
      RowBox[{
       RowBox[{"96", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"336", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}], "+", 
       RowBox[{"288", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "3"]}]}], 
      RowBox[{
       RowBox[{"288", " ", 
        RowBox[{"L", "[", "0", "]"}]}], "+", 
       RowBox[{"1056", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "2"]}], "+", 
       RowBox[{"1152", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "3"]}], "+", 
       RowBox[{"384", " ", 
        SuperscriptBox[
         RowBox[{"L", "[", "0", "]"}], "4"]}]}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{{3.621723401188003*^9, 3.6217234129739313`*^9}, 
   3.6217234607825937`*^9, {3.621723493648362*^9, 3.6217234997412558`*^9}, 
   3.621724217889698*^9, {3.621724276817039*^9, 3.6217242975700502`*^9}, {
   3.621724346792425*^9, 3.6217243734053087`*^9}, {3.6217244037068872`*^9, 
   3.621724412448927*^9}, 3.621786095783091*^9, 3.621966800358355*^9, 
   3.621966843182248*^9, 3.6264762345634947`*^9}],

Cell[BoxData[
 RowBox[{"384", " ", 
  SuperscriptBox[
   RowBox[{"L", "[", "0", "]"}], "3"], " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"-", "1"}], "+", "c", "+", 
    RowBox[{"8", " ", 
     RowBox[{"L", "[", "0", "]"}]}]}], ")"}], " ", 
  RowBox[{"(", 
   RowBox[{"2", "+", "c", "-", 
    RowBox[{"7", " ", 
     RowBox[{"L", "[", "0", "]"}]}], "+", 
    RowBox[{"c", " ", 
     RowBox[{"L", "[", "0", "]"}]}], "+", 
    RowBox[{"3", " ", 
     SuperscriptBox[
      RowBox[{"L", "[", "0", "]"}], "2"]}]}], ")"}], " ", 
  SuperscriptBox[
   RowBox[{"(", 
    RowBox[{"c", "-", 
     RowBox[{"10", " ", 
      RowBox[{"L", "[", "0", "]"}]}], "+", 
     RowBox[{"2", " ", "c", " ", 
      RowBox[{"L", "[", "0", "]"}]}], "+", 
     RowBox[{"16", " ", 
      SuperscriptBox[
       RowBox[{"L", "[", "0", "]"}], "2"]}]}], ")"}], "2"], " ", 
  RowBox[{"(", 
   RowBox[{"66", "+", 
    RowBox[{"15", " ", "c"}], "-", 
    RowBox[{"82", " ", 
     RowBox[{"L", "[", "0", "]"}]}], "+", 
    RowBox[{"10", " ", "c", " ", 
     RowBox[{"L", "[", "0", "]"}]}], "+", 
    RowBox[{"16", " ", 
     SuperscriptBox[
      RowBox[{"L", "[", "0", "]"}], "2"]}]}], ")"}]}]], "Output",
 CellChangeTimes->{{3.621723401188003*^9, 3.6217234129739313`*^9}, 
   3.6217234607825937`*^9, {3.621723493648362*^9, 3.6217234997412558`*^9}, 
   3.621724217889698*^9, {3.621724276817039*^9, 3.6217242975700502`*^9}, {
   3.621724346792425*^9, 3.6217243734053087`*^9}, {3.6217244037068872`*^9, 
   3.621724412448927*^9}, 3.621786095783091*^9, 3.621966800358355*^9, 
   3.621966843182248*^9, 3.626476234864449*^9}]
}, Open  ]],

Cell["\<\
Certain other operations are performed more easily without manipulation of \
symbolic variables.  Specialize now to the Ising model.  The Ising model is a \
minimal module of the Virasoro algebra, and is isomorphic to the \
corresponding Verma module quotiented by the nullspace of the Gram matrix.  \
The character of the minimal model is given by\
\>", "Text",
 CellChangeTimes->{{3.6217234756536407`*^9, 3.621723537452606*^9}, {
  3.621723654069621*^9, 3.621723816477757*^9}, {3.621723903461523*^9, 
  3.621723904053473*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"c", "=", 
    RowBox[{"1", "/", "2"}]}], ";", " ", 
   RowBox[{
    RowBox[{"L", "[", "0", "]"}], "=", "0"}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"q", "^", 
   RowBox[{"(", 
    RowBox[{
     RowBox[{"-", "c"}], "/", "24"}], ")"}]}], " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"Sum", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"q", "^", "n"}], " ", 
       RowBox[{"MatrixRank", "@", 
        RowBox[{"GramMatrix", "@", "n"}]}]}], ",", 
      RowBox[{"{", 
       RowBox[{"n", ",", "0", ",", "9"}], "}"}]}], "]"}], "+", 
    RowBox[{
     RowBox[{"O", "[", "q", "]"}], "^", "10"}]}], ")"}]}]}], "Input",
 CellChangeTimes->{{3.621723538816257*^9, 3.621723542805933*^9}, {
  3.621723820327156*^9, 3.621723893053664*^9}, {3.62179183732763*^9, 
  3.621791852911531*^9}, {3.621792066054549*^9, 3.621792070725209*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{
   FractionBox["1", 
    SuperscriptBox["q", 
     RowBox[{"1", "/", "48"}]]], "+", 
   SuperscriptBox["q", 
    RowBox[{"95", "/", "48"}]], "+", 
   SuperscriptBox["q", 
    RowBox[{"143", "/", "48"}]], "+", 
   RowBox[{"2", " ", 
    SuperscriptBox["q", 
     RowBox[{"191", "/", "48"}]]}], "+", 
   RowBox[{"2", " ", 
    SuperscriptBox["q", 
     RowBox[{"239", "/", "48"}]]}], "+", 
   RowBox[{"3", " ", 
    SuperscriptBox["q", 
     RowBox[{"287", "/", "48"}]]}], "+", 
   RowBox[{"3", " ", 
    SuperscriptBox["q", 
     RowBox[{"335", "/", "48"}]]}], "+", 
   RowBox[{"5", " ", 
    SuperscriptBox["q", 
     RowBox[{"383", "/", "48"}]]}], "+", 
   RowBox[{"5", " ", 
    SuperscriptBox["q", 
     RowBox[{"431", "/", "48"}]]}], "+", 
   InterpretationBox[
    SuperscriptBox[
     RowBox[{"O", "[", "q", "]"}], 
     RowBox[{"479", "/", "48"}]],
    SeriesData[$CellContext`q, 0, {}, -1, 479, 48],
    Editable->False]}],
  SeriesData[$CellContext`q, 0, CompressedData["
1:eJxTTMoPSmJkYGDYCCRANC0BqeaTqp6JxuqZaayelVT1ABpZAnE=
   "], -1, 479, 48],
  Editable->False]], "Output",
 CellChangeTimes->{{3.62172388921933*^9, 3.621723893355019*^9}, 
   3.621724217948827*^9, {3.621724276891143*^9, 3.621724297678645*^9}, {
   3.62172434686866*^9, 3.6217243734586554`*^9}, {3.6217244077126017`*^9, 
   3.6217244133485537`*^9}, 3.621786096912887*^9, {3.6219668136205797`*^9, 
   3.621966843279291*^9}, 3.626476266542206*^9}]
}, Open  ]],

Cell["\<\
The singular vectors and the ladder diagram can be calculated directly using \
the ConstructLadderDiagram[ops,max_level].  ops is a list of the operators by \
which to label the singular vectors, and max_level is the maximum level to \
which the algorithm will search.\
\>", "Text",
 CellChangeTimes->{{3.621723945457893*^9, 3.621723953168347*^9}, {
  3.6217239941905117`*^9, 3.621724010140705*^9}, {3.621724045807535*^9, 
  3.62172410958456*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"(*", " ", 
   RowBox[{"This", " ", "may", " ", "take", " ", "a", " ", 
    RowBox[{"while", "."}]}], " ", "*)"}], "\[IndentingNewLine]", 
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"{", 
      RowBox[{"states", ",", "parentage"}], "}"}], "=", 
     RowBox[{"ConstructLadderDiagram", "[", 
      RowBox[{
       RowBox[{"{", "L", "}"}], ",", "13"}], "]"}]}], ";"}], 
   "\[IndentingNewLine]", 
   RowBox[{"LadderGraph", "@@", "%"}]}]}]], "Input",
 CellChangeTimes->{{3.6217240116139393`*^9, 3.621724042817224*^9}, {
  3.621724422066469*^9, 3.621724422124731*^9}, {3.621724583360116*^9, 
  3.62172459107104*^9}, {3.6219673936164303`*^9, 3.621967403751108*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Singular vectors have dimension \"\>", "\[InvisibleSpace]", 
   "1", "\[InvisibleSpace]", "\<\". \"\>"}],
  SequenceForm["Singular vectors have dimension ", 1, ". "],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843333067*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Found singular vector at level \"\>", "\[InvisibleSpace]", "0",
    "\[InvisibleSpace]", "\<\", with eigenvalues \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "0", "}"}], "\[InvisibleSpace]", "\<\".\"\>"}],
  SequenceForm[
  "Found singular vector at level ", 0, ", with eigenvalues ", {0}, "."],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843337069*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "1"}],
  SequenceForm["Searching for singular vectors at level ", 1],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843342126*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Singular vectors have dimension \"\>", "\[InvisibleSpace]", 
   "1", "\[InvisibleSpace]", "\<\". \"\>"}],
  SequenceForm["Singular vectors have dimension ", 1, ". "],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843347014*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Found singular vector at level \"\>", "\[InvisibleSpace]", "1",
    "\[InvisibleSpace]", "\<\", with eigenvalues \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "1", "}"}], "\[InvisibleSpace]", "\<\".\"\>"}],
  SequenceForm[
  "Found singular vector at level ", 1, ", with eigenvalues ", {1}, "."],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.62196684335205*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "2"}],
  SequenceForm["Searching for singular vectors at level ", 2],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.6219668433594427`*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "3"}],
  SequenceForm["Searching for singular vectors at level ", 3],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843365634*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "4"}],
  SequenceForm["Searching for singular vectors at level ", 4],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843370858*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "5"}],
  SequenceForm["Searching for singular vectors at level ", 5],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843375451*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "6"}],
  SequenceForm["Searching for singular vectors at level ", 6],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843380515*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Singular vectors have dimension \"\>", "\[InvisibleSpace]", 
   "1", "\[InvisibleSpace]", "\<\". \"\>"}],
  SequenceForm["Singular vectors have dimension ", 1, ". "],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.62196684338546*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Found singular vector at level \"\>", "\[InvisibleSpace]", "6",
    "\[InvisibleSpace]", "\<\", with eigenvalues \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "6", "}"}], "\[InvisibleSpace]", "\<\".\"\>"}],
  SequenceForm[
  "Found singular vector at level ", 6, ", with eigenvalues ", {6}, "."],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843390822*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "7"}],
  SequenceForm["Searching for singular vectors at level ", 7],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843396604*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "8"}],
  SequenceForm["Searching for singular vectors at level ", 8],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843401875*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "9"}],
  SequenceForm["Searching for singular vectors at level ", 9],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.6219668434091682`*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "10"}],
  SequenceForm["Searching for singular vectors at level ", 10],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843416265*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "11"}],
  SequenceForm["Searching for singular vectors at level ", 11],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, {
   3.621966813699205*^9, 3.621966843424304*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Singular vectors have dimension \"\>", "\[InvisibleSpace]", 
   "1", "\[InvisibleSpace]", "\<\". \"\>"}],
  SequenceForm["Singular vectors have dimension ", 1, ". "],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621966901939843*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Found singular vector at level \"\>", "\[InvisibleSpace]", 
   "11", "\[InvisibleSpace]", "\<\", with eigenvalues \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "11", "}"}], "\[InvisibleSpace]", "\<\".\"\>"}],
  SequenceForm[
  "Found singular vector at level ", 11, ", with eigenvalues ", {11}, "."],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621966939658338*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "12"}],
  SequenceForm["Searching for singular vectors at level ", 12],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621966939664331*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Searching for singular vectors at level \"\>", 
   "\[InvisibleSpace]", "13"}],
  SequenceForm["Searching for singular vectors at level ", 13],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967058478595*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Singular vectors have dimension \"\>", "\[InvisibleSpace]", 
   "1", "\[InvisibleSpace]", "\<\". \"\>"}],
  SequenceForm["Singular vectors have dimension ", 1, ". "],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.6219674513655357`*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Found singular vector at level \"\>", "\[InvisibleSpace]", 
   "13", "\[InvisibleSpace]", "\<\", with eigenvalues \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "13", "}"}], "\[InvisibleSpace]", "\<\".\"\>"}],
  SequenceForm[
  "Found singular vector at level ", 13, ", with eigenvalues ", {13}, "."],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691485482*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "0", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "1", "}"}]}],
  SequenceForm["Checking parentage of ", {0}, " to ", {1}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.62196769149468*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "1", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "6", "}"}]}],
  SequenceForm["Checking parentage of ", {1}, " to ", {6}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691502684*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "0", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "6", "}"}]}],
  SequenceForm["Checking parentage of ", {0}, " to ", {6}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691510326*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "6", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "11", "}"}]}],
  SequenceForm["Checking parentage of ", {6}, " to ", {11}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691517173*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "1", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "11", "}"}]}],
  SequenceForm["Checking parentage of ", {1}, " to ", {11}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691522814*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "11", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "13", "}"}]}],
  SequenceForm["Checking parentage of ", {11}, " to ", {13}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.6219676917058992`*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "6", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "13", "}"}]}],
  SequenceForm["Checking parentage of ", {6}, " to ", {13}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691714654*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{"\<\"Checking parentage of \"\>", "\[InvisibleSpace]", 
   RowBox[{"{", "1", "}"}], "\[InvisibleSpace]", "\<\" to \"\>", 
   "\[InvisibleSpace]", 
   RowBox[{"{", "13", "}"}]}],
  SequenceForm["Checking parentage of ", {1}, " to ", {13}],
  Editable->False]], "Print",
 CellChangeTimes->{{3.6217244078378143`*^9, 3.621724423545171*^9}, {
   3.621724583778908*^9, 3.621724591254043*^9}, 3.621786097372265*^9, 
   3.621966813699205*^9, 3.621967691752636*^9}]
}, Open  ]],

Cell[BoxData[
 GraphicsBox[
  NamespaceBox["NetworkGraphics",
   DynamicModuleBox[{Typeset`graph = HoldComplete[
     Graph[{1, 2, 3, 4, 
      5}, {{{1, 2}, {1, 3}, {2, 4}, {2, 5}, {3, 4}, {3, 5}}, Null}, {
      EdgeShapeFunction -> {
         GraphElementData["FilledArrow", "ArrowSize" -> 0.05]}, 
       VertexLabels -> {
        3 -> Placed["{6}", Top], 5 -> Placed["{13}", Top], 4 -> 
         Placed["{11}", Top], 2 -> Placed["{1}", Top], 1 -> 
         Placed["{0}", Top]}}]]}, 
    TagBox[GraphicsGroupBox[{
       {Hue[0.6, 0.7, 0.5], Opacity[0.7], 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{0., 2.}, {0., 1.}}]}, 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{0., 2.}, {1., 1.}}]}, 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{0., 1.}, {0., 0.}}]}, 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{0., 1.}, {1., 0.}}]}, 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{1., 1.}, {0., 0.}}]}, 
        {Arrowheads[{{0.05, 0.8, {
             GraphicsBox[
              
              FilledCurveBox[{{{0, 2, 0}, {0, 1, 0}, {0, 1, 
               0}}}, {{{-1., -0.31249915682968066`}, {-0.8749949409780775, \
-8.881784197001252*^-16}, {-1., 0.3124991568296789}, {
               0., -8.881784197001252*^-16}}}]], 0.8749949409780782}}}], 
         ArrowBox[{{1., 1.}, {1., 0.}}]}}, 
       {Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[
        0.7]}], {DiskBox[{0., 2.}, 0.02261146496815286], 
         InsetBox["\<\"{0}\"\>", Offset[{0, -2}, {0., 2.022611464968153}], 
          ImageScaled[{0.5, 1}],
          BaseStyle->"Graphics"]}, {DiskBox[{0., 1.}, 0.02261146496815286], 
         InsetBox["\<\"{1}\"\>", Offset[{0, -2}, {0., 1.0226114649681528`}], 
          ImageScaled[{0.5, 1}],
          BaseStyle->"Graphics"]}, {DiskBox[{1., 1.}, 0.02261146496815286], 
         InsetBox["\<\"{6}\"\>", Offset[{0, -2}, {1., 1.0226114649681528`}], 
          ImageScaled[{0.5, 1}],
          BaseStyle->"Graphics"]}, {DiskBox[{0., 0.}, 0.02261146496815286], 
         InsetBox["\<\"{11}\"\>", Offset[{0, -2}, {0., 0.02261146496815286}], 
          ImageScaled[{0.5, 1}],
          BaseStyle->"Graphics"]}, {DiskBox[{1., 0.}, 0.02261146496815286], 
         InsetBox["\<\"{13}\"\>", Offset[{0, -2}, {1., 0.02261146496815286}], 
          ImageScaled[{0.5, 1}],
          BaseStyle->"Graphics"]}}}],
     MouseAppearanceTag["NetworkGraphics"]],
    AllowKernelInitialization->False]],
  DefaultBaseStyle->{
   "NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
  FrameTicks->None,
  GridLinesStyle->Directive[
    GrayLevel[0.5, 0.4]],
  ImagePadding->15]], "Output",
 CellChangeTimes->{
  3.6217244141636047`*^9, {3.6217245802128963`*^9, 3.62172459140772*^9}, 
   3.621786105258953*^9, 3.621966840826956*^9, 
   3.621967691969384*^9},ImageCache->GraphicsData["CompressedBitmap", "\<\
eJzFnQlcFtXexycVcd+XyjX3XHBNcUnE1ABB3FBUXDB3U1FxzT3DcENSEzcQ
kSJRBMUlN5TUQEENKm5pXa9vWukNfWmhLuX/nnPmzOM8+DtdT+/n/dzn89GH
Z57vfM//zJwZZs6c88cvOHTKxBnBoVNfC2746pzgkClTX5vbsN+sOWxRyWcM
w3hoGM8kNzT4z8Q+yv8eEnuxL/8f3qqKt5JUVFhIRSReRlnbMvkyUuQyYlRh
UZETJ5aZqFHF1FaRX91MDGGfPCm7wMJLsf8KKMqTVc0/ivKJki1L0U0KYZV1
i8w2ysllBTlRfAtQVHa+Za7sKLSAIt3cKP5moVHesewOrWKlpbPSLG1BdjgZ
QYnE4jNcxbLSVFBQwCpBjte9M4vIbVUGKsHTnzKYrYRcVsgDcotk31jLXB31
Cc/Ol77H6yXLjcKj8AzPeFxk8XUKcmgR3yaGm6jwqsQcc7FYL/uJyO7RIllP
M4oKjIxkRCQ9YDsnNzeXzp07x94zKaKNc2RRbmxz5hSYgVW1qu4UWCRD1ly+
JzTRMxqRMWEXFfF9np9ObqxYVjEWLyvOM0ZsVjMso5Jt/8bwurCtzlYyAyxj
rmHMJf+AQBoWNIGCp8xl72OpZSWD5idnWVs4P32V2WIKyUiytnpejNgqibcK
ZX0rilLmNjGoTZ/BUjdbvPv4+tONrETyZFuSbR+xrcLZup5ROVag1ma8kxHD
6jOJ8ooe7+C8E0sY0ZSWb0lgy+JSs1jkcakXaXAdgxp26EmXL18WWyl9lSfb
MWd4/a0oqfAOxUxyo0nxeQ7djRufUuPyBnkt2O2kG/FyA1Gjjgv3Wk2QRexP
Z24VOgXJD89C0ZpEXQqzaWKvmeTWqi4ZdcbTztQs7qSw6YPJc9JyZjDId8Fu
GsI2cVERq7eb/ViowlpvJHnKnX3t3YlUv1V76sLWGR15Vnh27j1AYdHp4uf5
0waSUauTaE8FGeHktii9SvHI8kUJZ2TjOhm7UNTJcFvsiCwuMZmC3cVpjIIj
08Ueys3NYm3f3ykyWYLw5GYeo471Hq/DPRGLvNnnmbSV/7x0JCu+B2Wy5llk
1sgpsjLET0gpQcwwKZ7usSbIj4WgYV5kNAylqNQsc0e4sv/TaSILLnDDWQqe
Oodi35rMJP6i6VmBFd1KFIHEZN8TmuApMxzriAqmHqeJXk3Nihve1C8ohE4f
3k3hnqLJOZ0OXagoP4/io+LpFms2/Ohim0PEkcWayrCgYIoNX0YpOffk2dZF
VCTvTDzFp98qxpcSmzLrZCxFxRznlZQlVZcNjx+vvBmEsXbsIksI33aAvPsP
4N8ZR5+Sq2Zqa0icN//uPXvT2qgD7JOJs1Wpk3tP1tZvGMcll5mZSW07dX+C
4+tyzgzTqCl3GFskSvQbOoZGjg8RdfMbGEBjZoXTxatfHRNYWXr06BHtPHCB
lqyLIy8fP4ENGzuDhowYLyrBopORGrWkmddvR1wKrVi7XWxB/vn7HwpowYYk
bk4tZo6MO0v/KvpdYBwfOyuMzp6/JDaFGaxRW1bx1KU8SvwwW3yyDneb2Tgs
T4fF1CUlumJrKt29Z/4W/hNzSWBOxuZSeuZSwJyEzS56ZhdgPoDNpfXMpYF5
Pza76pldgTkBm8vomcsA83vYXFbPXBaY92FzOT1zOWDei83l9czlgXkPNlfQ
M1cA5mhsrqhnrgjMu7C5kp65EjDvwObKeubKwBxlM+9i5k17z3BzFT1zFWB+
F5ur6pmrAvMWbK6mZ64GzO9gc3U9c3Vg3oTNNfTMNYB5IzbX1DPXBOb12FxL
z1wLmNdic209c21gfhubn9UzPwvMYdj8nJ75OWBejc3P65mfB+ZV2FxHz1wH
mFdgc109c11gXobN9fTM9YB5CTbX1zPXB+bF2NxAz9wAmBfazLsPXqQI09xQ
z9wQmOcXM/OYf/vX7y/omV8A5lBsbqRnbgTMc7C58X82n7jwOcUdFre5RmOb
OWTNfjqW/qkRYjOv3X2SImJPc3MTiS6KSFaZeRxhO8ybnCbS8u39/yXvSZtp
ddQxevjjLzPk4q+/uU/jFsfSxGX7uLypNATO3UW37vyA5EsiU2jqKvPS0MRd
6HTG36jnmPU0ct5uOnjyKv30y2/GVPndne8f0raE8+Q9ebP4d//BT4ZVDL+H
6TN+E9vIn8uTsnwzax20IIYGzthGv/5W1EwsLi1K5yUFzN4hNtTR87n864ny
6/v5P1J00kWasjJeFNZ3QiTfe81keTlffEOe4zbyi5Xi5X11+z4NnrWd/Ka/
S9mf3zbXKEOf3rgrto9V5uQV8TR37QE69XEeFf3+R7DEHhT8QvGpl2naqvdp
0vJ9jrJnsRB/LvytmSxkb0qGKJ+H98cfj2o6h3Dw1DVHCGwXNpeL10WftIdQ
gsfA6hIhGprZxTlGhsHbA2+YPEp7GHzvHv/os2Zyl/BtG7ruoAhl7KI9lPf1
d4ZTLC609J3Djlhmv51Iv//xh2Htgxv/+F6UYAU1f30SfXbz7njxtasIKj3r
Bg1nbcgqfN76g3y5YUVgKawIEo5dsSKoKUvhdeGIFQX/Oe+rb5tLw+b4NLHo
DdYgrGNxvFzVOhbf3nmCber3BHc28wtrVX442wtnR1Lxwtnx90Th7x+70lx+
fftuvlj08fWv7SeDcXILFDsXiOtjfriyBmNYCt6Q7UHwn/9x94caznGsYTXg
3/B/E5bGifeFGw+1kF+zkLiUf7LHMUYRB3/xdn7x6k0Zh6s4PLl1+pvv09CQ
HTTjrQ/E55Szn1idFDVk62JHNcUfuczDdJwW+Wll/4ksXnpzW6n2l/1sGWQ7
um2RWd0HtlXlOcKVruTe4ucH+unnX8XZ9JvvHtC1vNv8PGMFiM7VbnKZvfSR
uPS2En3K3wJtgTmwmNk8OH9vp2duB8zDsLm9nrk9MA/F5g565g7APBibO+qZ
OwLzQGzupGfuBMwDsPklPfNLwOyLzZ31zJ2B2Qebu+iZuwCzFza765ndgbkf
NnfVM3cF5j7Y3E3P3A2Ye2Nzdz1zd2Duhc099Mw9gLknNr+sZ34ZmHtgc089
c09g7obNHnpmD2B2t5n59aE099Iz9wLmztjsqWf2BOZO2Nxbz9wbmDtg8yt6
5leAuR0299Ez9wFmN2zuq2fuC8ytsbmfnrkfMLfE5lf1zK8Ccwts9tIzewFz
M2z21jN7A3MTbPbRM/sAcyNs7q9n7g/MDbHZV8/sC8z1sdlPz+wHzHWxeYCe
eQAwP4/N/npmf2B+1maOOXTJ6usYqGceCMy1sHmQnnkQMNfA5sF65sHAXA2b
h+iZhwBzFWweqmceCsyVsDlAzxwAzBWweZieeRgwl8Pm4Xrm4cBcBpsD9cyB
wFwam0fomUcAcylsHqlnHgnMJbB5lJ7ZxF3t5uJG2b/w1EoTdxHK+Uy5bMsR
h2r0X1GZdeR9U37TttK5KzfG/JU6lnaqF+/wkPXVjMncF2VMW9Il2rjntKMf
yLYVNTfaCPveTLK2fREaAqK5hwOxGQ3U0GyVw7EZDafQPJKGYTMa9KB59Adg
MxqaoHnGGorNaACB5ll2CDajx/yavxkGYzN6GK/522wQNqNH5pq/gQdiM3qw
rXnV4I/N6PGz5pXOAGxGD4k1r878sBk9ytW8ovTFZvTAVfMquD82NwBmzSt3
627j8Xm5CD651LzV8AHaxkCreW/kDbRNgVbzZs4LaJsDrebd56tA+yLQat4u
9wPaVkCreX/fF2jbAK1mh0QfoEWPLjR7UF4BWvR0QbPLpzfQogcAmn1UnkCL
+ug1O9V6AS3qRtfsBfQAWtTTrdlt2RNoUWe0h572ZaBF/cWaHcM9gNYDaDV7
sq0K86vqDTGnhBb1ump2vXcDWtQxqvmsoCvQor5LzYcb7kCLuhc1n8Z0AVrU
A6j5+Kgz0KJOOs3nXS8BLepH03xA1wloUVeX5hPFjkCLeqM0H4F2AFrUYaT5
zLY90KI+Hc2HzO2AFnW7aD4Vbwu0qGdE8zG+G9COAlrNcQdtgHY00LrpaVsD
7VigbaOntS6M9iR/TBvkaTwYaFvraVsC7WtA20pP+yLQTgTalnraFkA7GWhf
1NM2B9qpQNtCT9sMaKcDbXM9bVOgnQG0zfS0TYB2FtA21dM2BtrZQNtET9sI
aOcC7VOMG0VjXe3aeUCrOdC1IdAuAFrNkbkNgHYR0GoOJa4PtG8AbQM9bT2g
XQq0moO16wLtcqDVHF1udaPEpmTQenkaXwm0msPhn7dprWjfBFrN8fvPAe1b
QKs54eBZoF0DtJozJGoDbTjQak7pqAW064C2tp62JtBuAFrNSTM1gDYCaGvq
aasDbSTQak5Lqga0m4FWcx5VVaDdCrSaE7+qAO02oNWcqVYZaLcDbRU9bSWg
3Qm0mnMBKwLtbqDVnLxYAWhjgLainra8Q/ux43wbC7Sa00PLAW0c0GrOZy0L
tPFAqzkBtwzQvg+0mjOGXYH2A6D9kynO1R3VdiSCES9bMSQTwjimmNuLSwTF
lZR1tiWhES9b8fw7OSjdOgXYE8aYD8JLO0VhSx5TAgRyUG4R+1Nv/rKnrLG0
jwNxSl1TzTkge6qZErLROW8Wcsq3YovmkMBdbMHkOLLbWHlmCgsKaMnmx1vE
nu3GKRJXmG5mVgeDgramSZ2LlVrGaZukyPqaYcRTSKe+ItsLT/URH+JWgm9P
tuqMuMsOrZXpximCik/klSkqekDD6xnUN2STIw+DyAjTZgmtkaUfEetWYKV/
TV3Z/eu7F75ieyOIjAG7RLKPcVMnUyN2f3DhQRHZUtnIkqvKkm3JYkTJPGXF
kICh1LqyQe38pziSxKyN2kX9Geex9ZosuRI5UtcExNE8thuWjm7A7jX7inUC
xgRTU3aB4+7lL/JV2BLVVHWOwJYIRpA86UXYlr0U3NCgQJlqhefYaOPWijoY
PXnSFyNVrmvlpEnIuEaN61USNfEKDiU/nkTFfTEtZetx347JHa38M7Jcx87n
WV56Lb8gKjl7ZF9HZpjRkWdlDpqStDx0FFVu8YrIa5EqNzvPNBPRa4Co4MxB
rclzXgJFRO2jFZEJtH7vWdrDM81s2U1tKteitAdFxZtcRjg1mxArNlWxrC+O
UvdsCaVabQfwBmArNZ/mNOtMvYZNoJ1bFhNPohKWlEXRUfxnDwpPyRIZczrW
bkCxmblOpVZwpGfpMXSqTMeS7pSeZU9CAgWyZvKcx1hKS0tLlW2fn6DC+rIA
W/rQ1pRMWhEy0rAad+DKZLZqJoUvncmWNKHtH6YZxQ50vvrhXeHk3i9QJk0p
RdHROyk4ZDP5j+IZbnKPSvT6xcPk3sWTIpI4ZKK8OkvmLaYevkEclfL/UuYW
KyPLccmdOJVGrdp1fbrMLa4wc4uVisVUlnWc1D5IPi1Yka5paqgT65S2xQWl
bXlCd/HqTXlqMXO1sP3rYP/kd6BVUZtG3rtB/BjA66nxowCvr8ZTAd5AjR8B
eEM1fhjgL6jxFIA3UuPJAG+sxg8BvIkaTwJ4UzV+EODN1PiBJ3Cr9w3i6KKl
hRrfD/AX1Ti6AmupxhMA3kqNo8vG1mr8PYC3UePoWtdNje8DeFs1ji7Q26nx
vQBvr8bRXUUHNb4H4B3VeAzAO6nxaIC/pMat+7d7+T8We64G8V3F8Avs8Oii
xncC3F2N7wB4VzW+HeDd1HgUwLur8W0A7+GMJ5+5Ttv3i2xzMnVNSfrb378T
s+zTs27IJ+AOfBO7+OGzofknKx8Nn5e+ff9H5DF2A5+F3NN5DT47fcwis8GY
eWZKi2m2B05eFdPH+eRuPlX90aNHck1rNP0vv/5LTIfnc6NZDTaJxeyaji0+
kpYjxPZZ81c/vy2f4TsMl3NvOWZXn7r0uZkypozICMA309y1B53mmHNL2I7j
vZwlOxI/ckjWRZ+0JDwLAJ+Nz+cyF5+8/9nNu1JSU9aYT6DmAVsiPmP8x59/
Nfu2XOj2t/kiHYIl2LDntBw44DDkfnnnidnirKVvlF9bu5hPiudz5fnXX92+
X0yy70jmE5Kt75/fUExyQV5O8MQHW+LTetslrmKe/ZvbjlJE7Bkxdzx814f0
+uoEp65Fe4uz7jgLfiqk//nugfgk47Jmff9c+Bt9/c0/RaH228Rvvn/Am9da
m3XhxkP0UfYNOaQANvt1APdS48jurcbDAe6jxt8GeH81vgbgvmo8DOB+avwt
gA9Q46sB7q/G3wT4QDW+CuCD1PhKgA9W4ysAPkSNLwf4UDW+DOABatx6pHNf
HhYcH6bGl9hw035TDkWA+BsAD1TjiwE+Qo0vAvhINb4Q4KPU+AKAB6nx+QAf
rcbnAXyMGg8F+Fg1Phfg49T4HIAHq/HZAB+vxkMA/poanwXwCWp8JsAnqvEZ
AJ+kxl+34xGHxIXHZDU+HeBT1Pg0gE9V41MBPk2NTwH4dDU+GeCvq/FJAJ+h
xicCfKYanwDwWWr8NYCHqPHxAJ+txoMBPkeNjwP4XDU+FuChanwMwOep8dF2
fKOJz1fjQcXs57O+lCdCiI8C+EI1PhLgi9T4CIAvVuOBAH9DjQ8H+BI1Pgzg
S9V4AMCXqfGhAF+uxocAfIUaHwzwlWp8EMBXqfGBAH9TjfsDfLUaHwDwt9S4
n1z2zwc/ifbO8TA17mvHuf3Kl/JCF+L9Af62GvcBeLga9wb4WjXuBfB1avxV
gK9X4/0AvkGN9wX4RjXeB+ARavwVgG9S470BHqnGPQH+jhrvBfDNatwD4FvU
eE+Ab1XjLwP8XTXew4bznGwc36bGuwM8So13A/h2Nd4V4DvUuDvAd6rxLgDf
pcY7A3y3Gn8J4NFqvBPAY9R4R4DvUeMdAB6rxtsDfK8abwfwODXeFuD71Lgb
wOPVeBu57IeHj9v7e2q8tQ3n9nOXv5B97RBvBfAENd4S4B+o8RcBvl+NtwB4
ohpvDvADarwZwA+q8aYAT1LjTQB+SI03BniyGm8E8BQ1/gLAD6vxhgA/osYb
ADxVjdcH+FE1Xg/gx9R4XYAfV+N1AH5CjT8P8A/V+HMAP6nGnwX4KTVeG+Cn
1XgtgJ9R4zUBflaN1wB4mhqvDvBzarwawM+r8aoAT1fjVQD+kRqvDPALarwS
wC+q8YoAv6TGKxTD0zK/MD5W4+UBnqHGywE8U42XBfhlNV4G4FfUuCvAs0z8
rwz3s2vMAv4vY/bstqt2m6t9wJ2Mo5AOn77ObQ67fSCaTXXNbirlNGAuPzvG
HAtUhl3ur6B70m2Nl7NJrtsl9jFvt0QlY/IKWeWu06xuBvnH58kKRrIr6yia
J2v0iamAg9cKMsiT3R3flWNhFkzzps7T48V4lx8e/l2M6Wq/8IiR46ywjz7j
Co8mk8k3IFCM0Bni5y4GYPXz9qXJISHUnt3+8NFnOfaKlHf8nbAb1xOpPBO/
HpFg/p2xSZ3ICN4jhhm1a/0CNRm3w8i1r1pBDANrsyCNfHx9aEAdg/xWHqG4
pCM0xHg89m314rFUs1VfXpEc57Wt4VydfYIoeudm6mj+BUTqOGozRduGc9Xq
MpgP9XFa2xyWtXfjEvLwn/jEsKwRk0P5AKEce6suaf1NLcGWdvwdLjGASxCf
OOP/aciVtD/tkCu56YoPpULDoz41UfvwqOJDnj4zkYf/1TfjmX8Diegovw==
\
\>"]]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["SW(3/2,2) algebra", "Section",
 CellChangeTimes->{{3.621724714871956*^9, 3.6217247180715647`*^9}, {
  3.623094662851975*^9, 3.623094666436331*^9}}],

Cell[TextData[{
 "The ",
 "SW(3/2,2)",
 " algebra is defined by Shatashvili and Vafa in arXiv:hep-th/9407025.  This \
formalism has two bosonic operators, L, and X, and two fermionic operators M, \
and G.  We will restrict our analysis to the NS sector at c=12.  When writing \
the commutation relations, we use the command NOperator[G,M,n+m,level] for \
the normal ordered operator ",
 Cell[BoxData[
  FormBox[
   RowBox[{":", "GM", 
    SubscriptBox[":", 
     RowBox[{"n", "+", "m"}]]}], TraditionalForm]]],
 "."
}], "Text",
 CellChangeTimes->{{3.621724723728571*^9, 3.621724728447707*^9}, {
   3.621725073390572*^9, 3.6217250760287247`*^9}, {3.6217257264657097`*^9, 
   3.621725802496076*^9}, 3.621725848160631*^9, {3.6217259064195147`*^9, 
   3.621725953945915*^9}, {3.621783919665539*^9, 3.621783922039475*^9}, {
   3.621784954361363*^9, 3.6217849974726477`*^9}, 3.623094672774682*^9}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{"<<", "Weaver.m"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"AddOperator", "[", 
   RowBox[{"L", ",", "False", ",", "0", ",", "2"}], "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"AddOperator", "[", 
   RowBox[{"X", ",", "False", ",", "0", ",", "2"}], "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"AddOperator", "[", 
   RowBox[{"G", ",", "True", ",", 
    RowBox[{"1", "/", "2"}], ",", 
    RowBox[{"3", "/", "2"}]}], "]"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"AddOperator", "[", 
    RowBox[{"M", ",", "True", ",", 
     RowBox[{"1", "/", "2"}], ",", 
     RowBox[{"5", "/", "2"}]}], "]"}], ";"}], "\[IndentingNewLine]", 
  "\[IndentingNewLine]", 
  RowBox[{"(*", " ", 
   RowBox[{"Boson", "-", "Boson"}], " ", "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"L", ",", "n_", ",", "L", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"(", 
     RowBox[{"n", "-", "m"}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"L", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "3"}], "-", "n"}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"m", "+", "n"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"X", ",", "n_", ",", "X", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"16", "/", "6"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "3"}], "-", "n"}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"m", "+", "n"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{"8", 
    RowBox[{"(", 
     RowBox[{"n", "-", "m"}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"L", ",", "n_", ",", "X", ",", "m_", ",", "level_"}], "]"}], ":=", 
  " ", 
  RowBox[{
   RowBox[{
    RowBox[{"1", "/", "3"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "3"}], "-", "n"}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"m", "+", "n"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"n", "-", "m"}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"Commutator", "[", 
    RowBox[{"X", ",", "m_", ",", "L", ",", "n_", ",", "level_"}], "]"}], ":=", 
   RowBox[{"-", 
    RowBox[{"Commutator", "[", 
     RowBox[{"L", ",", "n", ",", "X", ",", "m", ",", "level"}], "]"}]}]}], 
  "\[IndentingNewLine]", "\[IndentingNewLine]", 
  RowBox[{"(*", " ", 
   RowBox[{"Boson", "-", 
    RowBox[{"Fermion", " ", "and", " ", "Fermion"}], "-", "Boson"}], " ", 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"G", ",", "n_", ",", "X", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"1", "/", "2"}], " ", 
    RowBox[{"(", 
     RowBox[{"n", "+", 
      RowBox[{"1", "/", "2"}]}], ")"}], " ", 
    RowBox[{"Operator", "[", 
     RowBox[{"G", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{"Operator", "[", 
    RowBox[{"M", ",", 
     RowBox[{"n", "+", "m"}], ",", "level"}], 
    "]"}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"X", ",", "m_", ",", "G", ",", "n_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{"-", 
   RowBox[{"Commutator", "[", 
    RowBox[{"G", ",", "n", ",", "X", ",", "m", ",", "level"}], 
    "]"}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"X", ",", "n_", ",", "M", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{
       RowBox[{"15", "/", "4"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "1"}], ")"}], 
       RowBox[{"(", 
        RowBox[{"m", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}]}], "-", 
      RowBox[{
       RowBox[{"5", "/", "4"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", 
         RowBox[{"5", "/", "2"}]}], ")"}]}]}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"G", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "-", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{
       RowBox[{"-", " ", "8"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "1"}], ")"}]}], "+", 
      RowBox[{
       RowBox[{"11", "/", "2"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", 
         RowBox[{"5", "/", "2"}]}], ")"}]}]}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"M", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "-", " ", 
   RowBox[{"6", 
    RowBox[{"NOperator", "[", 
     RowBox[{"G", ",", "X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"Commutator", "[", 
    RowBox[{"M", ",", "m_", ",", "X", ",", "n_", ",", "level_"}], "]"}], ":=", 
   RowBox[{"-", 
    RowBox[{"Commutator", "[", 
     RowBox[{"X", ",", "n", ",", "M", ",", "m", ",", "level"}], "]"}]}]}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"L", ",", "n_", ",", "G", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{"(", 
    RowBox[{
     RowBox[{
      RowBox[{"1", "/", "2"}], " ", "n"}], "-", "m"}], ")"}], 
   RowBox[{"Operator", "[", 
    RowBox[{"G", ",", 
     RowBox[{"n", "+", "m"}], ",", "level"}], 
    "]"}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"G", ",", "m_", ",", "L", ",", "n_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{"-", 
   RowBox[{"Commutator", "[", 
    RowBox[{"L", ",", "n", ",", "G", ",", "m", ",", "level"}], 
    "]"}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"L", ",", "n_", ",", "M", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    FractionBox["1", "4"], " ", "n", " ", 
    RowBox[{"Operator", "[", 
     RowBox[{"G", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    FractionBox["1", "4"], " ", 
    SuperscriptBox["n", "2"], " ", 
    RowBox[{"Operator", "[", 
     RowBox[{"G", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "-", 
   RowBox[{"m", " ", 
    RowBox[{"Operator", "[", 
     RowBox[{"M", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    FractionBox["3", "2"], " ", "n", " ", 
    RowBox[{"Operator", "[", 
     RowBox[{"M", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"Commutator", "[", 
    RowBox[{"M", ",", "m_", ",", "L", ",", "n_", ",", "level_"}], "]"}], ":=", 
   RowBox[{"-", 
    RowBox[{"Commutator", "[", 
     RowBox[{"L", ",", "n", ",", "M", ",", "m", ",", "level"}], "]"}]}]}], 
  "\[IndentingNewLine]", "\[IndentingNewLine]", 
  RowBox[{"(*", " ", 
   RowBox[{"Fermion", "-", "Fermion"}], " ", 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"G", ",", "n_", ",", "M", ",", "m_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{"2", "/", "3"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "2"}], "-", 
      RowBox[{"1", "/", "4"}]}], ")"}], 
    RowBox[{"(", 
     RowBox[{"n", "-", 
      RowBox[{"3", "/", "2"}]}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "-", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{"n", "+", 
      RowBox[{"1", "/", "2"}]}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"L", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{"3", "n"}], "-", "m"}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"M", ",", "m_", ",", "G", ",", "n_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{"Commutator", "[", 
   RowBox[{"G", ",", "n", ",", "M", ",", "m", ",", "level"}], 
   "]"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Commutator", "[", 
   RowBox[{"M", ",", "m_", ",", "M", ",", "n_", ",", "level_"}], "]"}], ":=", 
  
  RowBox[{
   RowBox[{
    RowBox[{
     RowBox[{"-", "8"}], "/", "3"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "2"}], "-", 
      RowBox[{"9", "/", "4"}]}], ")"}], 
    RowBox[{"(", 
     RowBox[{
      RowBox[{"n", "^", "2"}], "-", 
      RowBox[{"1", "/", "4"}]}], ")"}], 
    RowBox[{"\[Delta]", "[", 
     RowBox[{
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{
       RowBox[{"15", "/", "2"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}], 
       RowBox[{"(", 
        RowBox[{"m", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}]}], "-", 
      RowBox[{
       RowBox[{"5", "/", "2"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", "2"}], ")"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", "3"}], ")"}]}]}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"L", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
   "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"(", 
     RowBox[{
      RowBox[{"16", 
       RowBox[{"(", 
        RowBox[{"n", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}], 
       RowBox[{"(", 
        RowBox[{"m", "+", 
         RowBox[{"3", "/", "2"}]}], ")"}]}], "-", 
      RowBox[{
       RowBox[{"5", "/", "2"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", "2"}], ")"}], 
       RowBox[{"(", 
        RowBox[{"n", "+", "m", "+", "3"}], ")"}]}]}], ")"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "-", "  ", 
   RowBox[{"12", " ", 
    RowBox[{"NOperator", "[", 
     RowBox[{"L", ",", "X", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", "  ", 
   RowBox[{"6", " ", 
    RowBox[{"NOperator", "[", 
     RowBox[{"G", ",", "M", ",", 
      RowBox[{"n", "+", "m"}], ",", "level"}], 
     "]"}]}]}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"Commutator", "[", 
    RowBox[{"G", ",", "m_", ",", "G", ",", "n_", ",", "level_"}], "]"}], ":=", 
   RowBox[{
    RowBox[{
     RowBox[{"8", "/", "2"}], 
     RowBox[{"(", 
      RowBox[{
       RowBox[{"m", "^", "2"}], "-", 
       RowBox[{"1", "/", "4"}]}], ")"}], 
     RowBox[{"\[Delta]", "[", 
      RowBox[{
       RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}], "+", 
    RowBox[{"2", 
     RowBox[{"Operator", "[", 
      RowBox[{"L", ",", 
       RowBox[{"n", "+", "m"}], ",", "level"}], "]"}]}]}]}], " ", 
  "\[IndentingNewLine]", "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"MinimalGeneratorsCreation", "=", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"L", ",", 
       RowBox[{"-", "1"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"L", ",", 
       RowBox[{"-", "2"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"X", ",", 
       RowBox[{"-", "1"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"G", ",", 
       RowBox[{
        RowBox[{"-", "1"}], "/", "2"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"M", ",", 
       RowBox[{
        RowBox[{"-", "1"}], "/", "2"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"M", ",", 
       RowBox[{
        RowBox[{"-", "5"}], "/", "2"}]}], "}"}]}], "}"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"MinimalGeneratorsAnnihilation", "=", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"L", ",", "1"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"L", ",", "2"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"X", ",", "1"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"X", ",", "2"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"G", ",", 
       RowBox[{"1", "/", "2"}]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"M", ",", 
       RowBox[{"1", "/", "2"}]}], "}"}]}], "}"}]}], ";"}]}], "Input",
 CellChangeTimes->{{3.6217259558817*^9, 3.621725967956565*^9}, {
   3.621726443975789*^9, 3.62172653003183*^9}, {3.621726587210828*^9, 
   3.621726596264269*^9}, {3.621783932229271*^9, 3.621783936562249*^9}, {
   3.62178577700163*^9, 3.621785780882175*^9}, {3.621786182536747*^9, 
   3.621786193931363*^9}, {3.621787247673595*^9, 3.621787254403728*^9}, {
   3.621884035743526*^9, 3.621884035928804*^9}, 3.621966799232709*^9, 
   3.626474951182766*^9}],

Cell[BoxData["\"\<Weaver: a package for explicit exact-arithmetic \
calculations in operator algebras\>\""], "Print",
 GeneratedCell->False,
 CellAutoOverwrite->False,
 CellChangeTimes->{
  3.621788423405652*^9, 3.621788747498231*^9, 3.6217887890871067`*^9, 
   3.621789467338829*^9, 3.621789524965371*^9, 3.6217896875219507`*^9, 
   3.621792144491262*^9, 3.62179249066107*^9, 3.621967692067606*^9, {
   3.621969635667798*^9, 3.6219696535772123`*^9}, 3.621969733180365*^9, {
   3.621969846168084*^9, 3.621969959017377*^9}, {3.621970010897059*^9, 
   3.621970012764255*^9}, 3.626474951200365*^9}]
}, Open  ]],

Cell["\<\
The algebra has a nonstandard Hermitian conjugate for the M operators in this \
formalism.  It is possible to override the default:\
\>", "Text",
 CellChangeTimes->{{3.6217266018919992`*^9, 3.6217266292255087`*^9}, {
  3.621726866694006*^9, 3.621726871604105*^9}, {3.6217763568429832`*^9, 
  3.621776403819745*^9}, {3.623094079690194*^9, 3.623094080080817*^9}, {
  3.623094694464402*^9, 3.623094695293087*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"HC", "[", 
   RowBox[{"M", ",", "n_", ",", "level_"}], "]"}], ":=", " ", 
  RowBox[{
   RowBox[{"-", 
    RowBox[{"Operator", "[", 
     RowBox[{"M", ",", 
      RowBox[{"-", "n"}], ",", 
      RowBox[{"level", "-", "n"}]}], "]"}]}], "-", 
   RowBox[{
    RowBox[{"1", "/", "2"}], 
    RowBox[{"Operator", "[", 
     RowBox[{"G", ",", 
      RowBox[{"-", "n"}], ",", 
      RowBox[{"level", "-", "n"}]}], "]"}]}]}]}]], "Input"],

Cell["\<\
Restrict to the module generated by L[0]=0, X[0]=0.  This model has singular \
vectors at level 1/2, 1/2, 2, 4,... and a subsingular vector at level 11/2.  \
Using this module, the character is\
\>", "Text",
 CellChangeTimes->{{3.6217837927632523`*^9, 3.621783904983653*^9}, {
  3.621789950622467*^9, 3.621789957833823*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"L", "[", "0", "]"}], "=", "0"}], ";", 
  RowBox[{
   RowBox[{"X", "[", "0", "]"}], "=", "0"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"HighestWeightDimension", "=", "1"}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"q", "^", 
    RowBox[{"-", "1"}]}], 
   RowBox[{"(", 
    RowBox[{"Sum", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"q", "^", "n"}], " ", 
       RowBox[{"MatrixRank", "@", 
        RowBox[{"GramMatrix", "@", "n"}]}]}], ",", 
      RowBox[{"{", 
       RowBox[{"n", ",", "0", ",", "5", ",", 
        RowBox[{"1", "/", "2"}]}], "}"}]}], "]"}], ")"}]}], "+", 
  RowBox[{
   RowBox[{"O", "[", "q", "]"}], "^", 
   RowBox[{"(", 
    RowBox[{"9", "/", "2"}], ")"}]}]}]}], "Input",
 CellChangeTimes->{{3.62178390676367*^9, 3.6217839119483213`*^9}, {
   3.621786198258643*^9, 3.621786202658318*^9}, {3.621789960771298*^9, 
   3.6217899857397757`*^9}, {3.621790057668935*^9, 3.621790092727439*^9}, 
   3.621791828896742*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{
   FractionBox["1", "q"], "+", 
   SqrtBox["q"], "+", 
   RowBox[{"2", " ", "q"}], "+", 
   RowBox[{"2", " ", 
    SuperscriptBox["q", 
     RowBox[{"3", "/", "2"}]]}], "+", 
   RowBox[{"2", " ", 
    SuperscriptBox["q", "2"]}], "+", 
   RowBox[{"4", " ", 
    SuperscriptBox["q", 
     RowBox[{"5", "/", "2"}]]}], "+", 
   RowBox[{"7", " ", 
    SuperscriptBox["q", "3"]}], "+", 
   RowBox[{"8", " ", 
    SuperscriptBox["q", 
     RowBox[{"7", "/", "2"}]]}], "+", 
   RowBox[{"9", " ", 
    SuperscriptBox["q", "4"]}], "+", 
   InterpretationBox[
    SuperscriptBox[
     RowBox[{"O", "[", "q", "]"}], 
     RowBox[{"9", "/", "2"}]],
    SeriesData[$CellContext`q, 0, {}, -2, 9, 2],
    Editable->False]}],
  SeriesData[$CellContext`q, 0, {1, 0, 0, 1, 2, 2, 2, 4, 7, 8, 9}, -2, 9, 2],
  Editable->False]], "Output",
 CellChangeTimes->{
  3.6217900126416397`*^9, 3.621790060533576*^9, {3.621790090886804*^9, 
   3.621790093277446*^9}, 3.62179217058783*^9, 3.621792515634143*^9, 
   3.6219680808354273`*^9, {3.621969636382925*^9, 3.621969653737421*^9}, 
   3.621969733621708*^9, 3.6219703855012197`*^9}]
}, Open  ]],

Cell["\<\
Observe that both of the states at level 1/2 are null.  Find Eigenbasis will \
identify those states by their L[0] and X[0] eigenvalues.  All singular \
vectors in the module will be descendents of these two states.\
\>", "Text",
 CellChangeTimes->{{3.621790096532804*^9, 3.621790132606963*^9}, {
   3.6217902511763783`*^9, 3.621790297364272*^9}, 3.621790388242038*^9, {
   3.621790464196299*^9, 3.621790473124134*^9}, {3.621794989215219*^9, 
   3.62179500306898*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"states", " ", "=", " ", 
  RowBox[{"FindEigenbasis", "[", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"L", ",", "X"}], "}"}], ",", 
    RowBox[{"1", "/", "2"}]}], "]"}]}]], "Input",
 CellChangeTimes->{{3.6217901346780233`*^9, 3.621790142747493*^9}, {
  3.621790206267995*^9, 3.621790249395185*^9}, {3.621790284932242*^9, 
  3.621790383769758*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       FractionBox["1", "2"], ",", 
       FractionBox["5", "2"]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"1", ",", "2"}], "}"}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       FractionBox["1", "2"], ",", 
       FractionBox["1", "2"]}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"{", 
       RowBox[{"1", ",", 
        FractionBox["2", "5"]}], "}"}], "}"}]}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{
  3.62179043218237*^9, 3.6217921706440783`*^9, 3.6217925157157183`*^9, 
   3.6219680813224487`*^9, {3.621969636447288*^9, 3.62196965378552*^9}, 
   3.621969733652514*^9, 3.621970385777568*^9}]
}, Open  ]],

Cell["\<\
For example, the state {1,2} at level 1/2 is an eigenvector of L[0] and X[0] \
of values 1/2, and 5/2 respectively.  This is easily checked explicitly.\
\>", "Text",
 CellChangeTimes->{{3.621790390788069*^9, 3.621790425187265*^9}, {
  3.621790457006282*^9, 3.6217904885885878`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
  "Print", "[", "\"\<\!\(\*SubscriptBox[\(L\), \(0\)]\){1,2}:\>\"", "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Operator", "[", 
   RowBox[{"L", ",", "0", ",", 
    RowBox[{"1", "/", "2"}]}], "]"}], ".", 
  RowBox[{"{", 
   RowBox[{"1", ",", "2"}], "}"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
  "Print", "[", "\"\<\!\(\*SubscriptBox[\(X\), \(0\)]\){1,2}:\>\"", "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Operator", "[", 
   RowBox[{"X", ",", "0", ",", 
    RowBox[{"1", "/", "2"}]}], "]"}], ".", 
  RowBox[{"{", 
   RowBox[{"1", ",", "2"}], "}"}]}]}], "Input",
 CellChangeTimes->{{3.6217904336204433`*^9, 3.6217904529185677`*^9}, {
  3.62179644074044*^9, 3.621796485352265*^9}}],

Cell[BoxData["\<\"\\!\\(\\*SubscriptBox[\\(L\\), \\(0\\)]\\){1,2}:\"\>"], \
"Print",
 CellChangeTimes->{{3.621796479271287*^9, 3.621796485655095*^9}, 
   3.62196808134616*^9, {3.62196963653242*^9, 3.621969653831156*^9}, 
   3.621969733689117*^9, 3.621970385805997*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   FractionBox["1", "2"], ",", "1"}], "}"}]], "Output",
 CellChangeTimes->{{3.621790444683494*^9, 3.6217904531913958`*^9}, 
   3.621792170680819*^9, 3.62179251576618*^9, {3.621796479298341*^9, 
   3.621796485659841*^9}, 3.6219680813515377`*^9, {3.621969636538838*^9, 
   3.6219696538387012`*^9}, 3.621969733694003*^9, 3.621970385810286*^9}],

Cell[BoxData["\<\"\\!\\(\\*SubscriptBox[\\(X\\), \\(0\\)]\\){1,2}:\"\>"], \
"Print",
 CellChangeTimes->{{3.621796479271287*^9, 3.621796485655095*^9}, 
   3.62196808134616*^9, {3.62196963653242*^9, 3.621969653831156*^9}, 
   3.621969733689117*^9, 3.621970385813472*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   FractionBox["5", "2"], ",", "5"}], "}"}]], "Output",
 CellChangeTimes->{{3.621790444683494*^9, 3.6217904531913958`*^9}, 
   3.621792170680819*^9, 3.62179251576618*^9, {3.621796479298341*^9, 
   3.621796485659841*^9}, 3.6219680813515377`*^9, {3.621969636538838*^9, 
   3.6219696538387012`*^9}, 3.621969733694003*^9, 3.621970385816831*^9}]
}, Open  ]],

Cell["\<\
The characters of the submodules of the L,X={1/2,5/2} and {1/2,1/2} are \
different because there is a level 1/2 creation operator that annihilates the \
{1/2,1/2} state.  This is easily checked by computing the rank of the \
descendents.\
\>", "Text",
 CellChangeTimes->{{3.62179148057069*^9, 3.62179159815803*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"q", "^", 
   RowBox[{"-", "1"}]}], 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"Sum", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"q", "^", "n"}], " ", 
       RowBox[{"MatrixRank", "@", 
        RowBox[{"Descendents", "[", 
         RowBox[{
          RowBox[{"{", 
           RowBox[{"1", ",", "2"}], "}"}], ",", 
          RowBox[{"1", "/", "2"}], ",", "n"}], "]"}]}]}], ",", 
      RowBox[{"{", 
       RowBox[{"n", ",", 
        RowBox[{"1", "/", "2"}], ",", "5", ",", 
        RowBox[{"1", "/", "2"}]}], "}"}]}], "]"}], "+", 
    RowBox[{
     RowBox[{"O", "[", "q", "]"}], "^", 
     RowBox[{"(", 
      RowBox[{"11", "/", "2"}], ")"}]}]}], ")"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"q", "^", 
   RowBox[{"-", "1"}]}], 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"Sum", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"q", "^", "n"}], " ", 
       RowBox[{"MatrixRank", "@", 
        RowBox[{"Descendents", "[", 
         RowBox[{
          RowBox[{"{", 
           RowBox[{"1", ",", 
            RowBox[{"2", "/", "5"}]}], "}"}], ",", 
          RowBox[{"1", "/", "2"}], ",", "n"}], "]"}]}]}], ",", 
      RowBox[{"{", 
       RowBox[{"n", ",", 
        RowBox[{"1", "/", "2"}], ",", "5", ",", 
        RowBox[{"1", "/", "2"}]}], "}"}]}], "]"}], "+", 
    RowBox[{
     RowBox[{"O", "[", "q", "]"}], "^", 
     RowBox[{"(", 
      RowBox[{"11", "/", "2"}], ")"}]}]}], ")"}]}]}], "Input",
 CellChangeTimes->{{3.621791609678733*^9, 3.621791664046616*^9}, {
  3.621791808958294*^9, 3.62179182512099*^9}, {3.621792079953444*^9, 
  3.6217921022178583`*^9}}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{
   FractionBox["1", 
    SqrtBox["q"]], "+", "2", "+", 
   RowBox[{"3", " ", 
    SqrtBox["q"]}], "+", 
   RowBox[{"6", " ", "q"}], "+", 
   RowBox[{"11", " ", 
    SuperscriptBox["q", 
     RowBox[{"3", "/", "2"}]]}], "+", 
   RowBox[{"18", " ", 
    SuperscriptBox["q", "2"]}], "+", 
   RowBox[{"28", " ", 
    SuperscriptBox["q", 
     RowBox[{"5", "/", "2"}]]}], "+", 
   RowBox[{"44", " ", 
    SuperscriptBox["q", "3"]}], "+", 
   RowBox[{"69", " ", 
    SuperscriptBox["q", 
     RowBox[{"7", "/", "2"}]]}], "+", 
   RowBox[{"104", " ", 
    SuperscriptBox["q", "4"]}], "+", 
   InterpretationBox[
    SuperscriptBox[
     RowBox[{"O", "[", "q", "]"}], 
     RowBox[{"9", "/", "2"}]],
    SeriesData[$CellContext`q, 0, {}, -1, 9, 2],
    Editable->False]}],
  SeriesData[$CellContext`q, 0, {1, 2, 3, 6, 11, 18, 28, 44, 69, 104}, -1, 9, 
   2],
  Editable->False]], "Output",
 CellChangeTimes->{{3.621791639025736*^9, 3.6217916646228123`*^9}, 
   3.621791820510613*^9, 3.621791867745441*^9, 3.621792182152569*^9, 
   3.621792526835969*^9, 3.621968307428399*^9, {3.621969636614347*^9, 
   3.621969653885003*^9}, 3.621969733737625*^9, 3.621970601291931*^9}],

Cell[BoxData[
 InterpretationBox[
  RowBox[{
   FractionBox["1", 
    SqrtBox["q"]], "+", "1", "+", 
   RowBox[{"2", " ", 
    SqrtBox["q"]}], "+", 
   RowBox[{"4", " ", "q"}], "+", 
   RowBox[{"7", " ", 
    SuperscriptBox["q", 
     RowBox[{"3", "/", "2"}]]}], "+", 
   RowBox[{"11", " ", 
    SuperscriptBox["q", "2"]}], "+", 
   RowBox[{"17", " ", 
    SuperscriptBox["q", 
     RowBox[{"5", "/", "2"}]]}], "+", 
   RowBox[{"27", " ", 
    SuperscriptBox["q", "3"]}], "+", 
   RowBox[{"42", " ", 
    SuperscriptBox["q", 
     RowBox[{"7", "/", "2"}]]}], "+", 
   RowBox[{"62", " ", 
    SuperscriptBox["q", "4"]}], "+", 
   InterpretationBox[
    SuperscriptBox[
     RowBox[{"O", "[", "q", "]"}], 
     RowBox[{"9", "/", "2"}]],
    SeriesData[$CellContext`q, 0, {}, -1, 9, 2],
    Editable->False]}],
  SeriesData[$CellContext`q, 0, {1, 1, 2, 4, 7, 11, 17, 27, 42, 62}, -1, 9, 2],
  Editable->False]], "Output",
 CellChangeTimes->{{3.621791639025736*^9, 3.6217916646228123`*^9}, 
   3.621791820510613*^9, 3.621791867745441*^9, 3.621792182152569*^9, 
   3.621792526835969*^9, 3.621968307428399*^9, {3.621969636614347*^9, 
   3.621969653885003*^9}, 3.621969733737625*^9, 3.6219706016773157`*^9}]
}, Open  ]],

Cell["\<\
The identity of the level 1/2 operator that annihilates L,X={1/2,1/2} can be \
computed directly.  A basis is given in terms of the operators listed in \
OperatorNames[level].  The corresponding operator can be evaluated using \
OperatorNames and OperatorChain.\
\>", "Text",
 CellChangeTimes->{{3.6217919046803217`*^9, 3.621791937252534*^9}, {
  3.621792016674858*^9, 3.6217920168813763`*^9}, {3.621792583981913*^9, 
  3.621792602183156*^9}, {3.621793073886375*^9, 3.6217930919012327`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
  "Print", "[", 
   "\"\<The vector corresponding to the annihilating operator\>\"", "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{"annopvector", "=", 
  RowBox[{"FindAnnihilatingOperators", "[", 
   RowBox[{
    RowBox[{
     RowBox[{"-", "1"}], "/", "2"}], " ", 
    RowBox[{"(*", " ", 
     RowBox[{"level", " ", "of", " ", "operator"}], " ", "*)"}], ",", 
    RowBox[{"{", 
     RowBox[{"1", ",", 
      RowBox[{"2", "/", "5"}]}], "}"}], ",", 
    RowBox[{"1", "/", "2"}]}], " ", 
   RowBox[{"(*", " ", 
    RowBox[{"level", " ", "of", " ", "state"}], " ", "*)"}], 
   "]"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"annop", "=", 
   RowBox[{
    RowBox[{"annopvector", "[", 
     RowBox[{"[", "1", "]"}], "]"}], ".", 
    RowBox[{"(", 
     RowBox[{
      RowBox[{
       RowBox[{"OperatorChain", "[", 
        RowBox[{"#", ",", 
         RowBox[{"1", "/", "2"}]}], "]"}], "&"}], "/@", 
      RowBox[{"OperatorNames", "[", 
       RowBox[{"1", "/", "2"}], "]"}]}], ")"}]}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
  "Print", "[", "\"\<The action of the annihilating operator on {1,2/5}\>\"", 
   "]"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{"annop", ".", 
  RowBox[{"{", 
   RowBox[{"1", ",", 
    RowBox[{"2", "/", "5"}]}], "}"}]}]}], "Input",
 CellChangeTimes->{{3.621792106550354*^9, 3.621792136846315*^9}, {
   3.6217925447290707`*^9, 3.621792635407981*^9}, {3.62179301334962*^9, 
   3.6217930680861177`*^9}, {3.6217931072405643`*^9, 3.621793120902904*^9}, {
   3.621796392108615*^9, 3.62179643129873*^9}, 3.6219668324507227`*^9}],

Cell[BoxData["\<\"The vector corresponding to the annihilating \
operator\"\>"], "Print",
 CellChangeTimes->{
  3.621968307788134*^9, {3.6219696366784363`*^9, 3.621969653936986*^9}, 
   3.621969733789133*^9, 3.621970601753854*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"-", 
     FractionBox["1", "2"]}], ",", "1"}], "}"}], "}"}]], "Output",
 CellChangeTimes->{
  3.62179213884128*^9, 3.621792183001648*^9, 3.621792527335957*^9, 
   3.621792560333102*^9, {3.621792627923634*^9, 3.621792636197658*^9}, {
   3.621793013908503*^9, 3.621793041041626*^9}, {3.62179311350194*^9, 
   3.6217931213488607`*^9}, 3.621968307793646*^9, {3.621969636684826*^9, 
   3.621969653941798*^9}, 3.621969733795822*^9, 3.62197060175756*^9}],

Cell[BoxData["\<\"The action of the annihilating operator on {1,2/5}\"\>"], \
"Print",
 CellChangeTimes->{
  3.621968307788134*^9, {3.6219696366784363`*^9, 3.621969653936986*^9}, 
   3.621969733789133*^9, 3.621970601760178*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", "0", ",", "0"}], "}"}]], "Output",
 CellChangeTimes->{
  3.62179213884128*^9, 3.621792183001648*^9, 3.621792527335957*^9, 
   3.621792560333102*^9, {3.621792627923634*^9, 3.621792636197658*^9}, {
   3.621793013908503*^9, 3.621793041041626*^9}, {3.62179311350194*^9, 
   3.6217931213488607`*^9}, 3.621968307793646*^9, {3.621969636684826*^9, 
   3.621969653941798*^9}, 3.621969733795822*^9, 3.62197060176357*^9}]
}, Open  ]],

Cell["\<\
A separate function exists for finding null vectors that are not descendents \
of other null vectors.  Observe that at level 11/2, there is a null element \
at level 11/2 that is not a descendent of either of the level 1/2 singular \
vectors.

FindEigenbasis will determine the X eigenspaces at level 11/2.  Observe that \
the nullspace possesses an additional vector at eigenvalue 65/2 that is not \
in the space of descendents.\
\>", "Text",
 CellChangeTimes->{{3.621793130735167*^9, 3.621793156382576*^9}, {
  3.621793594647565*^9, 3.6217936032035503`*^9}, {3.621794478545205*^9, 
  3.621794590916389*^9}, {3.621794803651011*^9, 3.621794807812984*^9}, {
  3.621794970694787*^9, 3.621794970895811*^9}, {3.6217952740487623`*^9, 
  3.6217952742088137`*^9}, {3.621795377416977*^9, 3.6217955050735693`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"(*", " ", 
   RowBox[{"This", " ", "may", " ", "take", " ", "a", " ", 
    RowBox[{"while", "."}]}], " ", "*)"}], "\[IndentingNewLine]", 
  RowBox[{
   RowBox[{
    RowBox[{
    "Print", "[", 
     "\"\<Dimensions of the null vectors and the descendents of lower level \
null vectors.\>\"", "]"}], ";"}], " ", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"GramNullspace", "[", 
     RowBox[{"11", "/", "2"}], "]"}], "//", "MatrixRank"}], 
   "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"NullDescendents", "[", 
     RowBox[{"11", "/", "2"}], "]"}], "//", "MatrixRank"}], 
   "\[IndentingNewLine]", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
    "Print", "[", "\"\<Dimensions of the X eigenspaces at level 11/2:\>\"", 
     "]"}], ";"}], "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"eigenbasis", "=", 
     RowBox[{"FindEigenbasis", "[", 
      RowBox[{"X", ",", 
       RowBox[{"GramNullspace", "[", 
        RowBox[{"11", "/", "2"}], "]"}], ",", 
       RowBox[{"11", "/", "2"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"#", "[", 
        RowBox[{"[", "1", "]"}], "]"}], ",", 
       RowBox[{"MatrixRank", "[", 
        RowBox[{"#", "[", 
         RowBox[{"[", "2", "]"}], "]"}], "]"}]}], "}"}], "&"}], "/@", 
    "eigenbasis"}], "\[IndentingNewLine]", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
    "Print", "[", 
     "\"\<Dimension of the intersection between the eigenspace with \
eigenvalue 65/2 and the nullspace of the Gram matrix:\>\"", "]"}], ";"}], " ",
    "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"nullintersect", " ", "=", " ", 
     RowBox[{"IntersectVectorSpaces", "[", 
      RowBox[{
       RowBox[{"GramNullspace", "[", 
        RowBox[{"11", "/", "2"}], "]"}], ",", 
       RowBox[{"eigenbasis", "[", 
        RowBox[{"[", 
         RowBox[{"4", ",", "2"}], "]"}], "]"}]}], "]"}]}], ";"}], 
   "\[IndentingNewLine]", 
   RowBox[{"MatrixRank", "[", "nullintersect", "]"}], "\[IndentingNewLine]", 
   "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
    "Print", "[", 
     "\"\<Dimension of the intersection between the eigenspace with \
eigenvalue 65/2 and the space of descendents of lower level null \
vectors:\>\"", "]"}], ";"}], " ", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"descendintersect", " ", "=", " ", 
     RowBox[{"IntersectVectorSpaces", "[", 
      RowBox[{
       RowBox[{"NullDescendents", "[", 
        RowBox[{"11", "/", "2"}], "]"}], ",", 
       RowBox[{"eigenbasis", "[", 
        RowBox[{"[", 
         RowBox[{"4", ",", "2"}], "]"}], "]"}]}], "]"}]}], ";"}], 
   "\[IndentingNewLine]", 
   RowBox[{"MatrixRank", "[", "descendintersect", "]"}], 
   "\[IndentingNewLine]", "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{
    "Print", "[", 
     "\"\<Verify that the third generator of nullintersect is not in \
descendintersect using InVectorSpaceQ:\>\"", "]"}], ";"}], 
   "\[IndentingNewLine]", 
   RowBox[{"InVectorSpaceQ", "[", 
    RowBox[{"descendintersect", ",", 
     RowBox[{"nullintersect", "[", 
      RowBox[{"[", "3", "]"}], "]"}]}], "]"}], "\[IndentingNewLine]", 
   "\[IndentingNewLine]", 
   RowBox[{
    RowBox[{"subsingular", "=", 
     RowBox[{"nullintersect", "[", 
      RowBox[{"[", "3", "]"}], "]"}]}], ";"}], 
   "\[IndentingNewLine]"}]}]], "Input",
 CellChangeTimes->{{3.621793694094208*^9, 3.6217937173857937`*^9}, {
   3.6217937700179367`*^9, 3.621793790600148*^9}, {3.621794475835341*^9, 
   3.621794476611719*^9}, {3.621794521907692*^9, 3.621794526910281*^9}, {
   3.621794595686898*^9, 3.6217946780812683`*^9}, 3.621795026903673*^9, {
   3.621795191218107*^9, 3.621795191635103*^9}, {3.6217952666511507`*^9, 
   3.621795268723463*^9}, {3.621795507330514*^9, 3.6217957632791843`*^9}, 
   3.6217959159552402`*^9, {3.621795954347365*^9, 3.6217959584265003`*^9}, {
   3.6217962683486223`*^9, 3.621796268390851*^9}, {3.621968322791218*^9, 
   3.6219683320412817`*^9}}],

Cell[BoxData["\<\"Dimensions of the null vectors and the descendents of lower \
level null vectors.\"\>"], "Print",
 CellChangeTimes->{
  3.621795659939554*^9, 3.621796042408956*^9, 3.621968307893611*^9, {
   3.621969636746924*^9, 3.621969654003252*^9}, 3.6219697338550587`*^9, 
   3.621970601830615*^9}],

Cell[BoxData["208"], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.621971508347403*^9}],

Cell[BoxData["207"], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.621972060941112*^9}],

Cell[BoxData["\<\"Dimensions of the X eigenspaces at level 11/2:\"\>"], \
"Print",
 CellChangeTimes->{
  3.621795659939554*^9, 3.621796042408956*^9, 3.621968307893611*^9, {
   3.621969636746924*^9, 3.621969654003252*^9}, 3.6219697338550587`*^9, 
   3.621972060946801*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{
     FractionBox["85", "2"], ",", "7"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["81", "2"], ",", "7"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["69", "2"], ",", "10"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["65", "2"], ",", "8"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["53", "2"], ",", "15"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["49", "2"], ",", "13"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["37", "2"], ",", "21"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["33", "2"], ",", "18"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["21", "2"], ",", "22"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["17", "2"], ",", "17"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["5", "2"], ",", "36"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     FractionBox["1", "2"], ",", "31"}], "}"}]}], "}"}]], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.621972509383482*^9}],

Cell[BoxData["\<\"Dimension of the intersection between the eigenspace with \
eigenvalue 65/2 and the nullspace of the Gram matrix:\"\>"], "Print",
 CellChangeTimes->{
  3.621795659939554*^9, 3.621796042408956*^9, 3.621968307893611*^9, {
   3.621969636746924*^9, 3.621969654003252*^9}, 3.6219697338550587`*^9, 
   3.621972509389469*^9}],

Cell[BoxData["8"], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.621972509728737*^9}],

Cell[BoxData["\<\"Dimension of the intersection between the eigenspace with \
eigenvalue 65/2 and the space of descendents of lower level null \
vectors:\"\>"], "Print",
 CellChangeTimes->{
  3.621795659939554*^9, 3.621796042408956*^9, 3.621968307893611*^9, {
   3.621969636746924*^9, 3.621969654003252*^9}, 3.6219697338550587`*^9, 
   3.6219725097365437`*^9}],

Cell[BoxData["7"], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.6219725111653223`*^9}],

Cell[BoxData["\<\"Verify that the third generator of nullintersect is not in \
descendintersect using InVectorSpaceQ:\"\>"], "Print",
 CellChangeTimes->{
  3.621795659939554*^9, 3.621796042408956*^9, 3.621968307893611*^9, {
   3.621969636746924*^9, 3.621969654003252*^9}, 3.6219697338550587`*^9, 
   3.621972511170301*^9}],

Cell[BoxData["False"], "Output",
 CellChangeTimes->{
  3.621795028045067*^9, 3.6217951931996202`*^9, 3.6217956597865963`*^9, 
   3.6217960426035147`*^9, 3.621969242032467*^9, {3.621969636751555*^9, 
   3.621969654006621*^9}, 3.621969733860959*^9, 3.621972511173944*^9}]
}, Open  ]],

Cell[TextData[{
 "Observe the action of negative weight operators on the subsingular vector \
and verify that they are descendents of singular vectors.  The action of ",
 Cell[BoxData[
  FormBox[
   SubscriptBox["L", "1"], TraditionalForm]]],
 " is shown below.  The other operators act similarly."
}], "Text",
 CellChangeTimes->{{3.6217960032770147`*^9, 3.621796028004814*^9}, {
  3.6217963174650717`*^9, 3.621796372720489*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"Operator", "[", 
   RowBox[{"L", ",", "1", ",", 
    RowBox[{"11", "/", "2"}]}], "]"}], ".", 
  "subsingular"}], "\[IndentingNewLine]", 
 RowBox[{"InVectorSpaceQ", "[", 
  RowBox[{
   RowBox[{"GramNullspace", "[", 
    RowBox[{
     RowBox[{"11", "/", "2"}], "-", "1"}], "]"}], ",", "%"}], "]"}]}], "Input",\

 CellChangeTimes->{{3.6217960292631073`*^9, 3.621796036213846*^9}, {
  3.621796275687035*^9, 3.621796313601021*^9}, {3.6217963743137913`*^9, 
  3.621796375206318*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"0", ",", "0", ",", "0", ",", "0", ",", 
   FractionBox["75", "32"], ",", 
   FractionBox["15", "16"], ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", 
   FractionBox["25", "32"], ",", 
   FractionBox["5", "16"], ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", 
   RowBox[{"-", 
    FractionBox["25", "48"]}], ",", 
   RowBox[{"-", 
    FractionBox["5", "24"]}], ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", 
   ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", 
   "0", ",", "0", ",", "0", ",", "0", ",", "0", ",", "0"}], "}"}]], "Output",
 CellChangeTimes->{
  3.62179603671902*^9, {3.6217962762904882`*^9, 3.621796338899168*^9}, 
   3.621796376101997*^9, {3.621969637480135*^9, 3.6219696545865088`*^9}, 
   3.621969734672233*^9, 3.62197251128351*^9}],

Cell[BoxData["True"], "Output",
 CellChangeTimes->{
  3.62179603671902*^9, {3.6217962762904882`*^9, 3.621796338899168*^9}, 
   3.621796376101997*^9, {3.621969637480135*^9, 3.6219696545865088`*^9}, 
   3.621969734672233*^9, 3.6219725114125443`*^9}]
}, Open  ]]
}, Open  ]]
}, Open  ]]
},
WindowSize->{890, 920},
WindowMargins->{{44, Automatic}, {58, Automatic}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
FrontEndVersion->"10.0 for Mac OS X x86 (32-bit, 64-bit Kernel) (June 27, \
2014)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[580, 22, 198, 2, 92, "Title"],
Cell[781, 26, 675, 14, 87, "Text"],
Cell[CellGroupData[{
Cell[1481, 44, 101, 1, 64, "Section"],
Cell[1585, 47, 235, 4, 49, "Text"],
Cell[CellGroupData[{
Cell[1845, 55, 172, 3, 28, "Input"],
Cell[2020, 60, 152, 2, 22, "Print"]
}, Open  ]],
Cell[2187, 65, 815, 15, 165, "Text"],
Cell[3005, 82, 195, 4, 28, "Input"],
Cell[3203, 88, 427, 7, 49, "Text"],
Cell[3633, 97, 1258, 40, 63, "Input"],
Cell[4894, 139, 188, 4, 30, "Text"],
Cell[5085, 145, 154, 3, 28, "Input"],
Cell[5242, 150, 473, 8, 68, "Text"],
Cell[CellGroupData[{
Cell[5740, 162, 131, 2, 28, "Input"],
Cell[5874, 166, 1201, 37, 28, "Output"]
}, Open  ]],
Cell[7090, 206, 562, 13, 49, "Text"],
Cell[CellGroupData[{
Cell[7677, 223, 438, 14, 28, "Input"],
Cell[8118, 239, 398, 7, 28, "Output"]
}, Open  ]],
Cell[8531, 249, 528, 13, 49, "Text"],
Cell[CellGroupData[{
Cell[9084, 266, 241, 5, 28, "Input"],
Cell[9328, 273, 1341, 35, 58, "Output"]
}, Open  ]],
Cell[10684, 311, 465, 10, 49, "Text"],
Cell[CellGroupData[{
Cell[11174, 325, 347, 8, 46, "Input"],
Cell[11524, 335, 5710, 169, 126, "Output"],
Cell[17237, 506, 1586, 43, 58, "Output"]
}, Open  ]],
Cell[18838, 552, 538, 9, 68, "Text"],
Cell[CellGroupData[{
Cell[19401, 565, 913, 27, 63, "Input"],
Cell[20317, 594, 1470, 42, 51, "Output"]
}, Open  ]],
Cell[21802, 639, 457, 8, 68, "Text"],
Cell[CellGroupData[{
Cell[22284, 651, 699, 17, 63, "Input"],
Cell[CellGroupData[{
Cell[23008, 672, 435, 8, 22, "Print"],
Cell[23446, 682, 564, 10, 22, "Print"],
Cell[24013, 694, 410, 8, 22, "Print"],
Cell[24426, 704, 435, 8, 22, "Print"],
Cell[24864, 714, 563, 10, 22, "Print"],
Cell[25430, 726, 412, 8, 22, "Print"],
Cell[25845, 736, 410, 8, 22, "Print"],
Cell[26258, 746, 410, 8, 22, "Print"],
Cell[26671, 756, 410, 8, 22, "Print"],
Cell[27084, 766, 410, 8, 22, "Print"],
Cell[27497, 776, 434, 8, 22, "Print"],
Cell[27934, 786, 564, 10, 22, "Print"],
Cell[28501, 798, 410, 8, 22, "Print"],
Cell[28914, 808, 410, 8, 22, "Print"],
Cell[29327, 818, 412, 8, 22, "Print"],
Cell[29742, 828, 412, 8, 22, "Print"],
Cell[30157, 838, 412, 8, 22, "Print"],
Cell[30572, 848, 433, 8, 22, "Print"],
Cell[31008, 858, 570, 11, 22, "Print"],
Cell[31581, 871, 410, 8, 22, "Print"],
Cell[31994, 881, 410, 8, 22, "Print"],
Cell[32407, 891, 435, 8, 22, "Print"],
Cell[32845, 901, 570, 11, 22, "Print"],
Cell[33418, 914, 497, 10, 22, "Print"],
Cell[33918, 926, 498, 10, 22, "Print"],
Cell[34419, 938, 498, 10, 22, "Print"],
Cell[34920, 950, 500, 10, 22, "Print"],
Cell[35423, 962, 500, 10, 22, "Print"],
Cell[35926, 974, 504, 10, 22, "Print"],
Cell[36433, 986, 500, 10, 22, "Print"],
Cell[36936, 998, 500, 10, 22, "Print"]
}, Open  ]],
Cell[37451, 1011, 12160, 219, 447, 4188, 86, "CachedBoxData", "BoxData", \
"Output"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[49660, 1236, 153, 2, 64, "Section"],
Cell[49816, 1240, 891, 19, 89, "Text"],
Cell[CellGroupData[{
Cell[50732, 1263, 13005, 409, 751, "Input"],
Cell[63740, 1674, 595, 10, 22, "Print"]
}, Open  ]],
Cell[64350, 1687, 420, 7, 49, "Text"],
Cell[64773, 1696, 462, 15, 28, "Input"],
Cell[65238, 1713, 334, 6, 49, "Text"],
Cell[CellGroupData[{
Cell[65597, 1723, 1059, 31, 80, "Input"],
Cell[66659, 1756, 1148, 33, 50, "Output"]
}, Open  ]],
Cell[67822, 1792, 478, 8, 49, "Text"],
Cell[CellGroupData[{
Cell[68325, 1804, 371, 9, 28, "Input"],
Cell[68699, 1815, 783, 25, 48, "Output"]
}, Open  ]],
Cell[69497, 1843, 292, 5, 49, "Text"],
Cell[CellGroupData[{
Cell[69814, 1852, 761, 22, 80, "Input"],
Cell[70578, 1876, 268, 4, 22, "Print"],
Cell[70849, 1882, 380, 7, 47, "Output"],
Cell[71232, 1891, 268, 4, 22, "Print"],
Cell[71503, 1897, 380, 7, 46, "Output"]
}, Open  ]],
Cell[71898, 1907, 326, 6, 49, "Text"],
Cell[CellGroupData[{
Cell[72249, 1917, 1609, 50, 46, "Input"],
Cell[73861, 1969, 1206, 35, 52, "Output"],
Cell[75070, 2006, 1200, 34, 52, "Output"]
}, Open  ]],
Cell[76285, 2043, 501, 8, 68, "Text"],
Cell[CellGroupData[{
Cell[76811, 2055, 1604, 45, 114, "Input"],
Cell[78418, 2102, 230, 4, 22, "Print"],
Cell[78651, 2108, 517, 11, 47, "Output"],
Cell[79171, 2121, 227, 4, 22, "Print"],
Cell[79401, 2127, 459, 8, 28, "Output"]
}, Open  ]],
Cell[79875, 2138, 815, 14, 106, "Text"],
Cell[CellGroupData[{
Cell[80715, 2156, 3985, 100, 488, "Input"],
Cell[84703, 2258, 304, 5, 21, "Print"],
Cell[85010, 2265, 267, 4, 28, "Output"],
Cell[85280, 2271, 267, 4, 28, "Output"],
Cell[85550, 2277, 271, 5, 22, "Print"],
Cell[85824, 2284, 1305, 42, 84, "Output"],
Cell[87132, 2328, 336, 5, 38, "Print"],
Cell[87471, 2335, 265, 4, 28, "Output"],
Cell[87739, 2341, 360, 6, 38, "Print"],
Cell[88102, 2349, 267, 4, 28, "Output"],
Cell[88372, 2355, 322, 5, 22, "Print"],
Cell[88697, 2362, 269, 4, 28, "Output"]
}, Open  ]],
Cell[88981, 2369, 429, 9, 51, "Text"],
Cell[CellGroupData[{
Cell[89435, 2382, 513, 14, 46, "Input"],
Cell[89951, 2398, 1536, 26, 151, "Output"],
Cell[91490, 2426, 247, 4, 28, "Output"]
}, Open  ]]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)