Add ListWreathProductElement and WreathProductElementList

doc/ref/grpprod.xml

@@ -118,6 +118,8 @@ has to be taken.)
 <#Include Label="WreathProductImprimitiveAction">
 <#Include Label="WreathProductProductAction">
 <#Include Label="KuKGenerators">
+<#Include Label="ListWreathProductElement">
+<#Include Label="WreathProductElementList">
 
 </Section>
 

lib/gprd.gd

@@ -566,3 +566,66 @@ InstallTrueMethod(IsGeneratorsOfMagmaWithInverses,
 
 DeclareRepresentation("IsWreathProductElementDefaultRep",
   IsWreathProductElement and IsPositionalObjectRep,[]);
+
+#############################################################################
+##
+#F  ListWreathProductElement
+#O  ListWreathProductElementNC
+##
+##  <#GAPDoc Label="ListWreathProductElement">
+##  <ManSection>
+##  <Func Name="ListWreathProductElement" Arg='G, x[, testDecomposition]'/>
+##  <Oper Name="ListWreathProductElementNC" Arg='G, x, testDecomposition'/>
+##
+##  <Description>
+##  Let <A>x</A> be an element of a wreath product <A>G</A>
+##  where <M>G = K \wr H</M> and <M>H</M> acts
+##  as a finite permutation group of degree <M>m</M>.
+##  We can identify the element <A>x</A> with a tuple <M>(f_1, \ldots, f_m; h)</M>,
+##  where <M>f_i \in K</M> is the <M>i</M>-th base component of <A>x</A>
+##  and <M>h \in H</M> is the top component of <A>x</A>.
+##  <P/>
+##  <Ref Func="ListWreathProductElement"/> returns a list <M>[f_1, \ldots, f_m, h]</M>
+##  containing the components of <A>x</A> or <K>fail</K> if <A>x</A> cannot be decomposed in the wreath product.
+##  <P/>
+##  If ommited, the argument <A>testDecomposition</A> defaults to true.
+##  If <A>testDecomposition</A> is true, <Ref Func="ListWreathProductElement"/> makes additional tests to ensure
+##  that the computed decomposition of <A>x</A> is correct,
+##  i.e. it checks that <A>x</A> is an element of the parent wreath product of <A>G</A>:
+##  <P/>
+##  If <M>K \leq \mathop{Sym}(l)</M>, this ensures that <M>x \in \mathop{Sym}(l) \wr \mathop{Sym}(m)</M>
+##  where the parent wreath product is considered in the same action as <A>G</A>,
+##  i.e. either in imprimitive action or product action.
+##  <P/>
+##  If <M>K \leq \mathop{GL}(n,q)</M>, this ensures that <M>x \in \mathop{GL}(n,q) \wr \mathop{Sym}(m)</M>.
+##  </Description>
+##  </ManSection>
+##  <#/GAPDoc>
+##
+DeclareGlobalFunction( "ListWreathProductElement" );
+DeclareOperation( "ListWreathProductElementNC", [HasWreathProductInfo, IsObject, IsBool] );
+
+#############################################################################
+##
+#F  WreathProductElementList
+#O  WreathProductElementListNC
+##
+##  <#GAPDoc Label="WreathProductElementList">
+##  <ManSection>
+##  <Func Name="WreathProductElementList" Arg='G, list'/>
+##  <Oper Name="WreathProductElementListNC" Arg='G, list'/>
+##
+##  <Description>
+##  Let <A>list</A> be equal to <M>[f_1, \ldots, f_m, h]</M> and <A>G</A> be a wreath product
+##  where <M>G = K \wr H</M>, <M>H</M> acts
+##  as a finite permutation group of degree <M>m</M>,
+##  <M>f_i \in K</M> and <M>h \in H</M>.
+##  <P/>
+##  <Ref Func="WreathProductElementList"/> returns the element <M>x \in G</M>
+##  identified by the tuple <M>(f_1, \ldots, f_m; h)</M>.
+##  </Description>
+##  </ManSection>
+##  <#/GAPDoc>
+##
+DeclareGlobalFunction( "WreathProductElementList" );
+DeclareOperation( "WreathProductElementListNC", [HasWreathProductInfo, IsList] );

lib/gprd.gi

@@ -896,6 +896,73 @@ local I,n,fam,typ,gens,hgens,id,i,e,info,W,p,dom;
 
 end);
 
+#############################################################################
+##
+#M  ListWreathProductElement(<G>, <x>[, <testMembership>])
+##
+InstallGlobalFunction( ListWreathProductElement,
+function(G, x, testDecomposition...)
+  local info;
+  if Length(testDecomposition) = 0 then
+    testDecomposition := true;
+  elif Length(testDecomposition) = 1 then
+    testDecomposition := testDecomposition[1];
+  elif Length(testDecomposition) > 1 then
+    ErrorNoReturn("too many arguments");
+  fi;
+  if not HasWreathProductInfo(G) then
+    ErrorNoReturn("usage: <G> must be a wreath product");
+  fi;
+  return ListWreathProductElementNC(G, x, testDecomposition);
+end);
+
+InstallMethod( ListWreathProductElementNC, "generic wreath product", true,
+ [ HasWreathProductInfo, IsWreathProductElement, IsBool ], 0,
+function(G, x, testDecomposition)
+  local info, list, i;
+  info := WreathProductInfo(G);
+  list := EmptyPlist(info!.degI + 1);
+  for i in [1 .. info!.degI + 1] do
+    list[i] := StructuralCopy(x![i]);
+  od;
+  return list;
+end);
+
+#############################################################################
+##
+#M  WreathProductElementList(<G>, <list>)
+##
+InstallGlobalFunction( WreathProductElementList,
+function(G, list)
+  local info, i;
+
+  if not HasWreathProductInfo(G) then
+    ErrorNoReturn("usage: <G> must be a wreath product");
+  fi;
+  info := WreathProductInfo(G);
+  if Length(list) <> info.degI + 1 then
+    ErrorNoReturn("usage: <list> must have ",
+                  "length 1 + <WreathProductInfo(G).degI>");
+  fi;
+  for i in [1 .. info.degI] do
+    if not list[i] in info.groups[1] then
+      ErrorNoReturn("usage: <list{[1 .. Length(list) - 1]}> must contain ",
+                    "elements of <WreathProductInfo(G).groups[1]>");
+    fi;
+  od;
+  if not list[info.degI + 1] in info.groups[2] then
+    ErrorNoReturn("usage: <list[Length(list)]> must be ",
+                  "an element of <WreathProductInfo(G).groups[2]>");
+  fi;
+  return WreathProductElementListNC(G, list);
+end);
+
+InstallMethod( WreathProductElementListNC, "generic wreath product", true,
+ [ HasWreathProductInfo, IsList ], 0,
+function(G, list)
+  return Objectify(FamilyObj(One(G))!.defaultType, StructuralCopy(list));
+end);
+
 #############################################################################
 ##
 #M  PrintObj(<x>)

lib/gprdmat.gi

@@ -406,14 +406,97 @@ end );
 InstallOtherMethod( Projection,"matrix wreath product", true,
   [ IsMatrixGroup and HasWreathProductInfo ],0,
 function( W )
-local  info,proj,H;
+local  info, degI, dimA, zero, projFunc;
   info := WreathProductInfo( W );
   if IsBound( info.projection ) then return info.projection; fi;
 
-  proj:=Error("TODO");
+  degI := info.degI;
+  dimA := info.dimA;
+  zero := Zero(info.field);
+
+  projFunc := function(x)
+    local topImages, k, l, a;
+    topImages := [];
+    for k in [1 .. degI] do
+      for l in [1 .. degI] do
+        for a in [1 .. dimA] do
+          if x[dimA * (k - 1) + a, dimA * (l - 1) + a] <> zero then
+            Add(topImages, l);
+            break;
+          fi;
+        od;
+        if Length(topImages) = k then
+          break;
+        fi;
+      od;
+      if Length(topImages) <> k then
+        return fail;
+      fi;
+    od;
+    return PermList(topImages);
+  end;
+
+  info.projection := GroupHomomorphismByFunction(W, info.groups[2], projFunc);
+  return info.projection;
+end);
+
+#############################################################################
+##
+#M  ListWreathProductElementNC( <G>, <x> )
+##
+InstallMethod( ListWreathProductElementNC, "matrix wreath product", true,
+ [ IsMatrixGroup and HasWreathProductInfo, IsObject, IsBool], 0,
+function(G, x, testDecomposition)
+  local info, degI, dimA, h, list, i, j, k, zeroMat;
+
+  info := WreathProductInfo(G);
+  degI := info.degI;
+  dimA := info.dimA;
+
+  # The top group element
+  h := x ^ Projection(G);
+  if h = fail then
+    return fail;
+  fi;
+  list := EmptyPlist(degI + 1);
+  list[degI + 1] := h;
+  if testDecomposition then
+    # ZeroMatrix does not accept IsPlistRep
+    if IsPlistRep(x) then
+      zeroMat := NullMat(dimA, dimA, info.field);
+    else
+      zeroMat := ZeroMatrix(dimA, dimA, x);
+    fi;
+  fi;
+  for i in [1 .. degI] do
+      j := i ^ h;
+      list[i] := ExtractSubMatrix(x, [dimA * (i - 1) + 1 .. dimA * i], [dimA * (j - 1) + 1 .. dimA * j]);
+      if testDecomposition then
+        for k in [1 .. degI] do
+          if k = j then
+            continue;
+          fi;
+          if ExtractSubMatrix(x, [dimA * (i - 1) + 1 .. dimA * i], [dimA * (k - 1) + 1 .. dimA * k]) <> zeroMat then
+            return fail;
+          fi;
+        od;
+      fi;
+  od;
+  return list;
+end);
+
+#############################################################################
+##
+#M  WreathProductElementListNC(<G>, <list>)
+##
+InstallMethod( WreathProductElementListNC, "matrix wreath product", true,
+ [ IsMatrixGroup and HasWreathProductInfo, IsList ], 0,
+function(G, list)
+  local info;
 
-  info.projection:=proj;
-  return proj;
+  info := WreathProductInfo(G);
+  # TODO: Remove `MatrixByBlockMatrix` when `BlockMatrix` supports the MatObj interface.
+  return MatrixByBlockMatrix(BlockMatrix(List([1 .. info.degI], i -> [i, i ^ list[info.degI + 1], list[i]]), info.degI, info.degI));
 end);
 
 # tensor wreath -- dimension d^e This is not a faithful representation of

lib/gprdperm.gi

@@ -805,25 +805,133 @@ end );
 InstallOtherMethod( Projection,"perm wreath product", true,
   [ IsPermGroup and HasWreathProductInfo ],0,
 function( W )
-local  info,proj,H;
+local  info, proj, H, degI, degK, constPoints, projFunc;
   info := WreathProductInfo( W );
   if IsBound( info.projection ) then return info.projection; fi;
 
+  # Imprimitive Action, tuple (i, j) corresponds
+  # to point i + degK * (j - 1)
   if IsBound(info.permimpr) and info.permimpr=true then
     proj:=ActionHomomorphism(W,info.components,OnSets,"surjective");
+  # Primitive Action, tuple (t_1, ..., t_degI) corresponds
+  # to point Sum_{i=1}^degI t_i * degK ^ (i - 1)
   else
-    H:=info.groups[2];
-    proj:=List(info.basegens,i->One(H));
-    proj:=GroupHomomorphismByImagesNC(W,H,
-      Concatenation(info.basegens,info.hgens),
-      Concatenation(proj,GeneratorsOfGroup(H)));
+    degI := info.degI;
+    degK := NrMovedPoints(info.groups[1]);
+    # constPoints correspond to [1, 1, ...] and the one-vectors with a 2 in each position,
+    # i.e. [2, 1, 1, ...], [1, 2, 1, ...], [1, 1, 2, ...], ...
+    constPoints := Concatenation([0], List([0 .. degI - 1], i -> degK ^ i)) + 1;
+    projFunc := function(x)
+      local imageComponents, i, comp, topImages;
+      # Let x = (f_1, ..., f_m; h).
+      # imageComponents = [ [1 ^ f_1, 1 ^ f_2, 1 ^ f_3, ...] ^ (1, h)
+      #                     [2 ^ f_1, 1 ^ f_2, 1 ^ f_3, ...] ^ (1, h),
+      #                     [1 ^ f_1, 2 ^ f_2, 1 ^ f_3, ...] ^ (1, h), ... ]
+      # So we just need to check where the bit differs from the first point
+      # in order to compute the action of the top element h.
+      imageComponents := List(OnTuples(constPoints, x) - 1,
+                              p -> CoefficientsQadic(p, degK) + 1);
+      # The qadic expansion has no "trailing" zeros. Thus we need to append them.
+      # For example if (1, ..., 1) ^ (f_1, ..., f_m) = (1, ..., 1),
+      # we have imageComponents[1] = CoefficientsQadic(0, degK) + 1 = [].
+      # Note that we append 1's instead of 0's,
+      # since we already transformed the result of the qadic expansion
+      # from [{0, ..., degK - 1}, ...] to [{1, ..., degK}, ...].
+      for i in [1 .. degI + 1] do
+        comp := imageComponents[i];
+        Append(comp, ListWithIdenticalEntries(degI - Length(comp), 1));
+      od;
+      # For some reason, the action of the top component is in reverse order,
+      # i.e. [ p[m], ..., p[1] ] ^ (1, h) = [ p[m ^ (h ^ -1)], ..., p[1 ^ (h ^ -1)] ]
+      topImages := List([0 .. degI - 1], i -> PositionProperty([0 .. degI - 1],
+                        j -> imageComponents[1, degI - j] <>
+                             imageComponents[degI - i + 1, degI - j]));
+      return PermList(topImages);
+    end;
+    proj := GroupHomomorphismByFunction(W, info.groups[2], projFunc);
   fi;
   SetKernelOfMultiplicativeGeneralMapping(proj,info.base);
 
   info.projection:=proj;
   return proj;
 end);
 
+#############################################################################
+##
+#M  ListWreathProductElementNC( <G>, <x> )
+##
+InstallMethod( ListWreathProductElementNC, "perm wreath product", true,
+ [ IsPermGroup and HasWreathProductInfo, IsObject, IsBool ], 0,
+function(G, x, testDecomposition)
+  local info, list, h, f, degK, i, j, constPoints, imageComponents, comp, restPerm;
+
+  info := WreathProductInfo(G);
+  # The top group element
+  h := x ^ Projection(G);
+  if h = fail then
+    return fail;
+  fi;
+  # The product of the base group elements
+  f := x * Image(Embedding(G, info.degI + 1), h) ^ (-1);
+  list := EmptyPlist(info!.degI + 1);
+  list[info.degI + 1] := h;
+  # Imprimitive Action, tuple (i, j) corresponds
+  # to point i + degK * (j - 1)
+  if IsBound(info.permimpr) and info.permimpr then
+    for i in [1 .. info.degI] do
+        restPerm := RESTRICTED_PERM(f, info.components[i], testDecomposition);
+        if restPerm = fail then
+          return fail;
+        fi;
+        list[i] := restPerm ^ info.perms[i];
+    od;
+  # Primitive Action, tuple (t_1, ..., t_degI) corresponds
+  # to point Sum_{i=1}^degI t_i * degK ^ (i - 1)
+  elif IsBound(info.productType) and info.productType then
+    degK := NrMovedPoints(info.groups[1]);
+    # constPoints correspond to [1, 1, 1, ...], [2, 2, 2, ...], ...
+    constPoints := List([0 .. degK - 1], i -> Sum([0 .. info.degI - 1],
+                                                  j -> i * degK ^ j)) + 1;
+    # imageComponents = [ [1 ^ f_1, 1 ^ f_2, 1 ^ f_3, ...],
+    #                     [2 ^ f_1, 2 ^ f_2, 2 ^ f_3, ...], ... ]
+    imageComponents := List(OnTuples(constPoints, f) - 1,
+                            p -> CoefficientsQadic(p, degK) + 1);
+    # The qadic expansion has no "trailing" zeros. Thus we need to append them.
+    # For example if (1, ..., 1) ^ (f_1, ..., f_m) = (1, ..., 1),
+    # we have imageComponents[1] = CoefficientsQadic(0, degK) + 1 = [].
+    # Note that we append 1's instead of 0's,
+    # since we already transformed the result of the qadic expansion
+    # from [{0, ..., degK - 1}, ...] to [{1, ..., degK}, ...].
+    for i in [1 .. degK] do
+      comp := imageComponents[i];
+      Append(comp, ListWithIdenticalEntries(info.degI - Length(comp), 1));
+    od;
+    for j in [1 .. info.degI] do
+      list[j] := PermList(List([1 .. degK], i -> imageComponents[i,j]));
+      if list[j] = fail then
+        return fail;
+      fi;
+    od;
+  else
+    ErrorNoReturn("Error: cannot determine which action ",
+                  "was used for wreath product");
+  fi;
+  return list;
+end);
+
+#############################################################################
+##
+#M  WreathProductElementListNC(<G>, <list>)
+##
+InstallMethod( WreathProductElementListNC, "perm wreath product", true,
+ [ IsPermGroup and HasWreathProductInfo, IsList ], 0,
+function(G, list)
+  local info;
+
+  info := WreathProductInfo(G);
+  return Product(List([1 .. info.degI + 1], i -> list[i] ^ Embedding(G, i)));
+end);
+
 #############################################################################
 ##
 #F  WreathProductProductAction( <G>, <H> )   wreath product in product action