Using the non-translation generators of the group $I 4_1/a m d$ [origin 1] (No. 141) provided here, I finally solved this problem in GAP, as shown below:

gap> SGGenElemITA141O1:=[
>  [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0,0,0,1]],
>  [[-1, 0, 0, 1/2], [0, -1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]],
>  [[0, -1, 0, 0], [1, 0, 0, 1/2], [0, 0, 1, 1/4], [0,0,0, 1]],
>  [[-1, 0, 0, 1/2], [0,  1, 0,  0], [0,  0,  -1, 3/4], [0,0,0, 1]],
>  [[-1, 0, 0, 0], [0, -1, 0, 1/2], [0, 0, -1, 1/4], [0,0,0, 1]],
>  [[1, 0, 0, 1/2], [0, 1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]]
> ];;
gap> SGITA141O1:=AffineCrystGroupOnLeft(SGGenElemITA141O1);
<matrix group with 6 generators>
gap> TNGenElemSGITA141O1:=GeneratorsOfGroup(TranslationNormalizer(SGITA141O1));
[ [ [ 1, 0, 0, 1/2 ], [ 0, 1, 0, 1/2 ], [ 0, 0, 1, 1/2 ], [ 0, 0, 0, 1 ] ], [ [ 1, 0, 0, 0 ], [ 0, 1, 0, 1 ], [ 0, 0, 1, 0 ], [ 0, 0, 0, 1 ] ], 
  [ [ 1, 0, 0, 0 ], [ 0, 1, 0, 0 ], [ 0, 0, 1, 1/2 ], [ 0, 0, 0, 1 ] ] ]
gap> List(TNGenElemSGITA141O1, x-> SGITA141O1^x=SGITA141O1);
[ true, true, true ]

# With the help of some custom Mathematica functions, obtain all possible translations in Mod 1 format:
# "TNGenElemSGITA141O1=[ [ [ 1, 0, 0, 1/2 ], [ 0, 1, 0, 1/2 ], [ 0, 0, 1, 1/2 ], [ 0, 0, 0, 1 ] ], [ [ 1, 0, 0, 0 ], [ 0, 1, 0, 1 ], [ 0, 0, 1, 0 ], [ 0, 0, 0, 1 ] ], 
#   [ [ 1, 0, 0, 0 ], [ 0, 1, 0, 0 ], [ 0, 0, 1, 1/2 ], [ 0, 0, 0, 1 ] ] ];;"//StringReplace[#,{"\n "->"","["->"{","]"->"}",":="->"=",";"->""}]&//ToExpression;
# AffCrystGroupOnLeft[%];
# #[[1;;3,4]]&/@Select[%, # != IdentityMatrix[4]&]//Matrix2GAP

gap> transTNSGITA141O1:=[[0, 0, 1/2],
> [1/2, 1/2, 0],
> [1/2, 1/2, 1/2]];
[ [ 0, 0, 1/2 ], [ 1/2, 1/2, 0 ], [ 1/2, 1/2, 1/2 ] ]
gap> for i in SGGenElemITA141O1 do
>   for j in TNGenElemSGITA141O1 do
>     c:= i^j - i;
>     l:=c{[1..3]}{[1..3]};
>     t:=List(c{[1..3]}[4],x->FractionModOne(x)); 
>     # Print(l," ",l = Zero(IdentityMat(3)),"\n");
>     # Print(t," ",t =[0,0,0] or t in transTNGenElemSGITA227O1,"\n"); 
>     Print(l = Zero(IdentityMat(3)) and (t =[0,0,0] or t in transTNSGITA141O1)," ");
>   od;
> od;
true true true true true true true true true true true true true true true true true true

All elements of the group TNSGITA141O1 generated by TNGenElemSGITA141O1 will do the trick. Here, I checked for confirmation using all possible translations in Mod 1 format, i.e., the elements of transTNSGITA141O1.

For related discussions, see here.

Hi Hans Dolhaine,

Thank you for your wonderful code snippet.

I would like to add some additional comments:

• You said the following:

  I must admit I do not understand at all your problem and what du want to achieve.

I mean C3 is a pure translation, aka, {1/2,1/2,1/2}, and it's also an invariant transformation of the corresponding space group discussed here, as shown by the following checking:

In[78]:= gensSG141ITA1={
 {{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0,0,0,1}},
 {{-1, 0, 0, 1/2}, {0, -1, 0, 1/2}, {0, 0, 1, 1/2}, {0,0,0, 1}},
 {{0, -1, 0, 0}, {1, 0, 0, 1/2}, {0, 0, 1, 1/4}, {0,0,0, 1}},
 {{-1, 0, 0, 1/2}, {0,  1, 0,  0}, {0,  0,  -1, 3/4}, {0,0,0, 1}},
 {{-1, 0, 0, 0}, {0, -1, 0, 1/2}, {0, 0, -1, 1/4}, {0,0,0, 1}},
 {{1, 0, 0, 1/2}, {0, 1, 0, 1/2}, {0, 0, 1, 1/2}, {0,0,0, 1}}
}; 

C3={{1, 0, 0, 1/2}, {0, 1, 0, 1/2}, {0, 0, 1, 1/2}, {0,0,0,1}};
Inverse[C3] . # . C3 -# &/@gensSG141ITA1;
AffineTransform[{#[[1;;3,1;;3]],#[[1;;3,4]]}//FractionalPart]&/@%;
TM=TransformationMatrix/@%

generalC3={{1, 0, 0, n1+ 1/2}, {0, 1, 0, n2+1/2}, {0, 0, 1, n3+1/2}, {0,0,0,1}};
Inverse[generalC3] . # . generalC3 -# &/@gensSG141ITA1;
AffineTransform[{#[[1;;3,1;;3]],#[[1;;3,4]]}//FractionalPart]&/@%//FullSimplify[#, Element[{n1, n2, n3}, Integers]]&;
TM==TransformationMatrix/@%

Out[82]= {{{0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 
   1}}, {{0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 1}}, {{0,
    0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 1}}, {{0, 0, 0, 
   0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 1}}, {{0, 0, 0, 0}, {0, 
   0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 1}}, {{0, 0, 0, 0}, {0, 0, 0, 
   0}, {0, 0, 0, 0}, {0, 0, 0, 1}}}

Out[86]= True

Also see the following GAP code snippet for further confirmation/verification of this fact:

gap> gensSG141ITA1:=[
>  [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0,0,0,1]],
>  [[-1, 0, 0, 1/2], [0, -1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]],
>  [[0, -1, 0, 0], [1, 0, 0, 1/2], [0, 0, 1, 1/4], [0,0,0, 1]],
>  [[-1, 0, 0, 1/2], [0,  1, 0,  0], [0,  0,  -1, 3/4], [0,0,0, 1]],
>  [[-1, 0, 0, 0], [0, -1, 0, 1/2], [0, 0, -1, 1/4], [0,0,0, 1]],
>  [[1, 0, 0, 1/2], [0, 1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]]
> ];;
gap> SG141ITA1:=AffineCrystGroupOnLeft(gensSG141ITA1);
<matrix group with 6 generators>
gap> C3:=[[1, 0, 0, 1/2], [0, 1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0,1]];
[ [ 1, 0, 0, 1/2 ], [ 0, 1, 0, 1/2 ], [ 0, 0, 1, 1/2 ], [ 0, 0, 0, 1 ] ]
gap> SG141ITA1^C3=SG141ITA1;
true
gap> AffineCrystGroupOnLeft(List(GeneratorsOfGroup(SG141ITA1),x-> C3^-1 * x * C3 ))=SG141ITA1;
true

And I just want to find such transformations.

• gensSG141ITA1 are the generators of space group I 41/a m d [origin 1] (No. 141), corresponding to the data given here.

The 3 * 3 sub-matrices resided in the up-left portion are the corresponding point group elements. For your information: the following results, given by GAP, are consistent with the results of the approach you used here:

    gap> gensSG141ITA1:=[
    >  [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0,0,0,1]],
    >  [[-1, 0, 0, 1/2], [0, -1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]],
    >  [[0, -1, 0, 0], [1, 0, 0, 1/2], [0, 0, 1, 1/4], [0,0,0, 1]],
    >  [[-1, 0, 0, 1/2], [0,  1, 0,  0], [0,  0,  -1, 3/4], [0,0,0, 1]],
    >  [[-1, 0, 0, 0], [0, -1, 0, 1/2], [0, 0, -1, 1/4], [0,0,0, 1]],
    >  [[1, 0, 0, 1/2], [0, 1, 0, 1/2], [0, 0, 1, 1/2], [0,0,0, 1]]
    > ];;
    gap> SG141ITA1:=AffineCrystGroupOnLeft(gensSG141ITA1);
    <matrix group with 6 generators>
    gap> PG141ITA1:=PointGroup(SG141ITA1);
    <matrix group of size 16 with 4 generators>
    gap> GeneratorsOfGroup(PG141ITA1);
    [ [ [ -1, 0, 0 ], [ 0, -1, 0 ], [ 0, 0, 1 ] ], [ [ 0, -1, 0 ], [ 1, 0, 0 ], [ 0, 0, 1 ] ], [ [ -1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, -1 ] ], 
      [ [ -1, 0, 0 ], [ 0, -1, 0 ], [ 0, 0, -1 ] ] ]
    gap> IdGroup(PG141ITA1);
    [ 16, 11 ]
    gap> ccl:=ConjugacyClasses(PG141ITA1);
    [ [ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]^G, [ [ -1, 0, 0 ], [ 0, -1, 0 ], [ 0, 0, 1 ] ]^G, [ [ -1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, -1 ] ]^G, 
      [ [ -1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]^G, [ [ 0, -1, 0 ], [ -1, 0, 0 ], [ 0, 0, -1 ] ]^G, [ [ 0, -1, 0 ], [ -1, 0, 0 ], [ 0, 0, 1 ] ]^G, 
      [ [ 0, -1, 0 ], [ 1, 0, 0 ], [ 0, 0, -1 ] ]^G, [ [ 0, -1, 0 ], [ 1, 0, 0 ], [ 0, 0, 1 ] ]^G, [ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, -1 ] ]^G, 
      [ [ -1, 0, 0 ], [ 0, -1, 0 ], [ 0, 0, -1 ] ]^G ]
    gap> Size(ccl);
    10
    gap> List(ccl, x-> [TraceMat(Representative(x)), Size(x)]);
    [ [ 3, 1 ], [ -1, 1 ], [ -1, 2 ], [ 1, 2 ], [ -1, 2 ], [ 1, 2 ], [ -1, 2 ], [ 1, 2 ], [ 1, 1 ], [ -3, 1 ] ]

• The space group is an infinite affine matrix group, so, your gengroupn function will fall into an infinite loop:

  In[1]:= gengroupn[ge1_] := Module[{}, ge = ge1;
    ne = Length[ge];
    l1 = 1;
    ne = Length[ge];
    While[l1 <= ne, l2 = 1;
     While[l2 <= ne, res = FullSimplify[Together[ge[[l1]] . ge[[l2]]]];
      If[! MemberQ[ge, res], ne++; AppendTo[ge, res]];
      l2++];
     l1++];
    ge]
  
  In[2]:= gensSG141ITA1 = {{{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 
       0}, {0, 0, 0, 1}}, {{-1, 0, 0, 1/2}, {0, -1, 0, 1/2}, {0, 0, 1, 
       1/2}, {0, 0, 0, 1}}, {{0, -1, 0, 0}, {1, 0, 0, 1/2}, {0, 0, 1, 
       1/4}, {0, 0, 0, 1}}, {{-1, 0, 0, 1/2}, {0, 1, 0, 0}, {0, 0, -1, 
       3/4}, {0, 0, 0, 1}}, {{-1, 0, 0, 0}, {0, -1, 0, 1/2}, {0, 0, -1, 
       1/4}, {0, 0, 0, 1}}, {{1, 0, 0, 1/2}, {0, 1, 0, 1/2}, {0, 0, 1, 
       1/2}, {0, 0, 0, 1}}};
  
  In[3]:= gengroupn[gensSG141ITA1]
  
  Out[3]= $Aborted
  

A possible method is to find the fractional part of the shifted part modulo 1 as the representative elements of the group. But I still don't know how to generate such a group using Wolfram language.

Regards, Zhao