1############################################################################# 2## 3#W resolutionBieberbach.gi HAPcryst package Marc Roeder 4## 5## 6 7## 8## 9#Y Copyright (C) 2006 Marc Roeder 10#Y 11#Y This program is free software; you can redistribute it and/or 12#Y modify it under the terms of the GNU General Public License 13#Y as published by the Free Software Foundation; either version 2 14#Y of the License, or (at your option) any later version. 15#Y 16#Y This program is distributed in the hope that it will be useful, 17#Y but WITHOUT ANY WARRANTY; without even the implied warranty of 18#Y MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19#Y GNU General Public License for more details. 20#Y 21#Y You should have received a copy of the GNU General Public License 22#Y along with this program; if not, write to the Free Software 23#Y Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA 24## 25############################################################################# 26## 27#O ResolutionBieberbachGroup(<group>) 28## 29InstallMethod(ResolutionBieberbachGroup, 30 [IsGroup], 31 function(group) 32 return ResolutionBieberbachGroup(group,0*[1..Size(Representative(group))-1]); 33end); 34 35############################################################################# 36## 37#O ResolutionBieberbachGroup(<group>,<center>) 38## 39InstallMethod(ResolutionBieberbachGroup,"for affine cryst groups on right", 40 [IsGroup,IsVector], 41 function(group,center) 42 local gram, poly, fl; 43 44 gram:=GramianOfAverageScalarProductFromFiniteMatrixGroup(PointGroup(group)); 45 if not Order(gram)=1 46 then 47 Info(InfoHAPcryst,2,"non standard"); 48 fi; 49 poly:=FundamentalDomainBieberbachGroup(center,group,gram); 50 fl:=FaceLatticeAndBoundaryBieberbachGroup(poly,group); 51 RemoveFile(FullFilenameOfPolymakeObject(poly)); 52 return ResolutionFromFLandBoundary(fl, group); 53end); 54 55 56############################################################################# 57## 58#O ResolutionFromFLandBoundary(<fl>,<group>) 59## 60InstallMethod(ResolutionFromFLandBoundary,"for affine cryst groups on right", 61 [IsRecord,IsGroup], 62 function(fl,group) 63 local dimension, dimension2, boundary, elts, appendToElts, 64 boundary2, groupring, resolution, homotopy, hasse, 65 properties; 66 dimension:=function(k) 67 if k<0 or k>Size(fl.hasse)-1 68 then 69 return 0; 70 else 71 return Size(fl.hasse[k+1]); 72 fi; 73 end; 74 75 dimension2:=function(resolution,k) 76 if k<0 or k>Size(resolution!.hasse)-1 77 then 78 return 0; 79 else 80 return Size(resolution!.hasse[k+1]); 81 fi; 82 end; 83 84 85 86 boundary:=function(k,j) 87 local word, jsign, stdword, pos, coeffsAndGroupElts, g, 88 sign, mult, entry, i; 89 90 if k<=0 or k>=Size(fl.hasse) 91 then 92 return []; 93 else 94 word:=fl.hasse[k+1][AbsInt(j)][2]; 95 jsign:=SignInt(j); 96 stdword:=[]; 97 for pos in [1..Size(word)] 98 do 99 coeffsAndGroupElts:=CoefficientsAndMagmaElementsAsLists(word[pos][2]); 100 for g in [1..Size(coeffsAndGroupElts[1])] 101 do 102 sign:=jsign*SignInt(coeffsAndGroupElts[1][g]); 103 mult:=AbsInt(coeffsAndGroupElts[1][g]); 104 entry:=[sign*word[pos][1],Position(fl.elts,coeffsAndGroupElts[2][g])]; 105 for i in [1..mult] 106 do 107 Add(stdword,entry); 108 od; 109 od; 110 od; 111 fi; 112 return stdword; 113 end; 114 115 116 ## this is the usual HAP trick. 117 ## After the termination of ResolutionFromFLandBoundary, <elts> will not 118 ## be collected by GASMAN because appendToElts still uses it. 119 ## It will just float around as a secret global (to appendToElts) 120 ## variable... 121 ## 122 ## same with <group>. 123 ## 124 elts:=StructuralCopy(fl.elts); 125 126 appendToElts:=function(g) 127 if not g in group 128 then 129 Error("not an element of the right group"); 130 fi; 131 Add(elts,g); 132 end; 133 134 135 ################################################## 136 ################################################## 137 138 139 boundary2:=function(resolution,k,j) 140 local zero, family, vector, term; 141 if k<=0 or k>=Size(resolution!.hasse) 142 then 143 return []; 144 else 145 zero:=Zero(resolution!.groupring); 146 family:=FamilyObj(zero); 147 vector:=List([1..Dimension(resolution)(k-1)],i->zero); 148 for term in resolution!.hasse[k+1][j][2] 149 do 150 vector[term[1]]:=vector[term[1]]+ 151 term[2]; 152 od; 153 fi; 154 return vector; 155 end; 156 157 158 if not (IsAffineCrystGroupOnRight(group) and IsStandardSpaceGroup(group)) 159 then 160 Error("group is not a StandardSpaceGroup acting on right"); 161 fi; 162 if not ForAll(fl.elts,i->i in group) 163 then 164 Error("group does not match face lattice"); 165 fi; 166 167 groupring:=fl.groupring; 168 resolution:=Objectify(HapLargeGroupResolution, 169 rec( 170 groupring:=groupring, 171 dimension:=dimension, 172 dimension2:=dimension2, 173 boundary:=boundary, 174 boundary2:=boundary2, 175 homotopy:=fail, 176 elts:=elts, 177 appendToElts:=appendToElts, 178 group:=group, 179 hasse:=fl.hasse, 180 properties:= 181 [["length",Size(fl.hasse)], 182 ["type","resolution"], 183 ["characteristic",0] 184 ] 185 )); 186 return resolution; 187end); 188 189 190 191