Group Abstract

Message Boards

WOLFRAM COMMUNITY

2.9K Views

2 Replies

0 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Algebra Group Theory Wolfram Language

Optimize the efficiency of outer product when generating group elements

Hongyi Zhao

Posted 3 years ago

Based on the idea here, I wrote the following code snippet to generate all non-equivalent elements of an affine crystallographic group: AffOnLeftModOne[x_,y_]:=Module[{dim}, dim=Dimensions[x,1][[1]]-1; (TransformationMatrix[AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&@Dot[x,y]]) TransformationMatrix[ AffineTransform[{#[[1 ;; dim, 1 ;; dim]], Mod[#[[1 ;; dim, dim + 1]], 1]}] &@Dot[x, y]] // Expand // Together // FullSimplify ] AffCrystGroupOnLeft[gens_]:=Module[{dim,count,ge}, If[Length[Dimensions[gens]]==3 && Dimensions[gens][[2]]==Dimensions[gens][[3]], dim=Dimensions[gens][[2]]-1;,Abort[]]; count=0; ge = NestWhile[ (count++; Union[Join[#1, (TransformationMatrix/@(AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&/@Flatten[Outer[Dot, gens, #1, 1], 1])) Flatten[Outer[AffOnLeftModOne, gens, #1, 1], 1] ]]) & , {AffineTransform[{IdentityMatrix[dim],ConstantArray[0, dim]}]//TransformationMatrix} , Length[#2] != Length[#1]& , 2 , 99 ]; (Return[{ge,count}]) Return[ge] ] M1={{0,0,1,1/4},{1,0,0,1/4},{0,-1,0,1/4},{0,0,0,1}}; M2={{0,0,-1,0},{0,-1,0,0},{1,0,0,0},{0,0,0,1}}; SGGenElemAK227LeftS1={M1,M2}; In[172]:= AffCrystGroupOnLeft[SGGenElemAK227LeftS1]//Length//Timing Out[172]= {1.3305, 192} However, for the above method, I have the following problems need to be solved or further improvements: Here I use 99 as the most times to apply the function and a variable count to stores the number of function executions. I want to know how to automatically throw an error or prompt message when this condition is violated, so that I know that the task has not been completed normally. Outer is the core command of this method. I want to know if there are any other methods to further improve efficiency. Regards, Zhao

Based on the idea here, I wrote the following code snippet to generate all non-equivalent elements of an affine crystallographic group:

AffOnLeftModOne[x_,y_]:=Module[{dim},
dim=Dimensions[x,1][[1]]-1;
(*TransformationMatrix[AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&@Dot[x,y]]*)
TransformationMatrix[
    AffineTransform[{#[[1 ;; dim, 1 ;; dim]], 
        Mod[#[[1 ;; dim, dim + 1]], 1]}] &@Dot[x, y]] // Expand // 
  Together // FullSimplify
]

AffCrystGroupOnLeft[gens_]:=Module[{dim,count,ge},
If[Length[Dimensions[gens]]==3 && Dimensions[gens][[2]]==Dimensions[gens][[3]],
dim=Dimensions[gens][[2]]-1;,Abort[]];

count=0;
ge = NestWhile[ (count++;
                Union[Join[#1, 
                    (*TransformationMatrix/@(AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&/@Flatten[Outer[Dot, gens, #1, 1], 1])*)
                    Flatten[Outer[AffOnLeftModOne, gens, #1, 1], 1]
                    ]]) &
                ,
                {AffineTransform[{IdentityMatrix[dim],ConstantArray[0, dim]}]//TransformationMatrix}
                ,
                Length[#2] != Length[#1]&
                ,
                2
                ,
                99
            ];
  (*Return[{ge,count}]*)
  Return[ge]
]


M1={{0,0,1,1/4},{1,0,0,1/4},{0,-1,0,1/4},{0,0,0,1}};
M2={{0,0,-1,0},{0,-1,0,0},{1,0,0,0},{0,0,0,1}};
SGGenElemAK227LeftS1={M1,M2};

In[172]:= AffCrystGroupOnLeft[SGGenElemAK227LeftS1]//Length//Timing

Out[172]= {1.3305, 192}

However, for the above method, I have the following problems need to be solved or further improvements:

Here I use 99 as the most times to apply the function and a variable count to stores the number of function executions. I want to know how to automatically throw an error or prompt message when this condition is violated, so that I know that the task has not been completed normally.
Outer is the core command of this method. I want to know if there are any other methods to further improve efficiency.

Regards, Zhao

POSTED BY: Hongyi Zhao

2 Replies

Sort By:

Hongyi Zhao

Posted 3 years ago

Thank you very much. As shown below, it implements the functionality you have described above: AffModOneDotOnLeft // ClearAll; AffModOneDotOnLeft[list_List] := Module[{dim,elms}, elms=list; dim=Dimensions[list[[1]]][[1]]-1; (TransformationMatrix[AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&@Dot[x,y]]) TransformationMatrix[ AffineTransform[{#[[1 ;; dim, 1 ;; dim]], Mod[#[[1 ;; dim, dim + 1]], 1]}] &@(Dot@@elms)] // Expand // Together // FullSimplify ({dim,elms}) ] AffModOneDotOnLeft[args__] := AffModOneDotOnLeft[{args}] (p={{-1, -1, 1, 3/4}, {1, -1, -1, -(5/4)}, {-1, 1, -1, -(5/4)}, {0, 0, 0, 1}}; q={{-1, 0, 0, 0}, {0, -1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}; r=Inverse[p]; MapAt[Mod[#,1]&, p.q.r,{1;;3,4}]==AffModOneDotOnLeft[p,q.r]==AffModOneDotOnLeft[p,q,r]==AffModOneDotOnLeft[{p,q,r}]) In[345]:= AffCrystGroupOnLeft//ClearAll; AffCrystGroupOnLeft[gens_]:=Module[{dim,count,max,ge}, If[Length[Dimensions[gens]]==3 && Dimensions[gens][[2]]==Dimensions[gens][[3]], dim=Dimensions[gens][[2]]-1;,Abort[]]; count=0; max=3; ge = NestWhile[ (count++; Union[Join[#1, (TransformationMatrix/@(AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&/@Flatten[Outer[Dot, gens, #1, 1], 1])) Flatten[Outer[AffModOneDotOnLeft, gens, #1, 1], 1] ]]) & , {AffineTransform[{IdentityMatrix[dim],ConstantArray[0, dim]}]//TransformationMatrix} , Length[#2] != Length[#1]& , 2 , max ]; If[count == max, Failure["InvalidRange", <\|"MessageTemplate" -> "Maximum steps exceeded the limit `Number`","MessageParameters"-> <\|"Number" -> max\|>\|>], ge] ] In[347]:= AffCrystGroupOnLeft[SGGenElemAK227LeftS1] Out[347]= Failure["InvalidRange", <\|"MessageTemplate" -> "Maximum \ steps exceeded the limit `Number`", "MessageParameters" -> <\|"Number" -> 3\|>\|>]

Thank you very much. As shown below, it implements the functionality you have described above:

AffModOneDotOnLeft // ClearAll;
AffModOneDotOnLeft[list_List] := Module[{dim,elms},
elms=list;
dim=Dimensions[list[[1]]][[1]]-1;

(*TransformationMatrix[AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&@Dot[x,y]]*)
TransformationMatrix[
    AffineTransform[{#[[1 ;; dim, 1 ;; dim]], 
        Mod[#[[1 ;; dim, dim + 1]], 1]}] &@(Dot@@elms)] // Expand // 
  Together // FullSimplify
  (*{dim,elms}*)
]
AffModOneDotOnLeft[args__] := AffModOneDotOnLeft[{args}]

(*p={{-1, -1, 1, 3/4}, {1, -1, -1, -(5/4)}, {-1, 1, -1, -(5/4)}, {0, 0, 0,
   1}};
q={{-1, 0, 0, 0}, {0, -1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}};
r=Inverse[p];

MapAt[Mod[#,1]&, p.q.r,{1;;3,4}]==AffModOneDotOnLeft[p,q.r]==AffModOneDotOnLeft[p,q,r]==AffModOneDotOnLeft[{p,q,r}]*)

In[345]:= AffCrystGroupOnLeft//ClearAll;
AffCrystGroupOnLeft[gens_]:=Module[{dim,count,max,ge},
If[Length[Dimensions[gens]]==3 && Dimensions[gens][[2]]==Dimensions[gens][[3]],
dim=Dimensions[gens][[2]]-1;,Abort[]];

count=0;
max=3;
ge = NestWhile[ (count++;
                Union[Join[#1, 
                    (*TransformationMatrix/@(AffineTransform[{#[[1;;dim,1;;dim]],Mod[#[[1;;dim,dim+1]],1]}]&/@Flatten[Outer[Dot, gens, #1, 1], 1])*)
                    Flatten[Outer[AffModOneDotOnLeft, gens, #1, 1], 1]
                    ]]) &
                ,
                {AffineTransform[{IdentityMatrix[dim],ConstantArray[0, dim]}]//TransformationMatrix}
                ,
                Length[#2] != Length[#1]&
                ,
                2
                ,
                max
            ];

            If[count == max, 
             Failure["InvalidRange",  <|"MessageTemplate" -> "Maximum steps exceeded the limit `Number`","MessageParameters"-> <|"Number" -> max|>|>], 
                  ge]
]

In[347]:= AffCrystGroupOnLeft[SGGenElemAK227LeftS1]

Out[347]= Failure["InvalidRange", <|"MessageTemplate" -> "Maximum \
steps exceeded the limit `Number`", 
  "MessageParameters" -> <|"Number" -> 3|>|>]

POSTED BY: Hongyi Zhao

Rohit Namjoshi

Posted 3 years ago

For #1 you could examine the value of `count` after the `NestWhile` and evaluate `Failure` if the condition is violated.

POSTED BY: Rohit Namjoshi

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback