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