Maple Programs for Binary Tensor Invariants and Outerplanar Graphs

Maple Programs for Binary Tensor Invariants and Outerplanar Graphs

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);

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))));

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):

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:

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);

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):

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:

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

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);

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(%%);

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):

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:

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);

>    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:

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);

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;

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;

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;

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

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

For n = 10 we will use a loop:

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

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);

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

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

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

+ ... + .

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]]);

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)))]);

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

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:

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:

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

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):

$`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`$

$`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]);

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;

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

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

For n = 10 we will use a loop:

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

Here are a few other examples:

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

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

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:

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:

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

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):

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]);

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]);

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]);

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

For example,

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

Similarly,

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

Example:

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

> OPG2Hei := hei@OPG2BLW:

For example,

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

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

Example:

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

To hold the naming convention, we can add

> BLW2Hei := hei:

For example,

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

Finally,

> Hei := hei@BLW:

Example:

> Hei( 50, 3000000000000 );

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));

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, 2, 2, 1] ="

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

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

  CHARACTER :

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]);

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);

> expand_tensor(om(2));

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]]));

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;

>

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);

> TestInvariant(om(3));

> TestInvariant(x);

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);

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);

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));

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);

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);

which is equal to

> DimInvSL2(50);

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):

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:

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 in the decomposition of the tensor product of 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);

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);

which equals to

> 8!;

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):

A maplet can be created similarly. For some technical reason, we have to modify our procedure excluding an indeterminant from it:

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

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

However, for large tensor powers, the results need to be sorted. See, for instance, the results for indices 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12:

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

> MatGenSL2 := proc()
local p, i;
p:=MSL2(args);
[seq([i,coeff(p,t,i)],i=0..degree(p,t))]
end:

For example,

> MatGenSL2(1,2,3);

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

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

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

>

Enumeration of General Tensor Invariants

The formula for the dimension of the space of SL(2)- invariants in the tensor product of a few irreducible representations of SL (2) with indices , ..., gives us the formula for the number of outerplanar graphs with vertices of degrees , ..., . We allow for an outerplanar graph to have multiple edges, but don't allow loops. For example, the number of the outerplanar graphs with vertices of degrees 5, 7, 11, 15 is

> DimGenInvSL2(5, 7, 11, 15);

Writing x at the left vertix of every arc and y at the right vertex of every arc, and multiplying those x 's and y 's we obtain a sequence of monomials of degrees , ..., . We will call them generalized balanced lattice words. We use terms "balanced lattice words" because writing every monomial in the form and multiplying them, we obtain a usual balanced lattice word in the alphabet { x , y }. Inversely, every balanced lattice word, considered as a sentence of words of

lengths , ..., , so that every word in it has form y...yx...x , produces a generalized balance lattice word after multiplying the letters in every word. The following recursive procedure determines the k -th generalized balanced lattice word of length n in the lexicographical order. The procedure outputs a list of length s with pairs [ l, m ] of degrees of the monomials on every place.

>    GBLW := proc(n,k)
option remember;
local a, b, c, i, j, num, numo, nb, nbo, ne, neo, e1, e1o, e2, e2o, e3, e4, z;
nb := remove(x->evalb(x=0),n);
if nops(nb)=0 then
   return [[0,0]$nops(n)]
end if;
e4 := evalb(nops(n)=nops(nb));
nb[1] := nb[1]-1;
e3 := evalb(nb[1]=0);
if e3 then
   nb:=nb[2..-1]
end if;
nb[-1] := nb[-1]-1;
e1:= evalb(nb[-1]=0);
if e1 then
   nb := nb[1..-2]
end if;
e2 :=true;
ne := [];
num := 0;
while k>num do
   numo :=num;
   num := num + DimGenInvSL2( op(nb) )*DimGenInvSL2( op(ne) );
   nbo := nb;
   neo := ne;
   e1o := e1;
   e2o := e2;
   if nb=[] then break else
      to 2 do
         nb[-1] := nb[-1]-1;
         if e2 then
            ne := [1, op(ne)] else
               ne[1]:=ne[1]+1
         end if;
         e2 := e1;
         e1 := evalb(nb[-1]=0);
         if e1 then
            nb := nb[1..-2]
         end if
      od
   end if
od;
a := GBLW(nbo, iquo(k-numo-1, DimGenInvSL2(op(neo)))+1);
b := GBLW(neo, irem(k-numo-1, DimGenInvSL2(op(neo)))+1);
if e3 then
   a := [[0,1], op(a)] else
      a[1] := a[1]+[0,1]
end if;
if e1o then
   a := [op(a), [1,0]] else
      a[-1] := a[-1]+[1,0]
end if;
c:=`if`(e2o,
   [op(a),op(b)],
   [op(a[1..-2]),a[-1]+b[1],op(b[2..-1])]);
if e4 then
   z := c else
      z := [[0,0]$nops(n)];
      j := 1;
      for i to nops(n) do
         if n[i]=0 then else
            z[i] := c[j];
            j := j+1
         end if
      od
end if;
z
end proc:

For example,

> GBLW([0,0,1,0,1,0,0,0,1,0,1,0,0,0],1);

Another example, the list of the generalized balanced lattice words for n = (5, 7, 11, 15):

> for k from 1 to DimGenInvSL2(5,7,11,15)
do GBLW([5,7,11,15],k) od;

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

>    GOPG := proc(n,k)
option remember;
local a, b, c, i, j, m, num, numo, nb, nbo, ne, neo, e1, e1o, e2, e2o, e3, e4, eps, numz;
nb := remove(x->evalb(x=0),n);
if nops(nb)=0 then
   return []
end if;
e4 := evalb(nops(n)=nops(nb));
if e4 then else
   m:=[0$nops(nb)]
end if;
nb[1] := nb[1]-1;
e3 := evalb(nb[1]=0);
if e3 then
   nb:=nb[2..-1]
end if;
nb[-1] := nb[-1]-1;
e1:= evalb(nb[-1]=0);
if e1 then
   nb := nb[1..-2]
end if;
e2 :=true;
ne := [];
num := 0;
while k>num do
   numo :=num;
   num := num + DimGenInvSL2( op(nb) )*DimGenInvSL2( op(ne) );
   nbo := nb;
   neo := ne;
   e1o := e1;
   e2o := e2;
   if nb=[] then break else
      to 2 do
         nb[-1] := nb[-1]-1;
         if e2 then
            ne := [1, op(ne)] else
               ne[1]:=ne[1]+1
         end if;
         e2 := e1;
         e1 := evalb(nb[-1]=0);
         if e1 then
            nb := nb[1..-2]
         end if
      od
   end if
od;
a := GOPG(nbo, iquo(k-numo-1, DimGenInvSL2(op(neo)))+1);
b := GOPG(neo, irem(k-numo-1, DimGenInvSL2(op(neo)))+1);
if e3 then
   a := map(x->[x[1]+1,x[2]+1], a);
   eps := nops(nbo)+1 else
      eps := nops(nbo)
end if;
if e1o then
   eps := eps+1
end if;
a := [[1,eps],op(a)];
if e2o then else
   eps := eps-1
end if;
b := map(x->[x[1]+eps,x[2]+eps], b);
c := [op(a),op(b)];
if e4 then else
   j := 1;
   numz := 0;
   for i to nops(n) do
      if n[i]=0 then
         numz:=numz+1 else
            m[j] := numz+j;
            j := j+1
      end if
   od;
c := map(x->[m[x[1]],m[x[2]]],c)
end if;
c
end proc:

For example,

> GOPG([0, 1, 0, 0, 1, 1, 1, 0],1);

Another example, the list of the lists of the non-intersecting arcs for n = (5, 7, 11, 15).

> for k to DimGenInvSL2(5,7,11,15)
do GOPG([5,7,11,15],k) od;

As we can see, many arcs are repeating. In cases like that, it is more convenient to list arcs as triples [ a, b, c ] where a and b are the beginning and the end of

an arc, and c is its multiplicity. The following procedure is doing that.

>    GOPG1 := proc(n,k)
option remember;
local a, b, i, j, no;
a := GOPG(n,k);
no := nops(a);
if no=0 then return []
end if;
b := [[op(a[1]),1]];
for i from 2 to no do
   if a[i,1]=b[-1,1] and a[i,2]=b[-1,2] then
      b[-1,3] := b[-1,3] + 1 else
         b:=[op(b),[op(a[i]),1]]
   end if
od;
b
end:

For example,

> for k to 5 do GOPG1([5,7,11,15],k) od;

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

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

For example,

> GridGOPG([5,7,11,15],1,2,3,1);

Another example,

> DimGenInvSL2(2$5);

> GridGOPG([2$5],1,2,3,1);

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

> DimGenInvSL2(5$16);

Thus, there are 2 "central" outerplanar graphs with 16 vertices of degrees 5:

> GridGOPG([5$16],1670963202/2,1,2,2);

They don't look as symmetric as the similar example for outerplanar graphs with 24 vertices of degree1.

The following procedure determines the number of the outerplanar graph from the list of its arcs including multiplicities:

>    NumGOPG1 := proc(a)
option remember;
local aind, a1, ab, b, c, e1, e2, e3, i, m, nb, ne, num, s, x,y;
if nops(a)=0 then
   return 1
end if;
aind := [op(sort(map(x->op(x),{entries(array(map(y->y[1..2],a)))})))];
s := nops(aind);
ab:=table([seq(aind[i]=i,i=1..s)]);
nb := [0$s];
for i to nops(a) do
   nb[ab[a[i,1]]] := nb[ab[a[i,1]]] + a[i,3];
   nb[ab[a[i,2]]] := nb[ab[a[i,2]]] + a[i,3];
od;
c:=select(x->evalb(x[1]=a[1,2]),a);
m:=(add(nb[i], i=ab[a[1,2]]+1..s)+add(c[j,3],j=1..nops(c)))/2;
nb[1] := nb[1]-1;
e3 := evalb(nb[1]=0);
if e3 then
   nb:=nb[2..-1]
end if;
nb[-1] := nb[-1]-1;
e1:= evalb(nb[-1]=0);
if e1 then
   nb := nb[1..-2]
end if;
e2 :=true;
ne := [];
num := 0;
to m do
   num := num + DimGenInvSL2( op(nb) )*DimGenInvSL2( op(ne) );
   if nb=[] then break else
      to 2 do
         nb[-1] := nb[-1]-1;
         if e2 then
            ne := [1, op(ne)] else
               ne[1]:=ne[1]+1
         end if;
         e2 := e1;
         e1 := evalb(nb[-1]=0);
         if e1 then
            nb := nb[1..-2]
         end if
      od
   end if
od;
num := num + (NumGOPG1(select(x->evalb(x[1]<a[1,2]),a)[2..-1])-1)*DimGenInvSL2( op(ne) ) +
   NumGOPG1(select(x->evalb(x[1]>=a[1,2]),a));
end proc:
NumGOPG1([]) := 1:

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

> GOPG1([5$16],1670963202/2);
GOPG1([5$16],1670963202/2+1);

> 2*NumGOPG1(%%);
2*(NumGOPG1(%%)-1);

Correct answers. Now,

> NumGOPG1([op(GOPG1([5$8],1)),
op(map(x->[x[1]+8,x[2]+8,x[3]],GOPG1([5$8],1)))]);

> GridGOPG([5$16], 1425439054, 1, 1, 1);

Now, we can convert our procedures into maplets.

>    m_a2 := Maplet(
Window('title'="Outerplanar graphs",[
   ["        Enter the indices: ",
       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' = 'GridGOPG(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_a2 ):

The applet looks as follows:

Also, both GOPG1 and GBLW procedures can be converted into a maplet.

> with(Maplets[Elements]):

>    m_f2 := Maplet(
Window( 'title'="Arcs and Words", [
    ["        Enter the indices:    ",
        TextField['TF1'](26,onchange = Action(Evaluate(
            'TB1' = evaln(GOPG1(TF1,TF2))),
            Evaluate('TB2' = evaln(GBLW(TF1,TF2)))))],
    ["       Enter the number:    ",
        TextField['TF2'](26,onchange=Action(Evaluate(
            'TB1' = evaln(GOPG1(TF1,TF2))),
            Evaluate('TB2' = evaln(GBLW(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(GOPG1(TF1,TF2))),
            Evaluate('TB2' = evaln(GBLW(TF1,TF2))))),
        Button("Close", Shutdown(['TF1', 'TF2', 'TB1', 'TB2'])),
        Button("Clear", Action(SetOption('TF1' = ""),
            SetOption('TF2' = ""),
            SetOption('TB1' = ""),
            SetOption('TB2' = "")))]
] ) ):
Maplets[Display]( m_f2 ):

Here is how it looks:

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

Sometimes it is more convenient to use spreadsheets:

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

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

Sometimes it is useful to have procedures converting from the list of arcs to the generalized balanced lattice words and backwards. Here they are:

>    GOPG12GBLW := proc(a)
local aind, i, nb, s, x, y;
aind := [op(sort(map(x->op(x),{entries(array(map(y->y[1..2],a)))})))];
s := max(op(aind));
nb :=[[0,0]$s];
for i to nops(a) do
   nb[a[i,1],2] := nb[a[i,1],2] + a[i,3];
   nb[a[i,2],1] := nb[a[i,2],1] + a[i,3];
od;
nb
end:

For example,

> GOPG12GBLW([[1, 8, 2], [1, 3, 1], [1, 2, 20], [2, 3, 4], [3, 8, 16], [3, 7, 3], [3, 4, 1], [4, 7, 3], [4, 6, 6], [4, 5, 16], [5, 6, 11], [6, 7, 11], [7, 8, 12]]);

>    GBLW2GOPG := proc(a)
local blw, i, j, nb, num, opg;
nb := [seq(a[i,1]+a[i,2],i=1..nops(a))];
blw := [seq(op([-1$a[i,1],1$a[i,2]]),i=1..nops(a))];
opg := BLW2OPG(blw);
num := 0;
blw := array(blw);
for i from 1 to nops(a) do
   for j from num+1 to num+nb[i] do
      blw[j] := i;
   od;
num := num+nb[i]
od;
map(x->[blw[x[1]],blw[x[2]]],opg)
end:

For example,

> GBLW2GOPG([[0, 23], [20, 4], [5, 20], [1, 25], [16, 11], [17, 11], [17, 12], [30, 0]]);

Certainly, we can convert generalized balanced lattice words to the GOPG1 representation of arcs:

>    GBLW2GOPG1 := proc(c)
local a, b, i, j, no;
a := GBLW2GOPG(c);
no := nops(a);
if no=0 then return []
end if;
b := [[op(a[1]),1]];
for i from 2 to no do
   if a[i,1]=b[-1,1] and a[i,2]=b[-1,2] then
      b[-1,3] := b[-1,3] + 1 else
         b:=[op(b),[op(a[i]),1]]
   end if
od;
b
end:

For example,

> GBLW2GOPG1([[0, 23], [20, 4], [5, 20], [1, 25], [16, 11], [17, 11], [17, 12], [30, 0]]);

Now we can define the procedure NumGBLW as a composition of GBLW2OPG1 and NumGOPG1 :

> NumGBLW := NumGOPG1 @ GBLW2GOPG1:

For example,

> NumGBLW([[0, 23], [20, 4], [5, 20], [1, 25], [16, 11], [17, 11], [17, 12], [30, 0]]);









		$`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`$
		$`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`$