1############################################################################# 2## 3#A color.gi Cryst library Bettina Eick 4#A Franz G"ahler 5#A Werner Nickel 6## 7#Y Copyright 1997-1999 by Bettina Eick, Franz G"ahler and Werner Nickel 8## 9## Cryst - the crystallographic groups package for GAP (color groups) 10## 11 12############################################################################# 13## 14#M IsColorGroup( G ) . . . . . . . . . . . . . . . . . .is it a color group? 15## 16 17# Subgroups of ColorGroups are ColorGroups 18InstallSubsetMaintenance( IsColorGroup, IsGroup, IsCollection ); 19 20# ColorGroups always know that they are ColorGroups 21InstallMethod( IsColorGroup, 22 "fallback method", true, [ IsGroup ], 0, G -> false ); 23 24############################################################################# 25## 26#M ColorSubgroup( G ) . . . . . . . . . . . . . . extract the color subgroup 27## 28InstallMethod( ColorSubgroup, 29 "for subgroups", true, [ IsColorGroup and HasParent ], 0, 30function( G ) 31 local P; 32 P := Parent( G ); 33 while HasParent( P ) and P <> Parent( P ) do 34 P := Parent( P ); 35 od; 36 return Intersection( ColorSubgroup( P ), G ); 37# return Stabilizer( G, ColorCosetList( P )[1], OnRight ); 38end ); 39 40############################################################################# 41## 42#M ColorCosetList( G ) . . . . . . . . . . . . . .color labelling coset list 43## 44InstallMethod( ColorCosetList, 45 "generic", true, [ IsColorGroup ], 0, 46 G -> RightCosets( G, ColorSubgroup( G ) ) ); 47 48############################################################################# 49## 50#M ColorOfElement( G, elm ) . . . . . . . . . . . . . . .color of an element 51## 52InstallGlobalFunction( ColorOfElement, function( G, elm ) 53 local P, cos, i; 54 P := G; 55 while HasParent( P ) and Parent( P ) <> P do 56 P := Parent( P ); 57 od; 58 cos := ColorCosetList( P ); 59 for i in [1..Length( cos )] do 60 if elm in cos[i] then 61 return i; 62 fi; 63 od; 64 Error("elm must be an element of G"); 65end ); 66 67 68############################################################################# 69## 70#F ColorPermGroupHomomorphism( G ) . . . . .color PermGroup and homomorphism 71## 72ColorPermGroupHomomorphism := function( G ) 73 local P, pmg, hom; 74 P := G; 75 while HasParent( P ) and P <> Parent( P ) do 76 P := Parent( P ); 77 od; 78 pmg := Action( G, ColorCosetList( P ), OnRight ); 79 hom := ActionHomomorphism( G, pmg ); 80 return [ pmg, hom ]; 81end; 82 83 84############################################################################# 85## 86#M ColorPermGroup( G ) . . . . . . . . . . . . . . . . . . . color PermGroup 87## 88InstallMethod( ColorPermGroup, 89 "generic", true, [ IsColorGroup ], 0, 90function( G ) 91 local tmp; 92 tmp := ColorPermGroupHomomorphism( G ); 93 SetColorHomomorphism( G, tmp[2] ); 94 return tmp[1]; 95end ); 96 97 98############################################################################# 99## 100#M ColorHomomorphism( G ) . . . . . . . . . .homomorphism to color PermGroup 101## 102InstallMethod( ColorHomomorphism, 103 "generic", true, [ IsColorGroup ], 0, 104function( G ) 105 local tmp; 106 tmp := ColorPermGroupHomomorphism( G ); 107 SetColorPermGroup( G, tmp[1] ); 108 return tmp[2]; 109end ); 110 111 112############################################################################# 113## 114#M PointGroup( G ) . . . . . . . . . . . . . . . . . . . . .color PointGroup 115## 116InstallMethod( PointGroup, "for colored AffineCrystGroups", 117 true, [ IsColorGroup and IsAffineCrystGroupOnLeftOrRight ], 0, 118function( G ) 119 120 local tmp, P, hom, H, reps; 121 122 tmp := PointGroupHomomorphism( G ); 123 P := tmp[1]; 124 hom := tmp[2]; 125 SetPointGroup( G, P ); 126 SetPointHomomorphism( G, hom ); 127 128 # color the point group if possible 129 H := ColorSubgroup( G ); 130 if TranslationBasis( G ) = TranslationBasis( H ) then 131 H := PointGroup( H ); 132 SetIsColorGroup( P, true ); 133 SetColorSubgroup( P, H ); 134 reps := List( ColorCosetList( G ), 135 x -> ImagesRepresentative( hom, Representative( x ) ) ); 136 SetColorCosetList( P, List( reps, x -> RightCoset( H, x ) ) ); 137 fi; 138 139 return P; 140 141end ); 142 143 144############################################################################# 145## 146#M ColorGroup( G, H ) . . . . . . . . . . . . . . . . . . make a color group 147## 148InstallGlobalFunction( ColorGroup, function( G, H ) 149 150 local C, U, P, reps; 151 152 # H must be a subgroup of G 153 if not IsSubgroup( G, H ) then 154 Error("H must be contained in G"); 155 fi; 156 157 # since G may contain uncolored information components, make a new group 158 C := GroupByGenerators( GeneratorsOfGroup( G ), One( G ) ); 159 U := GroupByGenerators( GeneratorsOfGroup( H ), One( H ) ); 160 161 # make C a color group 162 SetIsColorGroup( C, true ); 163 SetColorSubgroup( C, U ); 164 165 # if G is an AffineCrystGroup, make C am AffineCrystGroup 166 if IsCyclotomicMatrixGroup( G ) then 167 if IsAffineCrystGroupOnRight( G ) then 168 SetIsAffineCrystGroupOnRight( C, true ); 169 SetIsAffineCrystGroupOnRight( U, true ); 170 if HasTranslationBasis( H ) then 171 AddTranslationBasis( U, TranslationBasis( H ) ); 172 fi; 173 if HasTranslationBasis( G ) then 174 AddTranslationBasis( C, TranslationBasis( G ) ); 175 fi; 176 fi; 177 if IsAffineCrystGroupOnLeft( G ) then 178 SetIsAffineCrystGroupOnLeft( C, true ); 179 SetIsAffineCrystGroupOnLeft( U, true ); 180 if HasTranslationBasis( H ) then 181 AddTranslationBasis( U, TranslationBasis( H ) ); 182 fi; 183 if HasTranslationBasis( G ) then 184 AddTranslationBasis( C, TranslationBasis( G ) ); 185 fi; 186 fi; 187 fi; 188 189 SetParent( C, C ); 190 return C; 191 192end ); 193 194