Action of Symmetric Group on Lie Polynomials with GAP

Question

Let $L$ be the free Lie Algebra, freely generated by $x_1,x_2, \ldots, x_n$. Let $f$ be a polynomial in $L$ and $\sigma \in S_n$, how to do $\sigma$ act on $f$ in GAP? That is $$\sigma f(x_1, \ldots, x_n)=f(x_{\sigma(1)},\ldots, x_{\sigma(n)}).$$

Answer 1

The data type for Lie algebra elements is a bit more complicated than that of polynomials, so OnIndeterminates will not work, but it would not be difficult to implement this. To show how it should work, first let's create a Lie algebra and its element:

gap> L:= FreeLieAlgebra( Rationals, "x", "y", "z" );
<Lie algebra over Rationals, with 3 generators>
gap> g:= GeneratorsOfAlgebra( L );; x:= g[1];; y:=g[2];; z:= g[3];;
gap> t:=z*(y*(x*(z*y)));
(-1)*((x*(y*z))*(y*z))+(-1)*((x*((y*z)*z))*y)+(-1)*(((x*z)*(y*z))*y)

Now the key is to get the external representation of object, modify it and then create a new object given by the new external representation. For our t, the external representation is a list of length two, the first entry is the zero of the ring of coefficients, and the 2nd entry describes monomials in an obvious way (odd positions describe Lie commutators and even positions contain coefficients):

gap> ExtRepOfObj(t);
[ 0, [ [ [ 1, [ 2, 3 ] ], [ 2, 3 ] ], -1, [ [ 1, [ [ 2, 3 ], 3 ] ], 2 ], -1, 
      [ [ [ 1, 3 ], [ 2, 3 ] ], 2 ], -1 ] ]

The inverse procedure is to create a Lie algebra element given by this presentation. It should belong to the same family as elements of L:

gap> fam:=ElementsFamily(FamilyObj(L));
NewFamily( "FreeLieAlgebraObjFamily", [ 880 ], [ 97, 100, 104, 108, 112, 116, 119, 122, 
  126, 130, 162, 168, 880 ] )
gap> u:=ObjByExtRep(fam,ExtRepOfObj(t));
(-1)*((x*(y*z))*(y*z))+(-1)*((x*((y*z)*z))*y)+(-1)*(((x*z)*(y*z))*y)
gap> t=u;
true

So we see that not only that u is displayed in the same way as t, but these two objects are also recognised as equal, since we did not modify the external representation for t.

Therefore, if one would like to implement the action from the question, the main task is to write a function which takes the external representation of object and permutes indices as needed. Note that there may be arbitrarily long nested lists in the external representation of Lie commutators:

gap> t:=(z*((y*(x*(z*y)*z)*y)));
(-1)*((x*((y*z)*z))*(y*(y*z)))+(-1)*(((x*z)*(y*z))*(y*(y*z)))+(
-2)*(((x*((y*z)*z))*(y*z))*y)+(-1)*(((x*(((y*z)*z)*z))*y)*y)+(
-2)*((((x*z)*(y*z))*(y*z))*y)+(-2)*((((x*z)*((y*z)*z))*y)*y)+(
-1)*(((((x*z)*z)*(y*z))*y)*y)
gap> ExtRepOfObj(t);                           
[ 0, 
  [ [ [ 1, [ [ 2, 3 ], 3 ] ], [ 2, [ 2, 3 ] ] ], -1, 
      [ [ [ 1, 3 ], [ 2, 3 ] ], [ 2, [ 2, 3 ] ] ], -1, 
      [ [ [ 1, [ [ 2, 3 ], 3 ] ], [ 2, 3 ] ], 2 ], -2, 
      [ [ [ 1, [ [ [ 2, 3 ], 3 ], 3 ] ], 2 ], 2 ], -1, 
      [ [ [ [ 1, 3 ], [ 2, 3 ] ], [ 2, 3 ] ], 2 ], -2, 
      [ [ [ [ 1, 3 ], [ [ 2, 3 ], 3 ] ], 2 ], 2 ], -2, 
      [ [ [ [ [ 1, 3 ], 3 ], [ 2, 3 ] ], 2 ], 2 ], -1 ] ]

so we may need to rewrite them recursively.

The following code (admittedly hacked together quickly) should do this. (I hope the call to normalization will do cancellations that might happen after the permutation).

OnIterList:=function(l,perm)
local m,i;
  m:=[];
  for i in l do
    if IsList(i) then
      Add(m,OnIterList(i,perm));
    else
      Add(m,i^perm);
    fi;
  od;
  return m;
end;

OnLiePol:=function(pol,perm)
local fam,e,f,i;
  e:=CoefficientsAndMagmaElements(pol);
  f:=[];    
  for i in [1,3..Length(e)-1] do
    Add(f,ObjByExtRep(FamilyObj(e[i]),OnIterList(ExtRepOfObj(e[i]),perm)));
    Add(f,e[i+1]);
  od;
  return NormalizedElementOfMagmaRingModuloRelations(FamilyObj(pol),[ZeroCoefficient(pol),f]);
end;

What I'm doing is basically to take the polynomial apart (I looked at the code for addition of lie polynomials to see how:

gap> me:=ApplicableMethod(\+,[p,p]);
gap> Print(me);

and am unravelling the objects, permuting and composing again.

For example, we have:

gap> t:=z*(y*(x*(z*y)));         
(-1)*((x*(y*z))*(y*z))+(-1)*((x*((y*z)*z))*y)+(-1)*(((x*z)*(y*z))*y)
gap> OnLiePol(t,(1,2));
(-1)*(x*((x*z)*(y*z)))+(-1)*(x*(((x*z)*z)*y))+(-1)*((x*z)*((x*z)*y))
gap> OnLiePol(t,(1,2,3));
(1)*(x*((x*z)*(y*z)))+(1)*(x*(((x*z)*z)*y))
gap> OnLiePol(t,(1,2)) = z*(x*(y*(z*x)));
true
gap> OnLiePol(t,(1,2,3)) = x*(z*(y*(x*z)));
true