Maple Programs for Binary Tensor Invariants and Outerplanar Graphs

Alec Mihailovs

Invariants and decompositions of tensor powers of the standard representation of  SL (2).

The dimension of the space of SL(2)- invariants in n -fold tensor product of the standard 2-dimensional representation of SL (2) can be determined using following command:

>    DimInvSL2 := n->`if`(n mod 2 = 0,
   binomial(n,n/2)/(n/2+1),
   0):

For example,

>    DimInvSL2(100);

1978261657756160653623774456

Here is the list of the dimensions for n  from 0 to 20:

>    for n from 0 to 20
   do A[n] := DimInvSL2(n) end do:
(op(op((A))));

[0 = 1, 1 = 0, 2 = 1, 3 = 0, 4 = 2, 5 = 0, 6 = 5, 7 = 0, 8 = 14, 9 = 0, 10 = 42, 11 = 0, 12 = 132, 13 = 0, 14 = 429, 15 = 0, 16 = 1430, 17 = 0, 18 = 4862, 19 = 0, 20 = 16796]
[0 = 1, 1 = 0, 2 = 1, 3 = 0, 4 = 2, 5 = 0, 6 = 5, 7 = 0, 8 = 14, 9 = 0, 10 = 42, 11 = 0, 12 = 132, 13 = 0, 14 = 429, 15 = 0, 16 = 1430, 17 = 0, 18 = 4862, 19 = 0, 20 = 16796]

We can also put the formula in a spreadsheet, so that it can be used without typing the command.

>    with(Spread):

>    i2 := CreateSpreadsheet():
for n to 10
   do SetCellFormula(i2,n,2,evaln(DimInvSL2(cat(~A,n)))) od;
SetSelection(i2,1$4):

22 58786
24 208012
26 742900
28 2674440
30 9694845
32 35357670
34 129644790
36 477638700
38 1767263190
40 6564120420

Now, entering a few numbers in first 10 cells of column A  will produce the dimensions of the invariant spaces in column B  after the evaluating of the worksheet. For example, try to enter some numbers. Reentering other numbers and reevaluating the worksheet will correct the dimensions. Another way of doing it is using Maplets.

>    with(Maplets[Elements]):

>    m_i2 := Maplet(
Window( 'title'="Dimensions of Invariants", [
    ["Enter the tensor power: ",
       TextField['TF1'](26, onchange=Evaluate('TB1' = evaln(DimInvSL2(TF1))))],
    ["Here is the dimension:   ",
       TextBox['TB1']('editable' = 'false',3..40 )],
    [Button("Evaluate the dimension", Evaluate('TB1' = evaln(DimInvSL2(TF1)))),
       Button("Close", Shutdown(['TF1', 'TB1'])),
       Button("Clear", SetOption('TF1' = ""))]
] ) ):
Maplets[Display]( m_i2 ):

Initializing Java runtime environment.

The maplet looks as follows:

[Maple Bitmap]

Similarly, we can produce the procedure, the spreadsheet, and the maplet for the decomposition of the tensor powers of the standard representation of SL (2).

>    MultSL2 := (n,k)->`if`(n-k mod 2 = 0,
   binomial(n,(n-k)/2)*(k+1)/(n-(n-k)/2+1),
   0):

For example,

>    MultSL2(6,2);

9

Here is the corresponding spreadsheet:

>    m2 := CreateSpreadsheet():
for n to 10
   do SetCellFormula(m2,n,3,evaln(MultSL2(cat(~A,n),cat(~B,n)))) od;
SetSelection(m2,1$4):

2 0 1
4 2 3
6 4 5
9 1 42
12 12 1
15 15 1
20 10 10659
25 19 2000
30 26 405
37 17 223926516

Entering the tensor power in the A column and the index of the irreducible representation in the B column, we obtain the multiplicity of the representation in the tensor power of the standard representation of SL (2). Here is the maplet:

>    m_m2 := Maplet(
Window( 'title'="Multiplicities of Representations", [
    ["Enter the tensor power: ",
       TextField['TF1'](26,onchange=Evaluate('TB1' = evaln(MultSL2(TF1,TF2)))),
       Button("Clear", SetOption('TF1' = ""))],
    [["Enter the index", "of the representation:"],
       TextField['TF2'](26,onchange=Evaluate('TB1' = evaln(MultSL2(TF1,TF2)))),
       Button("Clear", SetOption('TF2' = ""))],
    ["Here is the multiplicity:   ",
       TextBox['TB1']('editable' = 'false',3..50 )],
    [Button("Evaluate the multiplicity", Evaluate('TB1' = evaln(MultSL2(TF1,TF2)))),
       Button("Close", Shutdown(['TF1', 'TF2', 'TB1'])),
       Button("Clear", SetOption('TB1' = ""))]
] ) ):
Maplets[Display]( m_m2 ):

The maplet looks as follows:

[Maple Bitmap]

Certainly, it can be used for the determining of the dimensions of the invariant spaces as well:

[Maple Bitmap]

Comparing with the calculation done by the previous maplet shows that the results are the same.

The following formula, the spreadsheet, and the maplet give all the multiplicities at once as the coefficients of a polynomial.  

>    MultPolSL2 := (n,x)->sum(evaln(MultSL2(n,'k'))*x^'k','k'=0..n):

For example,

>    MultPolSL2(10,x);

42+90*x^2+75*x^4+35*x^6+9*x^8+x^10

means that that the 10-fold tesor power of the standard representation of SL (2) equals the direct sum of the 42-dimensional space of invariants,

90 irreducible representations of dimension 3, 75 irreducible representations of dimension 5, 35 irreducible representation of dimension 7, 9 irreducible representations of dimension 9, and 1 irreducible representation of dimension 11. The following formula gives the dimension of the representation presented by such a polynomial:

>    dimSL2 := p->subs(x=1,diff(x*p,x)):

We can use this command to check the dimension of the representation above,

>    dimSL2(%%);

1024

The spreadsheet can be defined as

>    p2 := CreateSpreadsheet():
for n to 10 do SetCellFormula(p2,n,2,evaln(MultPolSL2(cat(~A,n),x))) od;
SetSelection(p2,1$4):

1 x
2 1+x^2
3 2*x+x^3
4 2+3*x^2+x^4
5 5*x+4*x^3+x^5
6 5+9*x^2+5*x^4+x^6
7 14*x+14*x^3+6*x^5+x^7
8 14+28*x^2+20*x^4+7*x^6+x^8
9 42*x+48*x^3+27*x^5+8*x^7+x^9
10 42+90*x^2+75*x^4+35*x^6+9*x^8+x^10

Here is the maplet:

>    m_p2 := Maplet(
Window( 'title'="Multiplicities of Representations", [
    ["Enter the tensor power: ",
       TextField['TF1'](26),
       Button("Clear", SetOption('TF1' = ""))],
    ["Here are the multiplicities:",
       TextBox['TB1']('editable' = 'false',10..50 )],
    [Button("Evaluate the polynomial", Evaluate('TB1' = evaln(MultPolSL2(TF1,x)))),
       Button("Close", Shutdown(['TF1', 'TB1'])),
       Button("Clear", SetOption('TB1' = ""))]
] ) ):
Maplets[Display]( m_p2 ):

However, for large tensor powers, the results need to be sorted. See, for instance, the results for n  = 56:

[Maple Bitmap]

In cases like that, it is better to organize the results in a matrix form:

>    MatSL2 := n->Matrix(n+1,2,(i,j)->`if`(j=1,
   i-1,
   MultSL2(n,i-1))):

>    MatSL2(6);

_rtable[11110552]

>    m_h2 := Maplet(
Window( 'title'="Multiplicities of Representations", [
    ["Enter the tensor power: ",
       TextField['TF1'](26, onchange=Evaluate('TB1' = evaln(MatSL2(TF1)))),
       Button("Clear", SetOption('TF1' = ""))],
    ["Here are the multiplicities:",
       TextBox['TB1']('editable' = 'false',10..50 )],
    [Button("Evaluate the multiplicities", Evaluate('TB1' = evaln(MatSL2(TF1)))),
       Button("Close", Shutdown(['TF1', 'TB1'])),
       Button("Clear", SetOption('TB1' = ""))]
] ) ):
Maplets[Display]( m_h2 ):

The result is more readable than in the previous maplet's output:

[Maple Bitmap]

Comparing the pictures of the Maplets with the Maple source, one can easily change them accordingly her/his computing needs.

Outerplanar Graphs

The formula for the dimension of the space of n -fold tensor invariants gives us the formula for the number of outerplanar 1-regular graphs with n  vertices. For instance, the number of the outerplanar graphs with 6 vertices is

>    DimInvSL2(6);

5

Writing x  at the left vertix of every arc and y  at the right vertex of every arc, we obtain a word in the alphabet { x, y }. They are so-called balanced lattice words. "Balanced" mean that the number of x 's is equal to the number of y 's. The following recursive procedure determines the k -th balanced lattice word of length n  in the lexicographical order, so that xx...xyy...y  is the first word and xyxy...xy  is the last one. The procedure outputs a list of length n  with 1's instead of x 's and -1's instead of y 's. A "lattice" word in this context means that the sum of 1's and -1's from 1st position to the m -th position is non-negative for all m .  

>    BLW := proc(n,k)
option remember;
local i,j, numset;
numset := [0$n/2+1];
for i from 2 to n/2+1
do numset[i] := numset[i-1]+DimInvSL2(n-2*(i-1))*DimInvSL2(2*(i-2)) od;
j:=1;
while (k>numset[j])
do j:=j+1 od;
[1,
   op(BLW(n-2*(j-1),  
   iquo(k-numset[j-1]-1,
   DimInvSL2(2*(j-2)))+1)),
   -1,
   op(BLW(2*(j-2),
   irem(k-numset[j-1]-1,
   DimInvSL2(2*(j-2)))+1))]
end proc:
BLW(0,1) := []:

For example, here is the list of the balanced lattice words for n  = 6.

>    for k from 1 to DimInvSL2(6)
   do BLW(6,k) od;

[1, 1, 1, -1, -1, -1]

[1, 1, -1, 1, -1, -1]

[1, 1, -1, -1, 1, -1]

[1, -1, 1, 1, -1, -1]

[1, -1, 1, -1, 1, -1]

To draw the outerplanar graphs, it is better to have lists of the non-intersecting arcs instead:

>    OPG := proc(n,k)
option remember;
local i,j, numset;
numset:=array([0$n/2+1]);
for i from 2 to n/2+1
   do numset[i] :=  numset[i-1]+DimInvSL2(n-2*(i-1))*DimInvSL2(2*(i-2)) od;
j:=1;
while (k>numset[j])
   do j:=j+1 od;
[[1,n-2*(j-2)],
   op(map(x->[x[1]+1, x[2]+1],
      OPG(n-2*(j-1), iquo(k-numset[j-1]-1,DimInvSL2(2*(j-2)))+1))),
   op(map(x->[x[1]+n-2*(j-2), x[2]+n-2*(j-2)],
      OPG(2*(j-2), irem(k-numset[j-1]-1,DimInvSL2(2*(j-2)))+1)))]
end proc:
OPG(0,1):=[]:

For example, here is the list of the lists of the non-intersecting arcs for n  = 6.

>    for k from 1 to DimInvSL2(6)
  do OPG(6,k) od;

[[1, 6], [2, 5], [3, 4]]

[[1, 6], [2, 3], [4, 5]]

[[1, 4], [2, 3], [5, 6]]

[[1, 2], [3, 6], [4, 5]]

[[1, 2], [3, 4], [5, 6]]

The following procedure draws cr  outerplanar graphs with n  vertices, starting from   k ,   displaying c graphs in each row, in r  rows, numbering vertices with step s .

>    GridOPG := proc (n,k,c,r,s)
local nr,nlr,cr,i1,opg,lin,i,ir,ic,lab,w,t;
w:=interface(warnlevel);
interface(warnlevel=0);
with(plots);
with(plottools);
interface(warnlevel=w);
nr := `if`(r<(DimInvSL2(n)-k+1)/c,
   r,
   ceil((DimInvSL2(n)-k+1)/c));
nlr := `if`(k+c*nr-1<=DimInvSL2(n),
   c,
   DimInvSL2(n)-k+1-c*(nr-1));
cr:=i1->`if`(i1+1<nr,
   c,
   nlr);
opg:=seq(seq(seq(
   arc([(OPG(n,k+ir*c+ic)[i,1]+OPG(n,k+ir*c+ic)[i,2])/2+ic*(n+4),-ir*(n/2+2)],
        (OPG(n,k+ir*c+ic)[i,2]-OPG(n,k+ir*c+ic)[i,1])/2,
         0..Pi, color=red, thickness=3),
   i=1..n/2),
   ic=0..cr(ir)-1),
   ir=0..nr-1);
lin:=seq(seq(
line([ic*(n+4),-ir*(n/2+2)],
   [n+1+ic*(n+4),-ir*(n/2+2)],
   color=blue),
   ic=0..cr(ir)-1),
   ir=0..nr-1);
t:=floor(n/s);
lab:= textplot([seq(seq(seq(
   [ic*(n+4)+i*s, -ir*(n/2+2)-n/12, i*s],
   i=1..t),
   ic=0..cr(ir)-1),
   ir=0..nr-1)]);
display(opg,lin,lab,axes=NONE,scaling=CONSTRAINED)
end:

Here are the pictures of the outerplanar graphs with 6 vertices or less.

>    for n from 0 to 3
   do GridOPG(n+n,1,2,3,1) od;

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

For n  = 8 we will use the grid command twice:

>    GridOPG(8,1,2,4,1);
GridOPG(8,9,2,4,1);

[Maple Plot]

[Maple Plot]

For n  = 10 we will use a loop:

>    for i to 6
   do GridOPG(10,8*i-7,2,4,1) od;

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

Also, this procedure can be used for drawing just one outerplanar graph, or two. For instance, what is the "central" outerplanar graph with 24 vertices? First, we need to find the number of outerplanar graphs with 24 vertices:

>    DimInvSL2(24);

208012

 
Thus, there are 2 "central" outerplanar graphs with 24 vertices:

>    GridOPG(24,104006,1,2,2);

[Maple Plot]

The second graph looks very symmetric. It is easy to see though that for every n divisible by 4, the number of the outerplanar graphs with n vertices is even and the "second central" graph looks similar to the picture above. It follows from the symmetry of the identity

   c[n] = c[n-1]*c[0]+c[n-2]*c[1]  + ... + c[1]*c[n-2]+c[0]*c[n-1]  .

An interesting question is what is the number of the similarly looking outerplanar graph with 24 vertices, combined out of 3 outerplanar graphs with 8 vertices, each of which is the graph number 1 in the list of the outerplanar graphs with 8 vertices (see the picture below)? To solve problems like that, it is convenient to have a procedure determining the number of the outerplanar graph from the list of its arcs:  

>    NumOPG := proc(a)
option remember;
local i, n, num,x;
n:=nops(a);
add(DimInvSL2(2*(n-i))*DimInvSL2(2*(i-1)),i=1..n-a[1,2]/2)
 + (NumOPG( map(x->[x[1]-1,x[2]-1],
   a[2..a[1,2]/2]))-1)*DimInvSL2(2*n-a[1,2]) +
   NumOPG( map(x->[x[1]-a[1,2],x[2]-a[1,2]],
   a[a[1,2]/2+1..n]))  
end:
NumOPG([]):=1:

Let's test if it is working correctly for the outerplanar graph above.

>    NumOPG([[1, 12], [2, 11], [3, 10], [4, 9], [5, 8], [6, 7],
   [13, 24], [14, 23], [15, 22], [16, 21], [17, 20], [18, 19]]);

104007

Correct answer. Now,

>    NumOPG([op(OPG(8,1)),
   op(map(x->[x[1]+8,x[2]+8],OPG(8,1))),
   op(map(x->[x[1]+16,x[2]+16],
   OPG(8,1)))]);

116272

>    GridOPG(24, 116272, 1, 1, 2);

[Maple Plot]

Now, we can convert our procedures into maplets.

>    m_g2 := Maplet(
Window('title'="Outerplanar graphs",[
   ["Enter the tensor power: ",
       TextField['TF1'](),
       "       the number of columns:",
       TextField['TF3']()],
   ["          the initial number: ",
       TextField['TF2'](),
       "       the number of rows:     ",
       TextField['TF4']()],
   Plotter['PL1'](  ),
   ["Step of numbering:",
       TextField['TF5']("1"),
       "     ",
       Button("Draw", Evaluate('PL1' = 'GridOPG(TF1,TF2,TF3,TF4,TF5)') ),
       Button("Clear", Action(SetOption('TF1'=""), SetOption('TF2'=""),
            SetOption('TF3'=""), SetOption('TF4'=""),
            SetOption('PL1'="plot(undefined,x=1..10,axes=NONE)"))),
       Button("Close", Shutdown(['TF1','TF2','TF3','TF4','TF5']))]
])):
Maplets[Display]( m_g2 ):

The applet looks as follows:

[Maple Bitmap]

Also, both OPG  and BLW procedures can be converted into a maplet.

>    with(Maplets[Elements]):

>    m_b2 := Maplet(
Window( 'title'="Arcs and Words", [
    ["Enter the tensor power: ",
        TextField['TF1'](26,onchange = Action(Evaluate(
            'TB1' = evaln(OPG(TF1,TF2))),
            Evaluate('TB2' = evaln(BLW(TF1,TF2)))))],
    ["       Enter the number:    ",
        TextField['TF2'](26,onchange=Action(Evaluate(
            'TB1' = evaln(OPG(TF1,TF2))),
            Evaluate('TB2' = evaln(BLW(TF1,TF2)))))],
    ["Here is the list of arcs:  ",
        TextBox['TB1']('editable' = 'false',6..40 )],
    ["Here is the lattice word: ",
        TextBox['TB2']('editable' = 'false',6..40 )],
    [Button("List arcs and the word", Action(Evaluate(
            'TB1' = evaln(OPG(TF1,TF2))),
            Evaluate('TB2' = evaln(BLW(TF1,TF2))))),
        Button("Close", Shutdown(['TF1', 'TF2', 'TB1', 'TB2'])),
        Button("Clear", Action(SetOption('TF1' = ""),
            SetOption('TF2' = ""),
            SetOption('TB1' = ""),
            SetOption('TB2' = "")))]
] ) ):
Maplets[Display]( m_b2 ):

Here is how it looks:

[Maple Bitmap]

It is interesting to compare it with the result obtained using the previous maplet:

[Maple Bitmap]

Sometimes it is more convenient to use spreadsheets:

>    b2:=CreateSpreadsheet():
for n to 10
    do SetCellFormula(b2,n,3,evaln(OPG(cat(~A,n),cat(~B,n))));
         SetCellFormula(b2,n,4,evaln(BLW(cat(~A,n),cat(~B,n)))) od;
SetSelection(b2,1$4):

2 1 [[1, 2]] [1, -1]
6 3 [[1, 4], [2, 3], [5, 6]] [1, 1, -1, -1, 1, -1]
10 5 [[1, 10], [2, 9], [3, 4], [5, 6], [7, 8]] [1, 1, 1, -1, 1, -1, 1, -1, -1, -1]
10 42 [[1, 2], [3, 4], [5, 6], [7, 8], [9, 10]] [1, -1, 1, -1, 1, -1, 1, -1, 1, -1]
20 200 [[1, 20], [2, 19], [3, 18], [4, 13], [5, 6], [7, 8], [9, 12], [10, 11], [14, 15], [16, 17]]
[[1, 20], [2, 19], [3, 18], [4, 13], [5, 6], [7, 8], [9, 12], [10, 11], [14, 15], [16, 17]]
[1, 1, 1, 1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1, -1]
[1, 1, 1, 1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1, -1]
12 100 [[1, 2], [3, 12], [4, 5], [6, 11], [7, 10], [8, 9]]
[[1, 2], [3, 12], [4, 5], [6, 11], [7, 10], [8, 9]]
[1, -1, 1, 1, -1, 1, 1, 1, -1, -1, -1, -1]
16 1024 [[1, 2], [3, 16], [4, 15], [5, 10], [6, 7], [8, 9], [11, 12], [13, 14]]
[[1, 2], [3, 16], [4, 15], [5, 10], [6, 7], [8, 9], [11, 12], [13, 14]]
[1, -1, 1, 1, 1, 1, -1, 1, -1, -1, 1, -1, 1, -1, -1, -1]
[1, -1, 1, 1, 1, 1, -1, 1, -1, -1, 1, -1, 1, -1, -1, -1]
32 1024 [[1, 32], [2, 31], [3, 30], [4, 29], [5, 28], [6, 27], [7, 26], [8, 25], [9, 10], [11, 24], [12, 23], [13, 18], [14, 15], [16, 17], [19, 20], [21, 22]]
[[1, 32], [2, 31], [3, 30], [4, 29], [5, 28], [6, 27], [7, 26], [8, 25], [9, 10], [11, 24], [12, 23], [13, 18], [14, 15], [16, 17], [19, 20], [21, 22]]
[[1, 32], [2, 31], [3, 30], [4, 29], [5, 28], [6, 27], [7, 26], [8, 25], [9, 10], [11, 24], [12, 23], [13, 18], [14, 15], [16, 17], [19, 20], [21, 22]]
[[1, 32], [2, 31], [3, 30], [4, 29], [5, 28], [6, 27], [7, 26], [8, 25], [9, 10], [11, 24], [12, 23], [13, 18], [14, 15], [16, 17], [19, 20], [21, 22]]
[1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, -1, 1, -1, -1, 1, -1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1]
[1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, -1, 1, -1, -1, 1, -1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1]
[1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1, -1, 1, -1, -1, 1, -1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1]
14 1000 `Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in BLW) invalid subscript selector\n`
`Error, (in BLW) invalid subscript selector\n`
`Error, (in BLW) invalid subscript selector\n`
14 3000 `Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in OPG) 1st index, 9, larger than upper array bound 8\n`
`Error, (in BLW) invalid subscript selector\n`
`Error, (in BLW) invalid subscript selector\n`
`Error, (in BLW) invalid subscript selector\n`

Entering n  in the first column and k  in the second produces the list of non-intersecting arcs in the 3rd column and the corresponding balanced lattice word in the 4th column.  

Random walks

The similar procedures and maplets can be developed for random walks on the half-line. It is convenient to represent such a walk as its graph. The following procedure converts a balance lattice word into the sequence of the y  values for its graph.

>    hei := proc(a)
local i, b;
b:=array([0,op(a)]);
for i from 2 to nops(a)+1
     do b[i]:=b[i]+b[i-1] od;
convert(b,list)
end:

For instance,

>    hei([1,1,-1,1,-1,-1]);

[0, 1, 2, 1, 2, 1, 0]

The following procedure draws cr  graphs of random walks on a half-line with n  steps, starting from  a walk number k ,   displaying c graphs in each row, in r  rows, numbering vertices with step s .

>    GridBLW := proc(n,k,c,r,s)
local nr,nlr,cr,i1,blw,lin,i,ir,ic,lab,w,t;
w := interface(warnlevel);
interface( warnlevel=0 );
with(plots);
with(plottools);
interface(warnlevel=w);
nr := `if`(r<(DimInvSL2(n)-k+1)/c,
     r,
     ceil((DimInvSL2(n)-k+1)/c));
nlr := `if`(k+c*nr-1<=DimInvSL2(n),
     c,
     DimInvSL2(n)-k+1-c*(nr-1));
cr := i1->`if`(i1+1<nr,
     c,
     nlr);
blw:=seq(seq(seq(
line([ic*(n+4)+i,hei(BLW(n,k+ir*c+ic))[i]-ir*(n/2+2)],
     [ic*(n+4)+i+1,hei(BLW(n,k+ir*c+ic))[i+1]-ir*(n/2+2)],
     color=red, thickness=3),
     i=1..n),
     ic=0..cr(ir)-1),
     ir=0..nr-1);
lin:=seq(seq(
line([ic*(n+4),-ir*(n/2+2)],
     [n+2+ic*(n+4),-ir*(n/2+2)],
     color=blue),
     ic=0..cr(ir)-1),
     ir=0..nr-1);
t:=floor(n/s);
lab:= textplot([seq(seq(seq(
     [ic*(n+4)+i*s+1,-ir*(n/2+2)-n/12,i*s],
     i=0..t),
     ic=0..cr(ir)-1),
     ir=0..nr-1)]);
display( blw, lin, lab, axes=NONE, scaling=CONSTRAINED)
end:

For example, here are the graphs of the walks with 6 steps or less:

>    for n from 0 to 3
     do GridBLW(n+n,1,2,3,1) od;

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

For n  = 8 we will use the grid command twice:

>    GridBLW(8,1,2,4,1);
GridBLW(8,9,2,4,1);

[Maple Plot]

[Maple Plot]

For n  = 10 we will use a loop:

>    for i to 6
    do GridBLW(10,8*i-7,2,4,1) od;

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

[Maple Plot]

Here are a few other examples:

>    GridBLW(24,104006,1,2,2);

[Maple Plot]

>    GridBLW(24,116272,1,1,2);

[Maple Plot]

Now, we can convert our procedures into maplets.

>    m_r2 := Maplet(
Window('title'="Random Walks",[
   ["Enter the tensor power: ",
       TextField['TF1'](),
       "       the number of columns:",
       TextField['TF3']()],
   ["          the initial number: ",
       TextField['TF2'](),
       "       the number of rows:     ",
       TextField['TF4']()],
   Plotter['PL1'](  ),
   ["Step of numbering:",
       TextField['TF5']("1"),
       "     ",
       Button("Draw", Evaluate(
           'PL1' = 'GridBLW(TF1,TF2,TF3,TF4,TF5)') ),
       Button("Clear", Action(SetOption('TF1'=""),
           SetOption('TF2'=""),
           SetOption('TF3'=""),
           SetOption('TF4'=""),
           SetOption('PL1'="plot(undefined,x=1..10,axes=NONE)"))),
       Button("Close", Shutdown(['TF1','TF2','TF3','TF4','TF5']))]
])):
Maplets[Display]( m_r2 ):

The applet looks as follows:

[Maple Bitmap]

The maplet for the OPG  and BLW  procedures can be extended, including hei .

>    with (Maplets[Elements]):

>    m_w2 := Maplet(
Window( 'title'="Arcs, Words, and Walks", [
    ["Enter the tensor power:  ",
        TextField['TF1'](26,onchange=Action(Evaluate(
             'TB1' = evaln(OPG(TF1,TF2))),
             Evaluate('TB2' = evaln(BLW(TF1,TF2))),
             Evaluate('TB3' = evaln(hei(evaln(BLW(TF1,TF2)))))))],
    ["       Enter the number:     ",
        TextField['TF2'](26,onchange=Action(Evaluate(
             'TB1' = evaln(OPG(TF1,TF2))),
             Evaluate('TB2' = evaln(BLW(TF1,TF2))),
             Evaluate('TB3' = evaln(hei(evaln(BLW(TF1,TF2)))))))],
    ["Here is the list of arcs:    ",
        TextBox['TB1']('editable' = 'false',6..40 )],
    ["Here is the lattice word:  ",
        TextBox['TB2']('editable' = 'false',6..40 )],
    ["Here is the random walk:",
        TextBox['TB3']('editable' = 'false',6..40 )],
    [Button("List arcs, the word, and the walk", Action(
             Evaluate('TB1' = evaln(OPG(TF1,TF2))),
             Evaluate('TB2' = evaln(BLW(TF1,TF2))),
             Evaluate('TB3' = evaln(hei(evaln(BLW(TF1,TF2))))))),
        Button("Close", Shutdown(['TF1', 'TF2', 'TB1', 'TB2', 'TB3'])),
        Button("Clear", Action(SetOption('TF1' = ""),
             SetOption('TF2' = ""),
             SetOption('TB1' = ""),
             SetOption('TB2' = "")))]
] ) ):
Maplets[Display]( m_w2 ):

Here is how it looks:

[Maple Bitmap]

It is interesting to compare it with the result obtained using the previous maplet:

[Maple Bitmap]

Here is the spreadsheet duplicating the last maplet:

>    w2:=CreateSpreadsheet():
for n to 10  
     do SetCellFormula(w2,n,3,evaln(OPG(cat(~A,n),cat(~B,n))));
        SetCellFormula(w2,n,4,evaln(BLW(cat(~A,n),cat(~B,n))));
        SetCellFormula(w2,n,5,evaln(hei(cat(~D,n)))) od;
SetSelection(w2,1$4):

8 5 [[1, 8], [2, 3], [4, 5], [6, 7]] [1, 1, -1, 1, -1, 1, -1, -1] [0, 1, 2, 1, 2, 1, 2, 1, 0]
10 20 [[1, 6], [2, 5], [3, 4], [7, 10], [8, 9]] [1, 1, 1, -1, -1, -1, 1, 1, -1, -1] [0, 1, 2, 3, 2, 1, 0, 1, 2, 1, 0]
12 40 [[1, 12], [2, 3], [4, 5], [6, 9], [7, 8], [10, 11]]
[[1, 12], [2, 3], [4, 5], [6, 9], [7, 8], [10, 11]]
[1, 1, -1, 1, -1, 1, 1, -1, -1, 1, -1, -1] [0, 1, 2, 1, 2, 1, 2, 3, 2, 1, 2, 1, 0]
14 50 [[1, 14], [2, 11], [3, 6], [4, 5], [7, 10], [8, 9], [12, 13]]
[[1, 14], [2, 11], [3, 6], [4, 5], [7, 10], [8, 9], [12, 13]]
[1, 1, 1, 1, -1, -1, 1, 1, -1, -1, -1, 1, -1, -1] [0, 1, 2, 3, 4, 3, 2, 3, 4, 3, 2, 1, 2, 1, 0]
16 100 [[1, 16], [2, 15], [3, 4], [5, 14], [6, 7], [8, 13], [9, 12], [10, 11]]
[[1, 16], [2, 15], [3, 4], [5, 14], [6, 7], [8, 13], [9, 12], [10, 11]]
[1, 1, 1, -1, 1, 1, -1, 1, 1, 1, -1, -1, -1, -1, -1, -1]
[1, 1, 1, -1, 1, 1, -1, 1, 1, 1, -1, -1, -1, -1, -1, -1]
[0, 1, 2, 3, 2, 3, 4, 3, 4, 5, 6, 5, 4, 3, 2, 1, 0]
18 200 [[1, 18], [2, 17], [3, 12], [4, 5], [6, 7], [8, 11], [9, 10], [13, 14], [15, 16]]
[[1, 18], [2, 17], [3, 12], [4, 5], [6, 7], [8, 11], [9, 10], [13, 14], [15, 16]]
[1, 1, 1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1]
[1, 1, 1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1]
[0, 1, 2, 3, 4, 3, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 2, 1, 0]
[0, 1, 2, 3, 4, 3, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 2, 1, 0]
20 300 [[1, 20], [2, 19], [3, 18], [4, 5], [6, 17], [7, 16], [8, 15], [9, 12], [10, 11], [13, 14]]
[[1, 20], [2, 19], [3, 18], [4, 5], [6, 17], [7, 16], [8, 15], [9, 12], [10, 11], [13, 14]]
[1, 1, 1, 1, -1, 1, 1, 1, 1, 1, -1, -1, 1, -1, -1, -1, -1, -1, -1, -1]
[1, 1, 1, 1, -1, 1, 1, 1, 1, 1, -1, -1, 1, -1, -1, -1, -1, -1, -1, -1]
[0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 6, 7, 6, 5, 4, 3, 2, 1, 0]
[0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 6, 7, 6, 5, 4, 3, 2, 1, 0]
22 1000 [[1, 22], [2, 21], [3, 20], [4, 7], [5, 6], [8, 9], [10, 11], [12, 13], [14, 15], [16, 19], [17, 18]]
[[1, 22], [2, 21], [3, 20], [4, 7], [5, 6], [8, 9], [10, 11], [12, 13], [14, 15], [16, 19], [17, 18]]
[[1, 22], [2, 21], [3, 20], [4, 7], [5, 6], [8, 9], [10, 11], [12, 13], [14, 15], [16, 19], [17, 18]]
[1, 1, 1, 1, 1, -1, -1, 1, -1, 1, -1, 1, -1, 1, -1, 1, 1, -1, -1, -1, -1, -1]
[1, 1, 1, 1, 1, -1, -1, 1, -1, 1, -1, 1, -1, 1, -1, 1, 1, -1, -1, -1, -1, -1]
[0, 1, 2, 3, 4, 5, 4, 3, 4, 3, 4, 3, 4, 3, 4, 3, 4, 5, 4, 3, 2, 1, 0]
[0, 1, 2, 3, 4, 5, 4, 3, 4, 3, 4, 3, 4, 3, 4, 3, 4, 5, 4, 3, 2, 1, 0]
24 10000 [[1, 24], [2, 23], [3, 8], [4, 7], [5, 6], [9, 10], [11, 18], [12, 17], [13, 16], [14, 15], [19, 22], [20, 21]]
[[1, 24], [2, 23], [3, 8], [4, 7], [5, 6], [9, 10], [11, 18], [12, 17], [13, 16], [14, 15], [19, 22], [20, 21]]
[[1, 24], [2, 23], [3, 8], [4, 7], [5, 6], [9, 10], [11, 18], [12, 17], [13, 16], [14, 15], [19, 22], [20, 21]]
[1, 1, 1, 1, 1, -1, -1, -1, 1, -1, 1, 1, 1, 1, -1, -1, -1, -1, 1, 1, -1, -1, -1, -1]
[1, 1, 1, 1, 1, -1, -1, -1, 1, -1, 1, 1, 1, 1, -1, -1, -1, -1, 1, 1, -1, -1, -1, -1]
[0, 1, 2, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 4, 3, 2, 3, 4, 3, 2, 1, 0]
[0, 1, 2, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 4, 3, 2, 3, 4, 3, 2, 1, 0]
26 100000 [[1, 26], [2, 15], [3, 14], [4, 5], [6, 9], [7, 8], [10, 11], [12, 13], [16, 19], [17, 18], [20, 23], [21, 22], [24, 25]]
[[1, 26], [2, 15], [3, 14], [4, 5], [6, 9], [7, 8], [10, 11], [12, 13], [16, 19], [17, 18], [20, 23], [21, 22], [24, 25]]
[[1, 26], [2, 15], [3, 14], [4, 5], [6, 9], [7, 8], [10, 11], [12, 13], [16, 19], [17, 18], [20, 23], [21, 22], [24, 25]]
[1, 1, 1, 1, -1, 1, 1, -1, -1, 1, -1, 1, -1, -1, -1, 1, 1, -1, -1, 1, 1, -1, -1, 1, -1, -1]
[1, 1, 1, 1, -1, 1, 1, -1, -1, 1, -1, 1, -1, -1, -1, 1, 1, -1, -1, 1, 1, -1, -1, 1, -1, -1]
[0, 1, 2, 3, 4, 3, 4, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 1, 2, 3, 2, 1, 2, 1, 0]
[0, 1, 2, 3, 4, 3, 4, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 1, 2, 3, 2, 1, 2, 1, 0]

Here are the procedures determining an ordinal number of a balanced lattice word and of a random walk. Start from random walks:  

>    NumHei := proc(a)
option remember;
local i, m, n, numset,x;
n:=(nops(a)-1)/2;
numset:=array(sparse, 1..n);
for i from 2 to n
      do numset[i] := numset[i-1]+DimInvSL2(2*(n-i+1))*DimInvSL2(2*(i-2)) od;
m:=2;
while a[m] <> 0
      do m:=m+1 od;  
numset[n-(m-1)/2+1] +
(NumHei(map(x->x-1,a[2..m-1]))-1)*DimInvSL2(2*n-(m-1)) +
NumHei(a[m..2*n+1])
end:
NumHei([0]):=1:

For example,

>    NumHei([0, 1, 2, 1, 2, 3, 2, 1, 0, 1, 2, 3, 2, 3, 4, 5, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 6, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 3, 4, 3, 2, 3, 2, 1, 0]);

3000000000000

Here is the procedure determining the ordinal number of a balanced lattice word:

>    NumBLW := a->NumHei(hei(a)):

For example,

>    NumBLW([1, -1, 1, 1, 1, -1, -1, -1]);

10

Procedure hei converts words into walks. The following procedures do other conversions:

>    Hei2BLW := proc(b)
local i, a;
a:=[0$nops(b)-1];
for i to nops(a)
     do a[i]:=b[i+1]-b[i] od;
a end:

Example:

>    Hei2BLW([0, 1, 2, 1, 2, 3, 2, 1, 0, 1, 2, 3, 2, 3, 4, 5, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 6, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 3, 4, 3, 2, 3, 2, 1, 0]);

[1, 1, -1, 1, 1, -1, -1, -1, 1, 1, 1, -1, 1, 1, 1, -1, -1, 1, 1, -1, -1, -1, 1, -1, 1, 1, 1, 1, -1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1, 1, 1, -1, 1, 1, -1, -1, 1, -1, -1, -1]
[1, 1, -1, 1, 1, -1, -1, -1, 1, 1, 1, -1, 1, 1, 1, -1, -1, 1, 1, -1, -1, -1, 1, -1, 1, 1, 1, 1, -1, 1, -1, -1, -1, 1, -1, 1, -1, -1, -1, 1, 1, -1, 1, 1, -1, -1, 1, -1, -1, -1]

>    BLW2OPG := a->OPG(nops(a), NumBLW(a)):

For example,

>    BLW2OPG([1, -1, 1, 1, 1, -1, -1, -1]);

[[1, 2], [3, 8], [4, 7], [5, 6]]

Similarly,

>    OPG2BLW := a->BLW(2*nops(a),NumOPG(a)):

Example:

>    OPG2BLW([[1, 2], [3, 8], [4, 7], [5, 6]]);

[1, -1, 1, 1, 1, -1, -1, -1]

>    OPG2Hei := hei@OPG2BLW:

For example,

>    OPG2Hei([[1, 2], [3, 8], [4, 7], [5, 6]]);

[0, 1, 0, 1, 2, 3, 2, 1, 0]

>    Hei2OPG := a->OPG(nops(a)-1,NumHei(a)):

Example:

>    Hei2OPG([0, 1, 0, 1, 2, 3, 2, 1, 0]);

[[1, 2], [3, 8], [4, 7], [5, 6]]

To hold the naming convention, we can add

>    BLW2Hei := hei:

For example,

>    BLW2Hei([1, -1, 1, 1, 1, -1, -1, -1]);

[0, 1, 0, 1, 2, 3, 2, 1, 0]

Finally,

>    Hei := hei@BLW:

Example:

>    Hei( 50, 3000000000000 );

[0, 1, 2, 1, 2, 3, 2, 1, 0, 1, 2, 3, 2, 3, 4, 5, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 6, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 3, 4, 3, 2, 3, 2, 1, 0]
[0, 1, 2, 1, 2, 3, 2, 1, 0, 1, 2, 3, 2, 3, 4, 5, 4, 3, 4, 5, 4, 3, 2, 3, 2, 3, 4, 5, 6, 5, 6, 5, 4, 3, 4, 3, 4, 3, 2, 1, 2, 3, 2, 3, 4, 3, 2, 3, 2, 1, 0]

Formulas for Tensor Invariants

In this section we will use the tensor package.

>    with(tensor):

Warning, the name transform has been redefined

First, create the basis vectors x  and y .

>    x:=create([1],array([1,0])):

>    y:=create([1],array([0,1])):

Now, produce the basic invariant of the 2-fold tensor power of V.

>    omega:=lin_com(1,prod(x,y),-1,prod(y,x));

omega := TABLE([compts = matrix([[0, 1], [-1, 0]]), index_char = [1, 1]])

Here is the formula for the n -fold tensor product of it:  

>    om := proc(n)
option remember;
local i;
prod(om(n-1),omega) end:

>    om(0) := create([],1):

For instance,

>    act(display,om(2));

_____________________________________________________

  NON-ZERO INDEPENDENT COMPONENTS :

"[1, 2, 1, 2] ="

1

"[1, 2, 2, 1] ="

-1

"[2, 1, 1, 2] ="

-1

"[2, 1, 2, 1] ="

1

  CHARACTER :

[1, 1, 1, 1]

_____________________________________________________

It shows only non-zero components, but it is still rather long. We will introduce a few procedures allowing to see a tensor in more compact form.

The following procedure converts (2, 1, 2, 1) into yxyx .

>    conv := proc(a)
option remember;
cat(conv(a[1..-2]),`if`(a[-1]=1,'x','y'))
end:
conv([]):=``:

For example,

>    conv([2,1,2,1]);

yxyx

The following procedure shows tensors as polynomials of non-commuting variables x  and y .:

>    expand_tensor := a-> sum(evaln(op(entries(a[compts])['i']))*evaln(conv(indices(a[compts])['i'])),'i'=1..nops([entries(a[compts])])):

For example,

>    expand_tensor(omega);

xy-yx

>    expand_tensor(om(2));

xyxy-xyyx-yxxy+yxyx

The following procedure shows the tensor invariant corresonding to the (non-empty) lists of arcs a :

>    TI := proc(a)
local i, b, c, x;
b := map(x->op(x),a);
c := b;
for i to nops(b)
   do c[b[i]]:=i od;
permute_indices(om(nops(a)),c)
end:

For example,

>    expand_tensor(TI([[1,4],[2,3]]));

-xyxy+xxyy+yyxx-yxyx

Here is the list of the tensor invariants corresponding to the outerplanar graphs with no more than 8 vertices.

>    for n to 4 do
   for k to DimInvSL2(n+n) do
       print([n,k], expand_tensor(TI(OPG(n+n,k))) )
   od
od;

>   

[1, 1], xy-yx

[2, 1], -xyxy+xxyy+yyxx-yxyx

[2, 2], xyxy-xyyx-yxxy+yxyx

[3, 1], -xyxyxy+yxyxyx-xxyxyy+xyyxxy+yyxyxx-yxxyyx-yyyxxx+xxxyyy

[3, 2], yyxxyx+xyxyxy-yxyxyx+xxyxyy-xyxxyy+yxyyxx-xxyyxy-yyxyxx

[3, 3], -yyxxyx-xyxyxy+yxyxyx-xxyyyx+xxyyxy+xyxyyx+yyxxxy-yxyxxy

[3, 4], -xyxyxy+yxyxyx-xyyxyx+xyxxyy-yxxxyy-yxyyxx+yxxyxy+xyyyxx

[3, 5], xyxyxy-yxyxyx+xyyxyx-xyxyyx-xyyxxy-yxxyxy+yxxyyx+yxyxxy

[4, 1], xxyyxxyy-xyyyxxxy+xyyxyxxy-xxyxyxyy-yyyxyxxx+yxxyxyyx-yyxyxyxx+yyyyxxxx+xxxxyyyy-yxyyxxyx+xyxyxyxy-yxxxyyyx-xxxyxyyy+yxyxyxyx+yyxxyyxx-xyxxyyxy
[4, 1], xxyyxxyy-xyyyxxxy+xyyxyxxy-xxyxyxyy-yyyxyxxx+yxxyxyyx-yyxyxyxx+yyyyxxxx+xxxxyyyy-yxyyxxyx+xyxyxyxy-yxxxyyyx-xxxyxyyy+yxyxyxyx+yyxxyyxx-xyxxyyxy

[4, 2], yxxyyxyx-xyyxyxxy+xxyxyxyy-xxyxxyyy+yyyxyxxx-yxxyxyyx+yyxyxyxx-yyyxxyxx+xyxyyxxy-xxxyyxyy-xyxyxyxy+xxxyxyyy-yyxyyxxx-yxyxyxyx+yxyxxyyx+xyyxxyxy
[4, 2], yxxyyxyx-xyyxyxxy+xxyxyxyy-xxyxxyyy+yyyxyxxx-yxxyxyyx+yyxyxyxx-yyyxxyxx+xyxyyxxy-xxxyyxyy-xyxyxyxy+xxxyxyyy-yyxyyxxx-yxyxyxyx+yxyxxyyx+xyyxxyxy

[4, 3], yyxyxxyx-xxxyyyxy-yxyxyyxx-yxxyyxyx-xxyxyxyy-yyyxxxyx-xyxyxxyy-yyxyxyxx+yyyxxyxx+xyyxxxyy+xxxyyxyy+xyxyxyxy+yxxyyyxx+xxyxyyxy+yxyxyxyx-xyyxxyxy
[4, 3], yyxyxxyx-xxxyyyxy-yxyxyyxx-yxxyyxyx-xxyxyxyy-yyyxxxyx-xyxyxxyy-yyxyxyxx+yyyxxyxx+xyyxxxyy+xxxyyxyy+xyxyxyxy+yxxyyyxx+xxyxyyxy+yxyxyxyx-xyyxxyxy

[4, 4], -xyxxxyyy+xyxxyxyy+yxyyxyxx-xxyxyxyy-yyxxyxyx+xxyxxyyy-yxyyyxxx-yyxyxyxx-xyxyyxxy+xyxyxyxy+yyxyyxxx+yxyxyxyx+yyxxxyyx-yxyxxyyx-xxyyxyxy+xxyyyxxy
[4, 4], -xyxxxyyy+xyxxyxyy+yxyyxyxx-xxyxyxyy-yyxxyxyx+xxyxxyyy-yxyyyxxx-yyxyxyxx-xyxyyxxy+xyxyxyxy+yyxyyxxx+yxyxyxyx+yyxxxyyx-yxyxxyyx-xxyyxyxy+xxyyyxxy

[4, 5], -yyxyxxyx-xyxxyxyy-xxyyxxyy-yxyyxyxx+yxyxyyxx+xxyxyxyy+yyxxyxyx+xyxyxxyy+yyxyxyxx+yxyyxxyx-xyxyxyxy-xxyxyyxy-yxyxyxyx-yyxxyyxx+xxyyxyxy+xyxxyyxy
[4, 5], -yyxyxxyx-xyxxyxyy-xxyyxxyy-yxyyxyxx+yxyxyyxx+xxyxyxyy+yyxxyxyx+xyxyxxyy+yyxyxyxx+yxyyxxyx-xyxyxyxy-xxyxyyxy-yxyxyxyx-yyxxyyxx+xxyyxyxy+xyxxyyxy

[4, 6], -yyxyxxyx-xyyxxyyx+xyxyxyyx+xxxyyyxy+yxxyyxyx+yyyxxxyx-xxxyyyyx+yxyxyxxy+xxyxyyyx-yxxyyxxy-yyyxxxxy-xyxyxyxy+yyxyxxxy-xxyxyyxy-yxyxyxyx+xyyxxyxy
[4, 6], -yyxyxxyx-xyyxxyyx+xyxyxyyx+xxxyyyxy+yxxyyxyx+yyyxxxyx-xxxyyyyx+yxyxyxxy+xxyxyyyx-yxxyyxxy-yyyxxxxy-xyxyxyxy+yyxyxxxy-xxyxyyxy-yxyxyxyx+xyyxxyxy

[4, 7], yyxyxxyx+xxyyxyyx+yyxxyxxy-xyxyxyyx-yyxxyxyx-yxyxyxxy-xxyxyyyx+yxyyxxxy-yxyyxxyx+xyxyxyxy-yyxyxxxy+xxyxyyxy+yxyxyxyx+xyxxyyyx-xxyyxyxy-xyxxyyxy
[4, 7], yyxyxxyx+xxyyxyyx+yyxxyxxy-xyxyxyyx-yyxxyxyx-yxyxyxxy-xxyxyyyx+yxyyxxxy-yxyyxxyx+xyxyxyxy-yyxyxxxy+xxyxyyxy+yxyxyxyx+xyxxyyyx-xxyyxyxy-xyxxyyxy

[4, 8], xxyyxxyy+yyxxxxyy+yxyxxyxy-yxyxyyxx-yyxxyxyx-xyxyxxyy+xyxyyxyx-yxyxxxyy+xxyyyyxx+xyxyxyxy-yyxxxyxy-xxyyyxyx+yxyxyxyx-xyxyyyxx+yyxxyyxx-xxyyxyxy
[4, 8], xxyyxxyy+yyxxxxyy+yxyxxyxy-yxyxyyxx-yyxxyxyx-xyxyxxyy+xyxyyxyx-yxyxxxyy+xxyyyyxx+xyxyxyxy-yyxxxyxy-xxyyyxyx+yxyxyxyx-xyxyyyxx+yyxxyyxx-xxyyxyxy

[4, 9], -xxyyxyyx-yyxxyxxy+xyxyxyyx-yxyxxyxy+yyxxyxyx-xyxyyxyx+xyxyyxxy+yxyxyxxy-xyxyxyxy+yyxxxyxy+xxyyyxyx-yxyxyxyx-yyxxxyyx+yxyxxyyx+xxyyxyxy-xxyyyxxy
[4, 9], -xxyyxyyx-yyxxyxxy+xyxyxyyx-yxyxxyxy+yyxxyxyx-xyxyyxyx+xyxyyxxy+yxyxyxxy-xyxyxyxy+yyxxxyxy+xxyyyxyx-yxyxyxyx-yyxxxyyx+yxyxxyyx+xxyyxyxy-xxyyyxxy

[4, 10], xyxxxyyy-xyxxyxyy-xyyxxyyx+xyyxyxyx-yxyyxyxx+yxxxyxyy+yxyyyxxx+xyxyyxxy+yxxyxyxy-yxxyyxxy+xyyyxyxx-xyxyxyxy-xyyyyxxx-yxyxyxyx+yxyxxyyx-yxxxxyyy
[4, 10], xyxxxyyy-xyxxyxyy-xyyxxyyx+xyyxyxyx-yxyyxyxx+yxxxyxyy+yxyyyxxx+xyxyyxxy+yxxyxyxy-yxxyyxxy+xyyyxyxx-xyxyxyxy-xyyyyxxx-yxyxyxyx+yxyxxyyx-yxxxxyyy

[4, 11], yxxxyyxy+xyxxyxyy-xyyxyxyx+yxyyxyxx-yxyxyyxx+yxxyxxyy-yxxxyxyy+xyyyxxyx+xyyxyyxx-xyxyxxyy-yxxyxyxy-xyyyxyxx-yxyyxxyx+xyxyxyxy+yxyxyxyx-xyxxyyxy
[4, 11], yxxxyyxy+xyxxyxyy-xyyxyxyx+yxyyxyxx-yxyxyyxx+yxxyxxyy-yxxxyxyy+xyyyxxyx+xyyxyyxx-xyxyxxyy-yxxyxyxy-xyyyxyxx-yxyyxxyx+xyxyxyxy+yxyxyxyx-xyxxyyxy

[4, 12], -yxxxyyxy+xyxyxyyx+xyyxyxyx+xyyyxxxy-xyyxyxxy-xyyyxxyx-yxxyxyyx+yxyxyxxy+yxxyxyxy-yxyyxxxy+yxyyxxyx-xyxyxyxy+yxxxyyyx-yxyxyxyx-xyxxyyyx+xyxxyyxy
[4, 12], -yxxxyyxy+xyxyxyyx+xyyxyxyx+xyyyxxxy-xyyxyxxy-xyyyxxyx-yxxyxyyx+yxyxyxxy+yxxyxyxy-yxyyxxxy+yxyyxxyx-xyxyxyxy+yxxxyyyx-yxyxyxyx-xyxxyyyx+xyxxyyxy

[4, 13], xyyxyxyx-yxyxxyxy+yxyxyyxx-yxxyxxyy+yxxyyxyx-xyyxyyxx+xyxyxxyy-xyxyyxyx-xyyxxxyy+yxyxxxyy+yxxyxyxy-xyxyxyxy-yxxyyyxx-yxyxyxyx+xyxyyyxx+xyyxxyxy
[4, 13], xyyxyxyx-yxyxxyxy+yxyxyyxx-yxxyxxyy+yxxyyxyx-xyyxyyxx+xyxyxxyy-xyxyyxyx-xyyxxxyy+yxyxxxyy+yxxyxyxy-xyxyxyxy-yxxyyyxx-yxyxyxyx+xyxyyyxx+xyyxxyxy

[4, 14], xyyxxyyx-xyxyxyyx-xyyxyxyx+yxyxxyxy-yxxyyxyx+xyyxyxxy+xyxyyxyx+yxxyxyyx-xyxyyxxy-yxyxyxxy-yxxyxyxy+yxxyyxxy+xyxyxyxy+yxyxyxyx-yxyxxyyx-xyyxxyxy
[4, 14], xyyxxyyx-xyxyxyyx-xyyxyxyx+yxyxxyxy-yxxyyxyx+xyyxyxxy+xyxyyxyx+yxxyxyyx-xyxyyxxy-yxyxyxxy-yxxyxyxy+yxxyyxxy+xyxyxyxy+yxyxyxyx-yxyxxyyx-xyyxxyxy

It is interesting that Maple can confirm that the invariants are actually invariants.

>    TestInvariant := proc(X)
local a, b, c, d, g, h, x, y, Y, algsub;
algsub:= (x,y) -> algsubs(y,x);
g:=create([1,-1],array([[a,b],[c,d]]));
h:=create([-1,1],array([[1,0],[0,1]]));
Y:=change_basis(X,g,h);
Y:=act(algsub,Y,a*d-b*c=1);
evalb(expand_tensor(lin_com(1,X,-1,Y))=0)
end:

For example,

>    TestInvariant(omega);

true

>    TestInvariant(om(3));

true

>    TestInvariant(x);

false

However, these procedures work good only for rather small tensor powers. To work with larger powers, we have to introduce a new representation of tensors in Maple, ignoring non-zero entries. Start with redefining the basis elements of V .

>    X := table([x=1]):

>    Y := table([y=1]):

Now, define a tensor product:

>    `&*` := proc(A::table,B::table)
local i, j, C;
for i to nops([indices(A)]) do
   for j to nops([indices(B)]) do
      C[cat(op(indices(A)[i]),op(indices(B)[j]))] :=          op(entries(A)[i])*op(entries(B)[j])
   od
od;
eval(C)
end:

Here is a new version of a linear combination of tensors:

>    lin_comb := proc()
local A, C, S, i, j;
C := table();
S := `union`(seq({indices(args[i+i])},i=1..nargs/2));
for j to nops(S) do
   A := add( `if`( member(S[j], {indices(args[i+i])}),
      args[i+i][op(S[j])] * args[i+i-1], 0),
   i=1..nargs/2);
   if A<>0 then C[op(S[j])] := A end if
od;
eval(C)
end:

For example,

>    Omega:=lin_comb(1,X&*Y,-1,Y&*X);

Omega := TABLE([yx = -1, xy = 1])

Here is the procedure for the n -fold tensor product of it:  

>    Om := proc(n)
option remember;
local i;
Om(n-1) &* Omega end:

>    Om(0) := table([``=1]):

For example,

>    Om(3);

TABLE([xyxyyx = -1, xyxyxy = 1, xyyxxy = -1, yxxyyx = 1, yxyxyx = -1, yxyxxy = 1, xyyxyx = 1, yxxyxy = -1])

Again, we can write it down as a polynomial, using the following procedure,

>    ExpandTensor := a-> sum(evaln(op(entries(a)['i']))*evaln(op(indices(a)['i'])),'i'=1..nops([entries(a)])):

For example,

>    ExpandTensor(Om(2));

xyxy+yxyx-yxxy-xyyx

General tensor invariants

The dimension of the space of SL(2)- invariants in the tensor product of a few irreducible representations of SL (2) can be determined using following command:

>    DimGenInvSL2 := proc()
local p, t, i, j;
p:=(1-t^2)*mul(add(t^(args[i]-2*j),j=0..args[i]),i=1..nargs);
coeff( p, t, 0)
end:

For example,

>    DimGenInvSL2(2,2,2);

1

Certainly, it can be used for determining the dimensions of n -fold tensor powers of the standard representation of SL (2) as well:

>    DimGenInvSL2(1$50);

4861946401452

which is equal to

>    DimInvSL2(50);

4861946401452

We can use a speadsheet, as before,

>    d2 := CreateSpreadsheet():
for n to 10
   do SetCellFormula(d2,n,2,evaln(DimGenInvSL2(cat(~A,n)))) od;
SetSelection(d2,1$4):

1, 2, 3 1
7, 8, 9, 12 7
7, 7, 7, 7 8
5, 5, 5, 5, 5, 5 111
31, 26, 19, 24 20
60, 70, 80, 90, 100 3601
6, 7, 8, 9, 10 46
1, 1, 1, 1, 1, 1 5
100, 100 1
7, 26, 37, 7, 7, 7, 7 1470

Entering a few integers in column A  will produce the corresponding dimension in column B .

>    with(Maplets[Elements]):

>    m_d2 := Maplet(
Window( 'title'="Dimensions of Invariants", [
    ["    Enter the indices:       ",
       TextField['TF1'](26, onchange=Evaluate('TB1' = evaln(DimGenInvSL2(TF1))))],
    ["Here is the dimension:   ",
       TextBox['TB1']('editable' = 'false',3..40 )],
    [Button("Evaluate the dimension", Evaluate('TB1' = evaln(DimGenInvSL2(TF1)))),
       Button("Close", Shutdown(['TF1', 'TB1'])),
       Button("Clear", SetOption('TF1' = ""))]
] ) ):
Maplets[Display]( m_d2 ):

Here is how it looks:

[Maple Bitmap]

An interesting thing is that we can use this procedure, the spreadsheet, and the maplet for the decomposition of the tensor products of irreducible representation of SL (2) as well. For instance, the picture above says that the coefficient at rho[7]  in the decomposition of the tensor product of rho[1], rho[2], rho[3], rho[4], rho[5], rho[6]  is 100.

The following formula, the spreadsheet, and the maplet give all the multiplicities at once as the coefficients of a polynomial.  

>    MultGenPolSL2 := proc()
local p, s, i, t, j;
t:=args[-1];
s:=add(args[i],i=1..nargs-1);
p:=expand((t^(s+2)-t^s)*mul(add(t^(args[i]-2*j),j=0..args[i]),i=1..nargs-1));
quo(p,t^(s+2),t);
end:

For example,

>    MultGenPolSL2(1,2,3,4,5,6,7,t);

t^28+6*t^26+20*t^24+49*t^22+98*t^20+169*t^18+259*t^16+359*t^14+454*t^12+525*t^10+553*t^8+524*t^6+433*t^4+286*t^2+100
t^28+6*t^26+20*t^24+49*t^22+98*t^20+169*t^18+259*t^16+359*t^14+454*t^12+525*t^10+553*t^8+524*t^6+433*t^4+286*t^2+100

The following formula gives the dimension of the representation presented by such a polynomial:

>    dSL2 := (p,t)->subs(t=1,diff(t*p,t)):

We can use this command to check the dimension of the representation above,

>    dSL2(%%,t);

40320

which equals to

>    8!;

40320

The spreadsheet can be defined as

>    c2 := CreateSpreadsheet():
for n to 10 do SetCellFormula(c2,n,2,evaln(MultGenPolSL2(cat(~A,n),q))) od;
SetSelection(c2,1$4):

1, 1 q^2+1
1, 2, 3 q^6+2*q^4+2*q^2+1
5, 6, 7 q^18+2*q^16+3*q^14+4*q^12+5*q^10+6*q^8+6*q^6+5*q^4+3*q^2+1
q^18+2*q^16+3*q^14+4*q^12+5*q^10+6*q^8+6*q^6+5*q^4+3*q^2+1
12, 14, 16, 18 13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
13+117*q^32+135*q^12+84*q^6+38*q^2+62*q^4+121*q^10+104*q^8+146*q^14+161*q^20+154*q^16+104*q^34+91*q^36+78*q^38+160*q^22+156*q^24+149*q^26+140*q^28+129*q^30+159*q^18+q^60+66*q^40+55*q^42+45*q^44+36*q^46...
5, 5, 5, 5, 5, 5 q^30+5*q^28+15*q^26+35*q^24+70*q^22+126*q^20+204*q^18+300*q^16+405*q^14+505*q^12+581*q^10+609*q^8+575*q^6+475*q^4+315*q^2+111
q^30+5*q^28+15*q^26+35*q^24+70*q^22+126*q^20+204*q^18+300*q^16+405*q^14+505*q^12+581*q^10+609*q^8+575*q^6+475*q^4+315*q^2+111
q^30+5*q^28+15*q^26+35*q^24+70*q^22+126*q^20+204*q^18+300*q^16+405*q^14+505*q^12+581*q^10+609*q^8+575*q^6+475*q^4+315*q^2+111
q^30+5*q^28+15*q^26+35*q^24+70*q^22+126*q^20+204*q^18+300*q^16+405*q^14+505*q^12+581*q^10+609*q^8+575*q^6+475*q^4+315*q^2+111
3, 3, 3, 3 q^12+3*q^10+6*q^8+10*q^6+11*q^4+9*q^2+4
q^12+3*q^10+6*q^8+10*q^6+11*q^4+9*q^2+4
10, 10 q^20+q^18+q^16+q^14+q^12+q^10+q^8+q^6+q^4+q^2+1
q^20+q^18+q^16+q^14+q^12+q^10+q^8+q^6+q^4+q^2+1
4, 4, 4, 4, 4 q^20+4*q^18+10*q^16+20*q^14+35*q^12+51*q^10+64*q^8+70*q^6+65*q^4+45*q^2+16
q^20+4*q^18+10*q^16+20*q^14+35*q^12+51*q^10+64*q^8+70*q^6+65*q^4+45*q^2+16
q^20+4*q^18+10*q^16+20*q^14+35*q^12+51*q^10+64*q^8+70*q^6+65*q^4+45*q^2+16
2, 2, 2, 2, 2, 2 q^12+5*q^10+15*q^8+29*q^6+40*q^4+36*q^2+15
q^12+5*q^10+15*q^8+29*q^6+40*q^4+36*q^2+15
6, 8, 8, 12 q^34+3*q^32+6*q^30+10*q^28+15*q^26+21*q^24+28*q^22+35*q^20+42*q^18+47*q^16+50*q^14+51*q^12+50*q^10+46*q^8+39*q^6+29*q^4+18*q^2+6
q^34+3*q^32+6*q^30+10*q^28+15*q^26+21*q^24+28*q^22+35*q^20+42*q^18+47*q^16+50*q^14+51*q^12+50*q^10+46*q^8+39*q^6+29*q^4+18*q^2+6
q^34+3*q^32+6*q^30+10*q^28+15*q^26+21*q^24+28*q^22+35*q^20+42*q^18+47*q^16+50*q^14+51*q^12+50*q^10+46*q^8+39*q^6+29*q^4+18*q^2+6