1############################################################################ 2## 3#W fastmod.gi QuaGroup Willem de Graaf 4## 5## 6## Some fast methods for creating modules in special cases. 7## 8 9InstallMethod( A2Module, 10 "for a qea of type A2, highest weight", true, 11 [ IsQuantumUEA and IsGenericQUEA, IsList ], 0, 12 function( U, hw ) 13 14 local n1, n2, bas, mons, c, b, a, erep, dim, V, vv, 15 acts, act, i, pos, M, v, k, v1, v2, W, wts, 16 vecs, wt; 17 18 n1:= hw[1]; n2:= hw[2]; 19 20 # Get a basis of the module: 21 bas:= [ ]; 22 mons:= [ ]; 23 for c in [0..n1] do 24 for b in [c..n2+c] do 25 for a in [0..n1+b-2*c] do 26 erep:= [ ]; 27 if a <> 0 then Append( erep, [1,a] ); fi; 28 if c <> 0 then Append( erep, [2,c] ); fi; 29 if b-c <> 0 then Append( erep, [3,b-c] ); fi; 30 31 Add( mons, ObjByExtRep( ElementsFamily(FamilyObj(U)), 32 [ erep, _q^0 ] ) ); 33 Add( bas, [a,b,c] ); 34 od; 35 od; 36 od; 37 38 # The actual module will be a sparse row space: 39 dim:= Length( bas ); 40 V:= FullSparseRowSpace( QuantumField, dim ); 41 vv:= BasisVectors( Basis(V) ); 42 acts:= [ ]; 43 44 # We compute the actions: 45 act:= [ ]; 46 for i in [1..dim] do 47 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 48 if a < n1+b-2*c then 49 pos:= Position( bas, [a+1,b,c] ); 50 Add( act, GaussNumber( a+1, _q )*vv[pos] ); 51 elif a+1+c <= b then 52 M:= Minimum( c, n2+c-b ); 53 v:= Zero(V); 54 for k in [1..M] do 55 pos:= Position( bas, [a+1+k,b,c-k] ); 56 v:= v + _q^(k*(b-c+k))*GaussianBinomial( a+1+k, k,_q )*vv[pos]; 57 od; 58 v:= -v*GaussNumber( a+1, _q ); 59 Add( act, v ); 60 else 61 M:= Minimum( c, n2+c-b ); 62 v:= Zero(V); 63 for k in [1..M] do 64 pos:= Position( bas, [a+1+k,b,c-k] ); 65 v:= v + _q^(k*(a+1+k))*GaussianBinomial( b-c+k, b-c,_q )* 66 vv[pos]; 67 od; 68 v:= -v*GaussNumber( a+1, _q ); 69 Add( act, v ); 70 fi; 71 od; 72 Add( acts, act ); 73 74 act:= [ ]; 75 for i in [1..dim] do 76 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 77 if b=n2+c then 78 v:= Zero(V); 79 else 80 v:= _q^(a-c)*GaussNumber( b-c+1, _q )* 81 vv[ Position( bas, [a,b+1,c] ) ]; 82 fi; 83 84 if a >= 1 then 85 if c < n1 then 86 pos:= Position( bas, [a-1,b+1,c+1] ); 87 v:= v+GaussNumber( c+1, _q )*vv[pos]; 88 elif a+c<=b+1 then 89 M:= Minimum( c, n2+c-b-1 ); 90 v1:= Zero( V ); 91 for k in [0..M] do 92 pos:= Position( bas, [a+k,b+1,c-k] ); 93 v1:=v1+_q^((k+1)*(b+1-c+k))* 94 GaussianBinomial(a+k,k+1,_q)*vv[pos]; 95 od; 96 v:= v-v1*GaussNumber( c+1, _q ); 97 else 98 M:= Minimum( c, n2+c-b-1 ); 99 v1:= Zero( V ); 100 for k in [0..M] do 101 pos:= Position( bas, [a+k,b+1,c-k] ); 102 v1:=v1+_q^((k+1)*(a+k))* 103 GaussianBinomial(b-c+1+k,b-c,_q)*vv[pos]; 104 od; 105 v:= v-v1*GaussNumber( c+1, _q ); 106 fi; 107 fi; 108 Add( act, v ); 109 od; 110 Add( acts, act ); 111 112 act:= [ ]; 113 for i in [1..dim] do 114 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 115 Add( act, _q^(n1-2*(a+c)+b)*vv[i] ); 116 od; 117 Add( acts, act ); 118 act:= [ ]; 119 for i in [1..dim] do 120 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 121 Add( act, _q^(n2+a+c-2*b)*vv[i] ); 122 od; 123 Add( acts, act ); 124 125 act:= [ ]; 126 for i in [1..dim] do 127 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 128 Add( act, _q^-(n1-2*(a+c)+b)*vv[i] ); 129 od; 130 Add( acts, act ); 131 act:= [ ]; 132 for i in [1..dim] do 133 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 134 Add( act, _q^-(n2+a+c-2*b)*vv[i] ); 135 od; 136 Add( acts, act ); 137 138 act:= [ ]; 139 for i in [1..dim] do 140 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 141 if a = 0 then 142 v1:= Zero(V); 143 else 144 pos:= Position( bas, [a-1,b,c] ); 145 v1:= GaussNumber( 1-a-2*c+b+n1, _q )*vv[pos]; 146 fi; 147 if c = 0 or b = n2+c then 148 v2:= Zero(V); 149 else 150 pos:= Position( bas, [a,b,c-1] ); 151 v2:= _q^(n1+2+b-2*c)*GaussNumber( b-c+1, _q )*vv[pos]; 152 fi; 153 Add( act, v1-v2 ); 154 od; 155 Add( acts, act ); 156 act:= [ ]; 157 for i in [1..dim] do 158 a:= bas[i][1]; b:= bas[i][2]; c:= bas[i][3]; 159 if b = c or a = n1+b-2*c then 160 v1:= Zero(V); 161 else 162 pos:= Position( bas, [a,b-1,c] ); 163 v1:= GaussNumber( n2+1-b+c, _q )*vv[pos]; 164 fi; 165 if c = 0 then 166 v2:= Zero(V); 167 else 168 pos:= Position( bas, [a+1,b-1,c-1] ); 169 v2:= _q^(2*b-2*c-n2)*GaussNumber( a+1, _q )*vv[pos]; 170 fi; 171 if a < n1+b-2*c or b = c then 172 Add( act, v1+v2 ); 173 else 174 M:= Minimum( c, n2+c-b+1 ); 175 v1:= Zero( V ); 176 for k in [1..M] do 177 pos:= Position( bas, [a+k,b-1,c-k] ); 178 v1:= v1 + _q^(k*(a+k))*GaussianBinomial( b-c+k-1, b-c-1, _q)* 179 vv[pos]; 180 od; 181 Add( act, v2-GaussNumber( n2+1-b+c, _q )*v1 ); 182 fi; 183 od; 184 Add( acts, act ); 185 186 W:= DIYModule( U, V, acts ); 187 # Set the attribute WeightsAndVectors... 188 wts:= [ ]; vecs:= [ ]; 189 for i in [1..Length(bas)] do 190 wt:= hw-[bas[i][1]+bas[i][3],bas[i][2]]*CartanMatrix( RootSystem(U) ); 191 pos:= Position( wts, wt ); 192 if pos = fail then 193 Add( wts, wt ); Add( vecs, [ Basis(W)[i] ] ); 194 else 195 Add( vecs[pos], Basis(W)[i] ); 196 fi; 197 od; 198 SetWeightsAndVectors( W, [ wts, vecs ] ); 199 SetHighestWeightsAndVectors( W, [ [ wts[1] ], [ vecs[1] ] ] ); 200 return W; 201 202end ); 203 204InstallMethod( A2Module, 205 "for a qea of type A2, highest weight", true, 206 [ IsQuantumUEA, IsList ], 0, 207 function( U, hw ) 208 209 local action, U0, V, qpar, W, ww, wvecs, fam; 210 211 # Here U is non-generic; we construct the highest-weight 212 # module over the generic quea, and compute the action by 213 # mapping to this one, and mapping back. We note that it is 214 # not possible (in general) to do a Groebner basis thing, because 215 # if qpar is a root of 1, then there are zero divisors. 216 217 action:= function( qpar, famU0, x, v ) 218 219 local Vwv, Wwv, ev, ex, im, vi, j, m, vvi, evv, i, k; 220 221 Vwv:= FamilyObj( v )!.originalBVecs; 222 Wwv:= FamilyObj( v )!.basisVectors; 223 224 ev:= ExtRepOfObj( v ); 225 ex:= ExtRepOfObj( x ); 226 im:= 0*v; 227 for i in [1,3..Length(ev)-1] do 228 # calculate the image x^vi, map it back, add it to im. 229 vi:= Vwv[ ev[i] ]; 230 for j in [1,3..Length(ex)-1] do 231 m:= ObjByExtRep( famU0, [ ex[j], _q^0 ] ); 232 vvi:= m^vi; 233 # map vvi back to the module W: 234 evv:= ExtRepOfObj( ExtRepOfObj( vvi ) ); 235 for k in [1,3..Length(evv)-1] do 236 im:= im+Wwv[ evv[k] ]*Value( evv[k+1], qpar )* 237 ex[j+1]*ev[i+1]; 238 od; 239 od; 240 od; 241 return im; 242 end; 243 244 U0:= QuantizedUEA( RootSystem( U ) ); 245 V:= A2Module( U0, hw ); 246 247 # create the new module 248 qpar:= QuantumParameter( U ); 249 250 W:= LeftAlgebraModule( U, function(x,v) return 251 action( qpar, ElementsFamily( FamilyObj(U0) ), x, v ); end, 252 FullSparseRowSpace( LeftActingDomain(U), Dimension(V) ) ); 253 254 fam:= FamilyObj( ExtRepOfObj(Zero(W)) ); 255 fam!.originalBVecs:= BasisVectors( Basis(V) ); 256 fam!.basisVectors:= List( BasisVectors( Basis( W ) ), x ->x![1] ); 257 258 # Set the attributes `WeightsAndVectors', and 259 # `HighestWeightsAndVectors'. 260 ww:= WeightsAndVectors( V ); 261 wvecs:= List( ww[2], x -> List( x, y -> Basis(W)[ y![1]![1][1] ] ) ); 262 263 SetWeightsAndVectors( W, [ ww[1], wvecs ] ); 264 SetHighestWeightsAndVectors( W, [ [ww[1]], [wvecs[1]] ] ); 265 266 return W; 267 268end ); 269 270 271InstallMethod( MinusculeModule, 272 "for a qea, highest weight", true, 273 [ IsGenericQUEA, IsList ], 0, 274 function( U, hw ) 275 276 local R, char, o, wts, V, vv, acts, sim, posR, B, 277 rank, i, act, j, pos; 278 279 R:= RootSystem( U ); 280 char:= DominantCharacter( R, hw ); 281 if Length( char[1] ) > 1 then 282 Error("<hw> is not minuscule."); 283 fi; 284 285 o:= WeylOrbitIterator( WeylGroup(R), hw ); 286 wts:= [ ]; 287 while not IsDoneIterator( o ) do 288 Add( wts, NextIterator( o ) ); 289 od; 290 291 V:= FullSparseRowSpace( LeftActingDomain(U), Length( wts ) ); 292 vv:= BasisVectors( Basis( V ) ); 293 acts:= [ ]; 294 sim:= SimpleRootsAsWeights( R ); 295 posR:= PositiveRootsInConvexOrder( R ); 296 B:= BilinearFormMatNF(R); 297 298 rank:= Length( sim ); 299 # action of the F's: 300 for i in [1..rank] do 301 act:= [ ]; 302 for j in [1..Length(vv)] do 303 if wts[j][i] > 0 then 304 pos:= Position( wts, wts[j] - sim[i] ); 305 act[j]:= vv[pos]; 306 fi; 307 od; 308 Add( acts, act ); 309 od; 310 311 # action of the K's: 312 for i in [1..rank] do 313 Add( acts, List( [1..Length(wts)], x -> 314 _q^(wts[x][i]*B[i][i]/2)*vv[x] ) ); 315 od; 316 317 # action of the K's: 318 for i in [1..rank] do 319 Add( acts, List( [1..Length(wts)], x -> 320 _q^(-wts[x][i]*B[i][i]/2)*vv[x] ) ); 321 od; 322 323 # action of the F's: 324 for i in [1..rank] do 325 act:= [ ]; 326 for j in [1..Length(vv)] do 327 if wts[j][i] < 0 then 328 pos:= Position( wts, wts[j] + sim[i] ); 329 act[j]:= vv[pos]; 330 fi; 331 od; 332 Add( acts, act ); 333 od; 334 335 return DIYModule( U, V, acts ); 336 337end ); 338 339 340 341