1 | /////////////////////////////////////////////////////////////////////////////// |
---|
2 | version="$Id$"; |
---|
3 | category="Invariant theory"; |
---|
4 | info=" |
---|
5 | LIBRARY: rinvar.lib Invariant Rings of Reductive Groups |
---|
6 | AUTHOR: Thomas Bayer, tbayer@in.tum.de |
---|
7 | http://wwwmayr.informatik.tu-muenchen.de/personen/bayert/ |
---|
8 | Current Address: Institut fuer Informatik, TU Muenchen |
---|
9 | OVERVIEW: |
---|
10 | Implementation based on Derksen's algorithm. Written in the scope of the |
---|
11 | diploma thesis (advisor: Prof. Gert-Martin Greuel) 'Computations of moduli |
---|
12 | spaces of semiquasihomogenous singularities and an implementation in Singular' |
---|
13 | |
---|
14 | PROCEDURES: |
---|
15 | HilbertSeries(I, w); Hilbert series of the ideal I w.r.t. weight w |
---|
16 | HilbertWeights(I, w); weighted degrees of the generators of I |
---|
17 | ImageVariety(I, F); ideal of the image variety F(variety(I)) |
---|
18 | ImageGroup(G, F); ideal of G w.r.t. the induced representation |
---|
19 | InvariantRing(G, Gaction); generators of the invariant ring of G |
---|
20 | InvariantQ(f, G, Gaction); decide if f is invariant w.r.t. G |
---|
21 | LinearizeAction(G, Gaction); linearization of the action 'Gaction' of G |
---|
22 | LinearActionQ(action,s,t); decide if action is linear in var(s..nvars) |
---|
23 | LinearCombinationQ(base, f); decide if f is in the linear hull of 'base' |
---|
24 | MinimalDecomposition(f,s,t); minimal decomposition of f (like coef) |
---|
25 | NullCone(G, act); ideal of the nullcone of the action 'act' of G |
---|
26 | ReynoldsImage(RO,f); image of f under the Reynolds operator 'RO' |
---|
27 | ReynoldsOperator(G, Gaction); Reynolds operator of the group G |
---|
28 | SimplifyIdeal(I[,m,s]); simplify the ideal I (try to reduce variables) |
---|
29 | |
---|
30 | SEE ALSO: qhmoduli_lib, zeroset_lib |
---|
31 | "; |
---|
32 | |
---|
33 | LIB "presolve.lib"; |
---|
34 | LIB "elim.lib"; |
---|
35 | LIB "zeroset.lib"; |
---|
36 | |
---|
37 | /////////////////////////////////////////////////////////////////////////////// |
---|
38 | |
---|
39 | proc EquationsOfEmbedding(ideal embedding, int nrs) |
---|
40 | "USAGE: EquationsOfEmbedding(embedding, s); ideal embedding; int s; |
---|
41 | PURPOSE: compute the ideal of the variety parameterized by 'embedding' by |
---|
42 | implicitation and change the variables to the old ones. |
---|
43 | RETURN: ideal |
---|
44 | ASSUME: nvars(basering) = n, size(embedding) = r and s = n - r. |
---|
45 | The polynomials of embedding contain only var(s + 1 .. n). |
---|
46 | NOTE: the result is the Zariski closure of the parameterized variety |
---|
47 | EXAMPLE: example EquationsOfEmbedding; shows an example |
---|
48 | " |
---|
49 | { |
---|
50 | ideal tvars; |
---|
51 | |
---|
52 | for(int i = nrs + 1; i <= nvars(basering); i++) { tvars[i - nrs] = var(i); } |
---|
53 | |
---|
54 | def RE1 = ImageVariety(ideal(0), embedding); // implicitation of the parameterization |
---|
55 | // map F = RE1, tvars; |
---|
56 | map F = RE1, maxideal(1); |
---|
57 | return(F(imageid)); |
---|
58 | } |
---|
59 | example |
---|
60 | {"EXAMPLE:"; echo = 2; |
---|
61 | ring R = 0,(s(1..5), t(1..4)),dp; |
---|
62 | ideal emb = t(1), t(2), t(3), t(3)^2; |
---|
63 | ideal I = EquationsOfEmbedding(emb, 5); |
---|
64 | I; |
---|
65 | } |
---|
66 | |
---|
67 | /////////////////////////////////////////////////////////////////////////////// |
---|
68 | |
---|
69 | proc ImageGroup(ideal Grp, ideal Gaction) |
---|
70 | "USAGE: ImageGroup(G, action); ideal G, action; |
---|
71 | PURPOSE: compute the ideal of the image of G in GL(m,K) induced by the linear |
---|
72 | action 'action', where G is an algebraic group and 'action' defines |
---|
73 | an action of G on K^m (size(action) = m). |
---|
74 | RETURN: ring, a polynomial ring over the same ground field as the basering, |
---|
75 | containing the ideals 'groupid' and 'actionid'. |
---|
76 | - 'groupid' is the ideal of the image of G (order <= order of G) |
---|
77 | - 'actionid' defines the linear action of 'groupid' on K^m. |
---|
78 | NOTE: 'action' and 'actionid' have the same orbits |
---|
79 | all variables which give only rise to 0's in the m x m matrices of G |
---|
80 | have been omitted. |
---|
81 | ASSUME: basering K[s(1..r),t(1..m)] has r + m variables, G is the ideal of an |
---|
82 | algebraic group and F is an action of G on K^m. G contains only the |
---|
83 | variables s(1)...s(r). The action 'action' is given by polynomials |
---|
84 | f_1,...,f_m in basering, s.t. on the ring level we have |
---|
85 | K[t_1,...,t_m] --> K[s_1,...,s_r,t_1,...,t_m]/G |
---|
86 | t_i --> f_i(s_1,...,s_r,t_1,...,t_m) |
---|
87 | EXAMPLE: example ImageGroup; shows an example |
---|
88 | " |
---|
89 | { |
---|
90 | int i, j, k, newVars, nrt, imageSize, dbPrt; |
---|
91 | ideal matrixEntries; |
---|
92 | matrix coMx; |
---|
93 | poly tVars, mPoly; |
---|
94 | string ringSTR1, ringSTR2, order; |
---|
95 | |
---|
96 | dbPrt = printlevel-voice+2; |
---|
97 | dbprint(dbPrt, "Image Group of " + string(Grp) + ", action = " |
---|
98 | + string(Gaction)); |
---|
99 | def RIGB = basering; |
---|
100 | mPoly = minpoly; |
---|
101 | tVars = 1; |
---|
102 | k = 0; |
---|
103 | |
---|
104 | // compute the representation of G induced by Gaction, i.e., a matrix |
---|
105 | // of size(Gaction) x size(Gaction) and polynomials in s(1),...,s(r) as |
---|
106 | // entries |
---|
107 | // the matrix is represented as the list 'matrixEntries' where |
---|
108 | // the entries which are always 0 are omittet. |
---|
109 | |
---|
110 | for(i = 1; i <= ncols(Gaction); i++) { |
---|
111 | tVars = tVars * var(i + nvars(basering) - ncols(Gaction)); |
---|
112 | } |
---|
113 | for(i = 1; i <= ncols(Gaction); i++){ |
---|
114 | coMx = coef(Gaction[i], tVars); |
---|
115 | for(j = 1; j <= ncols(coMx); j++){ |
---|
116 | k++; |
---|
117 | matrixEntries[k] = coMx[2, j]; |
---|
118 | } |
---|
119 | } |
---|
120 | newVars = size(matrixEntries); |
---|
121 | nrt = ncols(Gaction); |
---|
122 | |
---|
123 | // this matrix defines an embedding of G into GL(m, K). |
---|
124 | // in the next step the ideal of this image is computed |
---|
125 | // note that we have omitted all variables which give give rise |
---|
126 | // only to 0's. Note that z(1..newVars) are slack variables |
---|
127 | |
---|
128 | order = "(dp(" + string(nvars(basering)) + "), dp);"; |
---|
129 | ringSTR1 = "ring RIGR = (" + charstr(basering) + "), (" + varstr(basering) |
---|
130 | + ", z(1.." + string(newVars) + "))," + order; |
---|
131 | execute(ringSTR1); |
---|
132 | minpoly = number(imap(RIGB, mPoly)); |
---|
133 | ideal I1, I2, Gn, G, F, mEntries, newGaction; |
---|
134 | G = imap(RIGB, Grp); |
---|
135 | F = imap(RIGB, Gaction); |
---|
136 | mEntries = imap(RIGB, matrixEntries); |
---|
137 | |
---|
138 | // prepare the ideals needed to compute the image |
---|
139 | // and compute the new action of the image on K^m |
---|
140 | |
---|
141 | for(i=1;i<=size(mEntries);i++){ I1[i] = var(i + nvars(RIGB))-mEntries[i]; } |
---|
142 | I1 = std(I1); |
---|
143 | |
---|
144 | for(i = 1; i <= ncols(F); i++) { newGaction[i] = reduce(F[i], I1); } |
---|
145 | I2 = G, I1; |
---|
146 | I2 = std(I2); |
---|
147 | Gn = nselect(I2, 1.. nvars(RIGB)); |
---|
148 | imageSize = ncols(Gn); |
---|
149 | |
---|
150 | // create a new basering which might contain more variables |
---|
151 | // s(1..newVars) as the original basering and map the ideal |
---|
152 | // Gn (contians only z(1..newVars)) to this ring |
---|
153 | |
---|
154 | ringSTR2 = "ring RIGS = (" + charstr(basering) + "), (s(1.." |
---|
155 | + string(newVars) + "), t(1.." + string(nrt) + ")), lp;"; |
---|
156 | execute(ringSTR2); |
---|
157 | minpoly = number(imap(RIGB, mPoly)); |
---|
158 | ideal mapIdeal, groupid, actionid; |
---|
159 | int offset; |
---|
160 | |
---|
161 | // construct the map F : RIGB -> RIGS |
---|
162 | |
---|
163 | for(i=1;i<=nvars(RIGB)-nrt;i++) { mapIdeal[i] = 0;} // s(i)-> 0 |
---|
164 | offset = nvars(RIGB) - nrt; |
---|
165 | for(i=1;i<=nrt;i++) { mapIdeal[i+offset] = var(newVars + i);} // t(i)->t(i) |
---|
166 | offset = offset + nrt; |
---|
167 | for(i=1;i<=newVars;i++) { mapIdeal[i + offset] = var(i);} // z(i)->s(i) |
---|
168 | |
---|
169 | // map Gn and newGaction to RIGS |
---|
170 | |
---|
171 | map F = RIGR, mapIdeal; |
---|
172 | groupid = F(Gn); |
---|
173 | actionid = F(newGaction); |
---|
174 | export groupid, actionid; |
---|
175 | dbprint(dbPrt+1, " |
---|
176 | // 'ImageGroup' created a new ring. |
---|
177 | // To see the ring, type (if the name 'R' was assigned to the return value): |
---|
178 | show(R); |
---|
179 | // To access the ideal of the image of the input group and to access the new |
---|
180 | // action of the group, type |
---|
181 | setring R; groupid; actionid; |
---|
182 | "); |
---|
183 | setring RIGB; |
---|
184 | return(RIGS); |
---|
185 | } |
---|
186 | example |
---|
187 | {"EXAMPLE:"; echo = 2; |
---|
188 | ring B = 0,(s(1..2), t(1..2)),dp; |
---|
189 | ideal G = s(1)^3-1, s(2)^10-1; |
---|
190 | ideal action = s(1)*s(2)^8*t(1), s(1)*s(2)^7*t(2); |
---|
191 | def R = ImageGroup(G, action); |
---|
192 | setring R; |
---|
193 | groupid; |
---|
194 | actionid; |
---|
195 | } |
---|
196 | |
---|
197 | /////////////////////////////////////////////////////////////////////////////// |
---|
198 | |
---|
199 | proc HilbertWeights(ideal I, wt) |
---|
200 | "USAGE: HilbertWeights(I, w); ideal I, intvec wt |
---|
201 | PURPOSE: compute the weights of the "slack" variables needed for the |
---|
202 | computation of the algebraic relations of the generators of 'I' s.t. |
---|
203 | the Hilbert driven 'std' can be used. |
---|
204 | RETURN: intvec |
---|
205 | ASSUME: basering = K[t_1,...,t_m,...], 'I' is quasihomogenous w.r.t. 'w' and |
---|
206 | contains only polynomials in t_1,...,t_m |
---|
207 | " |
---|
208 | { |
---|
209 | int offset = size(wt); |
---|
210 | intvec wtn = wt; |
---|
211 | |
---|
212 | for(int i = 1; i <= size(I); i++) { wtn[offset + i] = deg(I[i], wt); } |
---|
213 | return(wtn); |
---|
214 | } |
---|
215 | |
---|
216 | /////////////////////////////////////////////////////////////////////////////// |
---|
217 | |
---|
218 | proc HilbertSeries(ideal I, wt) |
---|
219 | "USAGE: HilbertSeries(I, w); ideal I, intvec wt |
---|
220 | PURPOSE: compute the polynomial p of the Hilbert Series, represented by p/q, of |
---|
221 | the ring K[t_1,...,t_m,y_1,...,y_r]/I1 where 'w' are the weights of |
---|
222 | the variables, computed, e.g., by 'HilbertWeights', 'I1' is of the |
---|
223 | form I[1] - y_1,...,I[r] - y_r and is quasihomogenous w.r.t. 'w' |
---|
224 | RETURN: intvec |
---|
225 | NOTE: the leading 0 of the result does not belong to p, but is needed in |
---|
226 | the Hilbert driven 'std'. |
---|
227 | " |
---|
228 | { |
---|
229 | int i; |
---|
230 | intvec hs1; |
---|
231 | matrix coMx; |
---|
232 | poly f = 1; |
---|
233 | |
---|
234 | for(i = 1; i <= ncols(I); i++) { f = f * (1 - var(1)^deg(I[i], wt));} |
---|
235 | coMx = coeffs(f, var(1)); |
---|
236 | for(i = 1; i <= deg(f) + 1; i++) { |
---|
237 | hs1[i] = int(coMx[i, 1]); |
---|
238 | } |
---|
239 | hs1[size(hs1) + 1] = 0; |
---|
240 | return(hs1); |
---|
241 | } |
---|
242 | /////////////////////////////////////////////////////////////////////////////// |
---|
243 | |
---|
244 | proc HilbertSeries1(wt) |
---|
245 | "USAGE: HilbertSeries1(wt); ideal I, intvec wt |
---|
246 | PURPOSE: compute the polynomial p of the Hilbert Series represented by p/q of |
---|
247 | the ring K[t_1,...,t_m,y_1,...,y_r]/I where I is a complete inter- |
---|
248 | section and the generator I[i] has degree wt[i] |
---|
249 | RETURN: poly |
---|
250 | " |
---|
251 | { |
---|
252 | int i, j; |
---|
253 | intvec hs1; |
---|
254 | matrix ma; |
---|
255 | poly f = 1; |
---|
256 | |
---|
257 | for(i = 1; i <= size(wt); i++) { f = f * (1 - var(1)^wt[i]);} |
---|
258 | ma = coef(f, var(1)); |
---|
259 | j = ncols(ma); |
---|
260 | for(i = 0; i <= deg(f); i++) { |
---|
261 | if(var(1)^i == ma[1, j]) { |
---|
262 | hs1[i + 1] = int(ma[2, j]); |
---|
263 | j--; |
---|
264 | } |
---|
265 | else { hs1[i + 1] = 0; } |
---|
266 | } |
---|
267 | hs1[size(hs1) + 1] = 0; |
---|
268 | return(hs1); |
---|
269 | } |
---|
270 | |
---|
271 | /////////////////////////////////////////////////////////////////////////////// |
---|
272 | |
---|
273 | proc ImageVariety(ideal I, F, list #) |
---|
274 | "USAGE: ImageVariety(ideal I, F [, w]);ideal I; F is a list/ideal, intvec w. |
---|
275 | PURPOSE: compute the Zariski closure of the image of the variety of I under |
---|
276 | the morphism F. |
---|
277 | NOTE: if 'I' and 'F' are quasihomogenous w.r.t. 'w' then the Hilbert-driven |
---|
278 | 'std' is used. |
---|
279 | RETURN: polynomial ring over the same ground field, containing the ideal |
---|
280 | 'imageid'. The variables are Y(1),...,Y(k) where k = size(F) |
---|
281 | - 'imageid' is the ideal of the Zariski closure of F(X) where |
---|
282 | X is the variety of I. |
---|
283 | EXAMPLE: example ImageVariety; shows an example |
---|
284 | " |
---|
285 | { |
---|
286 | int i, dbPrt, nrNewVars; |
---|
287 | intvec wt, wth, hs1; |
---|
288 | string ringSTR1, ringSTR2, order; |
---|
289 | |
---|
290 | def RARB = basering; |
---|
291 | nrNewVars = size(F); |
---|
292 | |
---|
293 | dbPrt = printlevel-voice+2; |
---|
294 | dbprint(dbPrt, "ImageVariety of " + string(I) + " under the map " + string(F)); |
---|
295 | |
---|
296 | if(size(#) > 0) { wt = #[1]; } |
---|
297 | |
---|
298 | // create new ring for elimination, Y(1),...,Y(m) are slack variables. |
---|
299 | |
---|
300 | poly mPoly = minpoly; |
---|
301 | order = "(dp(" + string(nvars(basering)) + "), dp);"; |
---|
302 | ringSTR1 = "ring RAR1 = (" + charstr(basering) + "), (" + varstr(basering) + ", Y(1.." + string(nrNewVars) + ")), " + order; |
---|
303 | ringSTR2 = "ring RAR2 = (" + charstr(basering) + "), Y(1.." + string(nrNewVars) + "), dp;"; |
---|
304 | execute(ringSTR1); |
---|
305 | minpoly = number(imap(RARB, mPoly)); |
---|
306 | |
---|
307 | ideal I, J1, J2, Fm; |
---|
308 | |
---|
309 | I = imap(RARB, I); |
---|
310 | Fm = imap(RARB, F); |
---|
311 | |
---|
312 | if(size(wt) > 1) { |
---|
313 | wth = HilbertWeights(Fm, wt); |
---|
314 | hs1 = HilbertSeries(Fm, wt); |
---|
315 | } |
---|
316 | |
---|
317 | // get the ideal of the graph of F : X -> Y and compute a standard basis |
---|
318 | |
---|
319 | for(i = 1; i <= nrNewVars; i++) { J1[i] = var(i + nvars(RARB)) - Fm[i];} |
---|
320 | J1 = J1, I; |
---|
321 | if(size(wt) > 1) { |
---|
322 | J1 = std(J1, hs1, wth); // Hilbert-driven algorithm |
---|
323 | } |
---|
324 | else { |
---|
325 | J1 = std(J1); |
---|
326 | } |
---|
327 | |
---|
328 | // forget all elements which contain other than the slack variables |
---|
329 | |
---|
330 | J2 = nselect(J1, 1.. nvars(RARB)); |
---|
331 | |
---|
332 | execute(ringSTR2); |
---|
333 | minpoly = number(imap(RARB, mPoly)); |
---|
334 | ideal imageid = imap(RAR1, J2); |
---|
335 | export(imageid); |
---|
336 | dbprint(dbPrt+1, " |
---|
337 | // 'ImageVariety' created a new ring. |
---|
338 | // To see the ring, type (if the name 'R' was assigned to the return value): |
---|
339 | show(R); |
---|
340 | // To access the ideal of the image variety, type |
---|
341 | setring R; imageid; |
---|
342 | "); |
---|
343 | setring RARB; |
---|
344 | return(RAR2); |
---|
345 | } |
---|
346 | example |
---|
347 | {"EXAMPLE:"; echo = 2; |
---|
348 | ring B = 0,(x,y),dp; |
---|
349 | ideal I = x4 - y4; |
---|
350 | ideal F = x2, y2, x*y; |
---|
351 | def R = ImageVariety(I, F); |
---|
352 | setring R; |
---|
353 | imageid; |
---|
354 | } |
---|
355 | |
---|
356 | /////////////////////////////////////////////////////////////////////////////// |
---|
357 | |
---|
358 | proc LinearizeAction(ideal Grp, Gaction, int nrs) |
---|
359 | "USAGE: LinearizeAction(G,action,r); ideal G, action; int r |
---|
360 | PURPOSE: linearize the group action 'action' and find an equivariant embedding |
---|
361 | of K^m where m = size(action). |
---|
362 | ASSUME: G contains only variables var(1..r) (r = nrs) |
---|
363 | basering = K[s(1..r),t(1..m)], K = Q or K = Q(a) and minpoly != 0. |
---|
364 | RETURN: polynomial ring containing the ideals 'actionid', 'embedid', 'groupid' |
---|
365 | - 'actionid' is the ideal defining the linearized action of G |
---|
366 | - 'embedid' is a parameterization of an equivariant embedding (closed) |
---|
367 | - 'groupid' is the ideal of G in the new ring |
---|
368 | NOTE: set printlevel > 0 to see a trace |
---|
369 | EXAMPLE: example LinearizeAction; shows an example |
---|
370 | " |
---|
371 | { |
---|
372 | def altring = basering; |
---|
373 | int i, j, k, ok, loop, nrt, sizeOfDecomp, dbPrt; |
---|
374 | intvec wt; |
---|
375 | ideal action, basis, G, reduceIdeal; |
---|
376 | matrix decompMx; |
---|
377 | poly actCoeff; |
---|
378 | string str, order, mPoly; |
---|
379 | |
---|
380 | dbPrt = printlevel-voice+2; |
---|
381 | dbprint(dbPrt, "LinearizeAction " + string(Gaction)); |
---|
382 | def RLAR = basering; |
---|
383 | mPoly = "minpoly = " + string(minpoly) + ";"; |
---|
384 | order = ordstr(basering); |
---|
385 | nrt = ncols(Gaction); |
---|
386 | for(i = 1; i <= nrs; i++) { wt[i] = 0;} |
---|
387 | for(i = nrs + 1; i <= nrs + nrt; i++) { basis[i - nrs] = var(i); wt[i] = 1;} |
---|
388 | dbprint(dbPrt, " basis = " + string(basis)); |
---|
389 | if(attrib(Grp, "isSB")) { G = Grp; } |
---|
390 | else { G = std(Grp); } |
---|
391 | reduceIdeal = G; |
---|
392 | action = Gaction; |
---|
393 | loop = 1; |
---|
394 | i = 1; |
---|
395 | |
---|
396 | // check if each component of 'action' is linear in t(1),...,t(nrt). |
---|
397 | |
---|
398 | while(loop){ |
---|
399 | if(deg(action[i], wt) <= 1) { |
---|
400 | sizeOfDecomp = 0; |
---|
401 | dbprint(dbPrt, " " + string(action[i]) + " is linear"); |
---|
402 | } |
---|
403 | else { // action[i] is not linear |
---|
404 | |
---|
405 | // compute the minimal decomposition of action[i] |
---|
406 | // action[i]=decompMx[1,1]*decompMx[2,1]+ ... +decompMx[1,k]*decompMx[2,k] |
---|
407 | // decompMx[1,j] contains variables var(1)...var(nrs) |
---|
408 | // decompMx[2,j] contains variables var(nrs + 1)...var(nvars(basering)) |
---|
409 | |
---|
410 | dbprint(dbPrt, " " + string(action[i]) |
---|
411 | + " is not linear, a minimal decomposition is :"); |
---|
412 | decompMx = MinimalDecomposition(action[i], nrs, nrt); |
---|
413 | sizeOfDecomp = ncols(decompMx); |
---|
414 | dbprint(dbPrt, decompMx); |
---|
415 | |
---|
416 | for(j = 1; j <= sizeOfDecomp; j++) { |
---|
417 | // check if decompMx[2,j] is a linear combination of basis elements |
---|
418 | actCoeff = decompMx[2, j]; |
---|
419 | ok = LinearCombinationQ(basis, actCoeff, nrt + nrs); |
---|
420 | if(ok == 0) { |
---|
421 | |
---|
422 | // nonlinear element, compute new component of the action |
---|
423 | |
---|
424 | dbprint(dbPrt, " the polynomial " + string(actCoeff) |
---|
425 | + " is not a linear combination of the elements of basis"); |
---|
426 | nrt++; |
---|
427 | str = charstr(basering) + ", (" + varstr(basering) |
---|
428 | + ",t(" + string(nrt) + ")),"; |
---|
429 | if(defined(RLAB)) { kill RLAB;} |
---|
430 | def RLAB = basering; |
---|
431 | if(defined(RLAR)) { kill RLAR;} |
---|
432 | execute("ring RLAR = " + str + "(" + order + ");"); |
---|
433 | execute(mPoly); |
---|
434 | |
---|
435 | ideal basis, action, G, reduceIdeal; |
---|
436 | matrix decompMx; |
---|
437 | map F; |
---|
438 | poly actCoeff; |
---|
439 | |
---|
440 | wt[nrs + nrt] = 1; |
---|
441 | basis = imap(RLAB, basis), imap(RLAB, actCoeff); |
---|
442 | action = imap(RLAB, action); |
---|
443 | decompMx = imap(RLAB, decompMx); |
---|
444 | actCoeff = imap(RLAB, actCoeff); |
---|
445 | G = imap(RLAB, G); |
---|
446 | attrib(G, "isSB", 1); |
---|
447 | reduceIdeal = imap(RLAB, reduceIdeal), actCoeff - var(nrs + nrt); |
---|
448 | |
---|
449 | // compute action on the new basis element |
---|
450 | |
---|
451 | for(k = 1; k <= nrs; k++) { F[k] = 0;} |
---|
452 | for(k = nrs + 1; k < nrs + nrt; k++) { F[k] = action[k - nrs];} |
---|
453 | actCoeff = reduce(F(actCoeff), G); |
---|
454 | action[ncols(action) + 1] = actCoeff; |
---|
455 | dbprint(dbPrt, " extend basering by " + string(var(nrs + nrt))); |
---|
456 | dbprint(dbPrt, " new basis = " + string(basis)); |
---|
457 | dbprint(dbPrt, " action of G on new basis element = " |
---|
458 | + string(actCoeff)); |
---|
459 | dbprint(dbPrt, " decomp : " + string(decompMx[2, j]) + " -> " |
---|
460 | + string(var(nrs + nrt))); |
---|
461 | } // end if |
---|
462 | else { |
---|
463 | dbprint(dbPrt, " the polynomial " + string(actCoeff) |
---|
464 | + " is a linear combination of the elements of basis"); |
---|
465 | } |
---|
466 | } // end for |
---|
467 | reduceIdeal = std(reduceIdeal); |
---|
468 | action[i] = reduce(action[i], reduceIdeal); |
---|
469 | } // end else |
---|
470 | if(i < ncols(action)) { i++;} |
---|
471 | else {loop = 0;} |
---|
472 | } // end while |
---|
473 | if(defined(actionid)) { kill actionid; } |
---|
474 | ideal actionid, embedid, groupid; |
---|
475 | actionid = action; |
---|
476 | embedid = basis; |
---|
477 | groupid = G; |
---|
478 | export actionid, embedid, groupid; |
---|
479 | dbprint(dbPrt+1, " |
---|
480 | // 'LinearizeAction' created a new ring. |
---|
481 | // To see the ring, type (if the name 'R' was assigned to the return value): |
---|
482 | show(R); |
---|
483 | // To access the new action and the equivariant embedding, type |
---|
484 | setring R; actionid; embedid; groupid |
---|
485 | "); |
---|
486 | setring altring; |
---|
487 | return(RLAR); |
---|
488 | } |
---|
489 | example |
---|
490 | {"EXAMPLE:"; echo = 2; |
---|
491 | ring B = 0,(s(1..5), t(1..3)),dp; |
---|
492 | ideal G = s(3)-s(4), s(2)-s(5), s(4)*s(5), s(1)^2*s(4)+s(1)^2*s(5)-1, s(1)^2*s(5)^2-s(5), s(4)^4-s(5)^4+s(1)^2, s(1)^4+s(4)^3-s(5)^3, s(5)^5-s(1)^2*s(5); |
---|
493 | ideal action = -s(4)*t(1)+s(5)*t(1), -s(4)^2*t(2)+2*s(4)^2*t(3)^2+s(5)^2*t(2), s(4)*t(3)+s(5)*t(3); |
---|
494 | LinearActionQ(action, 5); |
---|
495 | def R = LinearizeAction(G, action, 5); |
---|
496 | setring R; |
---|
497 | R; |
---|
498 | actionid; |
---|
499 | embedid; |
---|
500 | groupid; |
---|
501 | LinearActionQ(actionid, 5); |
---|
502 | } |
---|
503 | |
---|
504 | /////////////////////////////////////////////////////////////////////////////// |
---|
505 | |
---|
506 | proc LinearActionQ(Gaction, int nrs) |
---|
507 | "USAGE: LinearActionQ(action,nrs); ideal action, int nrs |
---|
508 | PURPOSE: check whether the action defined by 'action' is linear w.r.t. the |
---|
509 | variables var(nrs + 1...nvars(basering)). |
---|
510 | RETURN: 0 action not linear |
---|
511 | 1 action is linear |
---|
512 | EXAMPLE: example LinearActionQ; shows an example |
---|
513 | " |
---|
514 | { |
---|
515 | int i, nrt, loop; |
---|
516 | intvec wt; |
---|
517 | |
---|
518 | nrt = ncols(Gaction); |
---|
519 | for(i = 1; i <= nrs; i++) { wt[i] = 0;} |
---|
520 | for(i = nrs + 1; i <= nrs + nrt; i++) { wt[i] = 1;} |
---|
521 | loop = 1; |
---|
522 | i = 1; |
---|
523 | while(loop) |
---|
524 | { |
---|
525 | if(deg(Gaction[i], wt) > 1) { loop = 0; } |
---|
526 | else |
---|
527 | { |
---|
528 | i++; |
---|
529 | if(i > ncols(Gaction)) { loop = 0;} |
---|
530 | } |
---|
531 | } |
---|
532 | return(i > ncols(Gaction)); |
---|
533 | } |
---|
534 | example |
---|
535 | {"EXAMPLE:"; echo = 2; |
---|
536 | ring R = 0,(s(1..5), t(1..3)),dp; |
---|
537 | ideal G = s(3)-s(4), s(2)-s(5), s(4)*s(5), s(1)^2*s(4)+s(1)^2*s(5)-1, |
---|
538 | s(1)^2*s(5)^2-s(5), s(4)^4-s(5)^4+s(1)^2, s(1)^4+s(4)^3-s(5)^3, |
---|
539 | s(5)^5-s(1)^2*s(5); |
---|
540 | ideal Gaction = -s(4)*t(1)+s(5)*t(1), |
---|
541 | -s(4)^2*t(2)+2*s(4)^2*t(3)^2+s(5)^2*t(2), |
---|
542 | s(4)*t(3)+s(5)*t(3); |
---|
543 | LinearActionQ(Gaction, 5); |
---|
544 | LinearActionQ(Gaction, 8); |
---|
545 | } |
---|
546 | |
---|
547 | /////////////////////////////////////////////////////////////////////////////// |
---|
548 | |
---|
549 | proc LinearCombinationQ(ideal I, poly f) |
---|
550 | "USAGE: LinearCombination(I, f); ideal I, poly f |
---|
551 | PURPOSE: test whether f can be written as a linear combination of the generators of I. |
---|
552 | RETURN: 0 f is not a linear combination |
---|
553 | 1 f is a linear combination |
---|
554 | " |
---|
555 | { |
---|
556 | int i, loop, sizeJ; |
---|
557 | ideal J; |
---|
558 | |
---|
559 | J = I, f; |
---|
560 | sizeJ = size(J); |
---|
561 | |
---|
562 | def RLC = ImageVariety(ideal(0), J); // compute algebraic relations |
---|
563 | setring RLC; |
---|
564 | matrix coMx; |
---|
565 | poly relation = 0; |
---|
566 | |
---|
567 | loop = 1; |
---|
568 | i = 1; |
---|
569 | while(loop) |
---|
570 | { // look for a linear relation containing Y(nr) |
---|
571 | if(deg(imageid[i]) == 1) |
---|
572 | { |
---|
573 | coMx = coef(imageid[i], var(sizeJ)); |
---|
574 | if(coMx[1,1] == var(sizeJ)) |
---|
575 | { |
---|
576 | relation = imageid[i]; |
---|
577 | loop = 0; |
---|
578 | } |
---|
579 | } |
---|
580 | else |
---|
581 | { |
---|
582 | i++; |
---|
583 | if(i > ncols(imageid)) { loop = 0;} |
---|
584 | } |
---|
585 | } |
---|
586 | return(i <= ncols(imageid)); |
---|
587 | } |
---|
588 | |
---|
589 | /////////////////////////////////////////////////////////////////////////////// |
---|
590 | |
---|
591 | proc InvariantRing(ideal G, ideal action, list #) |
---|
592 | "USAGE: InvariantRing(G, Gact [, opt]); ideal G, Gact; int opt |
---|
593 | PURPOSE: compute generators of the invariant ring of G w.r.t. the action 'Gact' |
---|
594 | ASSUME: G is a finite group and 'Gact' is a linear action. |
---|
595 | RETURN: ring R; this ring comes with the ideals 'invars' and 'groupid' and |
---|
596 | with the poly 'newA': |
---|
597 | - 'invars' contains the algebra generators of the invariant ring |
---|
598 | - 'groupid' is the ideal of G in the new ring |
---|
599 | - 'newA' is the new representation of the primitive root of the |
---|
600 | minimal polynomial of the ring which was active when calling the |
---|
601 | procedure (if the minpoly did not change, 'newA' is set to 'a'). |
---|
602 | NOTE: the minimal polynomial of the output ring depends on some random |
---|
603 | choices |
---|
604 | EXAMPLE: example InvariantRing; shows an example |
---|
605 | " |
---|
606 | { |
---|
607 | int i, ok, dbPrt, noReynolds, primaryDec; |
---|
608 | ideal invarsGens, groupid; |
---|
609 | |
---|
610 | dbPrt = printlevel-voice+2; |
---|
611 | |
---|
612 | if(size(#) > 0) { primaryDec = #[1]; } |
---|
613 | else { primaryDec = 0; } |
---|
614 | |
---|
615 | dbprint(dbPrt, "InvariantRing of " + string(G)); |
---|
616 | dbprint(dbPrt, " action = " + string(action)); |
---|
617 | |
---|
618 | if(!attrib(G, "isSB")) { groupid = std(G);} |
---|
619 | else { groupid = G; } |
---|
620 | |
---|
621 | // compute the nullcone of G by means of Derksen's algorithm |
---|
622 | |
---|
623 | invarsGens = NullCone(groupid, action); // compute nullcone of linear action |
---|
624 | dbprint(dbPrt, " generators of zero-fibre ideal are " + string(invarsGens)); |
---|
625 | |
---|
626 | // make all generators of the nullcone invariant |
---|
627 | // if necessary, compute the Reynolds Operator, i.e., find all elements |
---|
628 | // of the variety defined by G. It might be necessary to extend the |
---|
629 | // ground field. |
---|
630 | |
---|
631 | def IRB = basering; |
---|
632 | if(defined(RIRR)) { kill RIRR;} |
---|
633 | def RIRR = basering; |
---|
634 | setring RIRR; |
---|
635 | // export(RIRR); |
---|
636 | // export(invarsGens); |
---|
637 | noReynolds = 1; |
---|
638 | dbprint(dbPrt, " nullcone is generated by " + string(size(invarsGens))); |
---|
639 | dbprint(dbPrt, " degrees = " + string(maxdeg(invarsGens))); |
---|
640 | for(i = 1; i <= ncols(invarsGens); i++){ |
---|
641 | ok = InvariantQ(invarsGens[i], groupid, action); |
---|
642 | if(ok) { dbprint(dbPrt, string(i) + ": poly " + string(invarsGens[i]) |
---|
643 | + " is invariant");} |
---|
644 | else { |
---|
645 | if(noReynolds) { |
---|
646 | |
---|
647 | // compute the Reynolds operator and change the ring ! |
---|
648 | noReynolds = 0; |
---|
649 | def RORN = ReynoldsOperator(groupid, action, primaryDec); |
---|
650 | setring RORN; |
---|
651 | ideal groupid = std(id); |
---|
652 | attrib(groupid, "isSB", 1); |
---|
653 | ideal action = actionid; |
---|
654 | setring RIRR; |
---|
655 | string parName, minPoly; |
---|
656 | if(npars(basering) == 0) { |
---|
657 | parName = "a"; |
---|
658 | minPoly = "0"; |
---|
659 | } |
---|
660 | else { |
---|
661 | parName = parstr(basering); |
---|
662 | minPoly = string(minpoly); |
---|
663 | } |
---|
664 | execute("ring RA1=0,(" + varstr(basering) + "," + parName + "), lp;"); |
---|
665 | if (minPoly!="0") { execute("ideal mpoly = std(" + minPoly + ");"); } |
---|
666 | ideal I = imap(RIRR,invarsGens); |
---|
667 | setring RORN; |
---|
668 | map Phi = RA1, maxideal(1); |
---|
669 | Phi[nvars(RORN) + 1] = newA; |
---|
670 | ideal invarsGens = Phi(I); |
---|
671 | kill Phi,RA1,RIRR; |
---|
672 | // end of ersetzt durch |
---|
673 | |
---|
674 | } |
---|
675 | dbprint(dbPrt, string(i) + ": poly " + string(invarsGens[i]) |
---|
676 | + " is NOT invariant"); |
---|
677 | invarsGens[i] = ReynoldsImage(ROelements, invarsGens[i]); |
---|
678 | dbprint(dbPrt, " --> " + string(invarsGens[i])); |
---|
679 | } |
---|
680 | } |
---|
681 | for(i = 1; i <= ncols(invarsGens); i++){ |
---|
682 | ok = InvariantQ(invarsGens[i], groupid, action); |
---|
683 | if(ok) { dbprint(dbPrt, string(i) + ": poly " + string(invarsGens[i]) |
---|
684 | + " is invariant"); } |
---|
685 | else { print(string(i) + ": Fatal Error with Reynolds ");} |
---|
686 | } |
---|
687 | if(noReynolds == 0) { |
---|
688 | def RIRS = RORN; |
---|
689 | setring RIRS; |
---|
690 | kill RORN; |
---|
691 | export groupid; |
---|
692 | } |
---|
693 | else { |
---|
694 | def RIRS = RIRR; |
---|
695 | kill RIRR; |
---|
696 | setring RIRS; |
---|
697 | export groupid; |
---|
698 | } |
---|
699 | ideal invars = invarsGens; |
---|
700 | kill invarsGens; |
---|
701 | if (defined(ROelements)) { kill ROelements,actionid,theZeroset,id; } |
---|
702 | export invars; |
---|
703 | dbprint(dbPrt+1, " |
---|
704 | // 'InvariantRing' created a new ring. |
---|
705 | // To see the ring, type (if the name 'R' was assigned to the return value): |
---|
706 | show(R); |
---|
707 | // To access the generators of the invariant ring type |
---|
708 | setring R; invars; |
---|
709 | // Note that the input group G is stored in R as the ideal 'groupid'; to |
---|
710 | // see it, type |
---|
711 | groupid; |
---|
712 | // Note that 'InvariantRing' might change the minimal polynomial |
---|
713 | // The representation of the algebraic number is given by 'newA' |
---|
714 | "); |
---|
715 | setring IRB; |
---|
716 | return(RIRS); |
---|
717 | } |
---|
718 | example |
---|
719 | {"EXAMPLE:"; echo = 2; |
---|
720 | ring B = 0, (s(1..2), t(1..2)), dp; |
---|
721 | ideal G = -s(1)+s(2)^3, s(1)^4-1; |
---|
722 | ideal action = s(1)*t(1), s(2)*t(2); |
---|
723 | |
---|
724 | def R = InvariantRing(std(G), action); |
---|
725 | setring R; |
---|
726 | invars; |
---|
727 | } |
---|
728 | |
---|
729 | /////////////////////////////////////////////////////////////////////////////// |
---|
730 | |
---|
731 | proc InvariantQ(poly f, ideal G, action) |
---|
732 | "USAGE: InvariantQ(f, G, action); poly f; ideal G, action |
---|
733 | PURPOSE: check whether the polynomial f is invariant w.r.t. G, where G acts via |
---|
734 | 'action' on K^m. |
---|
735 | ASSUME: basering = K[s_1,...,s_m,t_1,...,t_m] where K = Q of K = Q(a) and |
---|
736 | minpoly != 0, f contains only t_1,...,t_m, G is the ideal of an |
---|
737 | algebraic group and a standardbasis. |
---|
738 | RETURN: int; |
---|
739 | 0 if f is not invariant, |
---|
740 | 1 if f is invariant |
---|
741 | NOTE: G need not be finite |
---|
742 | " |
---|
743 | { |
---|
744 | def altring=basering; |
---|
745 | map F; |
---|
746 | if(deg(f) == 0) { return(1); } |
---|
747 | for(int i = 1; i <= size(action); i++) { |
---|
748 | F[nvars(basering) - size(action) + i] = action[i]; |
---|
749 | } |
---|
750 | return(reduce(f - F(f), G) == 0); |
---|
751 | } |
---|
752 | |
---|
753 | /////////////////////////////////////////////////////////////////////////////// |
---|
754 | |
---|
755 | proc MinimalDecomposition(poly f, int nrs, int nrt) |
---|
756 | "USAGE: MinimalDecomposition(f,a,b); poly f; int a, b. |
---|
757 | PURPOSE: decompose f as a sum M[1,1]*M[2,1] + ... + M[1,r]*M[2,r] where M[1,i] |
---|
758 | contains only s(1..a), M[2,i] contains only t(1...b) s.t. r is minimal |
---|
759 | ASSUME: f polynomial in K[s(1..a),t(1..b)], K = Q or K = Q(a) and minpoly != 0 |
---|
760 | RETURN: 2 x r matrix M s.t. f = M[1,1]*M[2,1] + ... + M[1,r]*M[2,r] |
---|
761 | EXAMPLE: example MinimalDecomposition; |
---|
762 | " |
---|
763 | { |
---|
764 | int i, sizeOfMx, changed, loop; |
---|
765 | list initialTerms; |
---|
766 | matrix coM1, coM2, coM, decompMx, auxM; |
---|
767 | matrix m[2][2] = 0,1,1,0; |
---|
768 | poly vars1, vars2; |
---|
769 | |
---|
770 | if(f == 0) { return(decompMx); } |
---|
771 | |
---|
772 | // first decompose f w.r.t. t(1..nrt) |
---|
773 | // then decompose f w.r.t. s(1..nrs) |
---|
774 | |
---|
775 | vars1 = RingVarProduct(nrs+1..nrt+nrs); |
---|
776 | vars2 = RingVarProduct(1..nrs); |
---|
777 | coM1 = SimplifyCoefficientMatrix(m*coef(f, vars1)); // exchange rows of decomposition |
---|
778 | coM2 = SimplifyCoefficientMatrix(coef(f, vars2)); |
---|
779 | if(ncols(coM2) < ncols(coM1)) { |
---|
780 | auxM = coM1; |
---|
781 | coM1 = coM2; |
---|
782 | coM2 = auxM; |
---|
783 | } |
---|
784 | decompMx = coM1; // decompMx is the smaller decomposition |
---|
785 | if(ncols(decompMx) == 1) { return(decompMx);} // n = 1 is minimal |
---|
786 | changed = 0; |
---|
787 | loop = 1; |
---|
788 | i = 1; |
---|
789 | |
---|
790 | // first loop, try coM1 |
---|
791 | |
---|
792 | while(loop) { |
---|
793 | coM = MinimalDecomposition(f - coM1[1, i]*coM1[2, i], nrs, nrt); |
---|
794 | if(size(coM) == 1) { sizeOfMx = 0; } // coM = 0 |
---|
795 | else {sizeOfMx = ncols(coM); } // number of columns |
---|
796 | if(sizeOfMx + 1 < ncols(decompMx)) { // shorter decomposition |
---|
797 | changed = 1; |
---|
798 | decompMx = coM; |
---|
799 | initialTerms[1] = coM1[1, i]; |
---|
800 | initialTerms[2] = coM1[2, i]; |
---|
801 | } |
---|
802 | if(sizeOfMx == 1) { loop = 0;} // n = 2 is minimal |
---|
803 | if(i < ncols(coM1)) {i++;} |
---|
804 | else {loop = 0;} |
---|
805 | } |
---|
806 | if(sizeOfMx > 1) { // n > 2 |
---|
807 | loop = 1; // coM2 might yield |
---|
808 | i = 1; // a smaller decomposition |
---|
809 | } |
---|
810 | |
---|
811 | // first loop, try coM2 |
---|
812 | |
---|
813 | while(loop) { |
---|
814 | coM = MinimalDecomposition(f - coM2[1, i]*coM2[2, i], nrs, nrt); |
---|
815 | if(size(coM) == 1) { sizeOfMx = 0; } |
---|
816 | else {sizeOfMx = ncols(coM); } |
---|
817 | if(sizeOfMx + 1 < ncols(decompMx)) { |
---|
818 | changed = 1; |
---|
819 | decompMx = coM; |
---|
820 | initialTerms[1] = coM2[1, i]; |
---|
821 | initialTerms[2] = coM2[2, i]; |
---|
822 | } |
---|
823 | if(sizeOfMx == 1) { loop = 0;} |
---|
824 | if(i < ncols(coM2)) {i++;} |
---|
825 | else {loop = 0;} |
---|
826 | } |
---|
827 | if(!changed) { return(decompMx); } |
---|
828 | if(size(decompMx) == 1) { matrix decompositionM[2][1];} |
---|
829 | else { matrix decompositionM[2][ncols(decompMx) + 1];} |
---|
830 | decompositionM[1, 1] = initialTerms[1]; |
---|
831 | decompositionM[2, 1] = initialTerms[2]; |
---|
832 | if(size(decompMx) > 1) { |
---|
833 | for(i = 1; i <= ncols(decompMx); i++) { |
---|
834 | decompositionM[1, i + 1] = decompMx[1, i]; |
---|
835 | decompositionM[2, i + 1] = decompMx[2, i]; |
---|
836 | } |
---|
837 | } |
---|
838 | return(decompositionM); |
---|
839 | } |
---|
840 | example |
---|
841 | {"EXAMPLE:"; echo = 2; |
---|
842 | ring R = 0, (s(1..2), t(1..2)), dp; |
---|
843 | poly h = s(1)*(t(1) + t(1)^2) + (t(2) + t(2)^2)*(s(1)^2 + s(2)); |
---|
844 | matrix M = MinimalDecomposition(h, 2, 2); |
---|
845 | M; |
---|
846 | M[1,1]*M[2,1] + M[1,2]*M[2,2] - h; |
---|
847 | } |
---|
848 | |
---|
849 | /////////////////////////////////////////////////////////////////////////////// |
---|
850 | |
---|
851 | proc NullCone(ideal G, action) |
---|
852 | "USAGE: NullCone(G, action); ideal G, action |
---|
853 | PURPOSE: compute the ideal of the nullcone of the linear action of G on K^n, |
---|
854 | given by 'action', by means of Deksen's algorithm |
---|
855 | ASSUME: basering = K[s(1..r),t(1..n)], K = Q or K = Q(a) and minpoly != 0, |
---|
856 | G is an ideal of a reductive algebraic group in K[s(1..r)], |
---|
857 | 'action' is a linear group action of G on K^n (n = ncols(action)) |
---|
858 | RETURN: ideal of the nullcone of G. |
---|
859 | NOTE: the generators of the nullcone are homogenous, but in general not invariant |
---|
860 | EXAMPLE: example NullCone; shows an example |
---|
861 | " |
---|
862 | { |
---|
863 | int i, nt, dbPrt, offset, groupVars; |
---|
864 | poly minPoly; |
---|
865 | string ringSTR, vars, order; |
---|
866 | def RNCB = basering; |
---|
867 | |
---|
868 | // prepare the ring needed for the computation |
---|
869 | // s(1...) variables of the group |
---|
870 | // t(1...) variables of the affine space |
---|
871 | // y(1...) additional 'slack' variables |
---|
872 | |
---|
873 | nt = size(action); |
---|
874 | order = "(dp(" + string(nvars(basering) - nt) + "), dp);"; |
---|
875 | vars = "(s(1.." + string(nvars(basering) - nt); |
---|
876 | vars = vars +"),t(1.."+string(nt) + "), Y(1.." + string(nt) + "))," + order; |
---|
877 | ringSTR = "ring RNCR = (" + charstr(basering) + ")," + vars; |
---|
878 | // ring for the computation |
---|
879 | |
---|
880 | minPoly = minpoly; |
---|
881 | offset = size(G) + nt; |
---|
882 | execute(ringSTR); |
---|
883 | def aaa=imap(RNCB, minPoly); |
---|
884 | if (aaa!=0) { minpoly = number(aaa); } |
---|
885 | ideal action, G, I, J, N, generators; |
---|
886 | map F; |
---|
887 | poly f; |
---|
888 | |
---|
889 | // built the ideal of the graph of GxV -> V, (s,v) -> s(v), i.e. |
---|
890 | // of the image of the map GxV -> GxVxV, (s,v) -> (s,v,s(v)) |
---|
891 | |
---|
892 | G = fetch(RNCB, G); |
---|
893 | action = fetch(RNCB, action); |
---|
894 | groupVars = nvars(basering) - 2*nt; |
---|
895 | offset = groupVars + nt; |
---|
896 | I = G; |
---|
897 | for(i = 1; i <= nt; i = i + 1) { |
---|
898 | I = I, var(offset + i) - action[i]; |
---|
899 | } |
---|
900 | |
---|
901 | J = std(I); // takes long, try to improve |
---|
902 | |
---|
903 | // eliminate |
---|
904 | |
---|
905 | N = nselect(J, 1.. groupVars); |
---|
906 | |
---|
907 | // substitute |
---|
908 | for(i = 1; i <= nvars(basering); i = i + 1) { F[i] = 0; } |
---|
909 | for(i = groupVars + 1; i <= offset; i = i + 1) { F[i] = var(i); } |
---|
910 | |
---|
911 | generators = mstd(F(N))[2]; |
---|
912 | setring RNCB; |
---|
913 | return(fetch(RNCR, generators)); |
---|
914 | } |
---|
915 | example |
---|
916 | {"EXAMPLE:"; echo = 2; |
---|
917 | ring R = 0, (s(1..2), x, y), dp; |
---|
918 | ideal G = -s(1)+s(2)^3, s(1)^4-1; |
---|
919 | ideal action = s(1)*x, s(2)*y; |
---|
920 | |
---|
921 | ideal inv = NullCone(G, action); |
---|
922 | inv; |
---|
923 | } |
---|
924 | |
---|
925 | /////////////////////////////////////////////////////////////////////////////// |
---|
926 | |
---|
927 | proc ReynoldsOperator(ideal Grp, ideal Gaction, list #) |
---|
928 | "USAGE: ReynoldsOperator(G, action [, opt]); ideal G, action; int opt |
---|
929 | PURPOSE: compute the Reynolds operator of the group G which acts via 'action' |
---|
930 | RETURN: polynomial ring R over a simple extension of the ground field of the |
---|
931 | basering (the extension might be trivial), containing a list |
---|
932 | 'ROelements', the ideals 'id', 'actionid' and the polynomial 'newA'. |
---|
933 | R = K(a)[s(1..r),t(1..n)]. |
---|
934 | - 'ROelements' is a list of ideals, each ideal represents a |
---|
935 | substitution map F : R -> R according to the zero-set of G |
---|
936 | - 'id' is the ideal of G in the new ring |
---|
937 | - 'newA' is the new representation of a' in terms of a. If the |
---|
938 | basering does not contain a parameter then 'newA' = 'a'. |
---|
939 | ASSUME: basering = K[s(1..r),t(1..n)], K = Q or K = Q(a') and minpoly != 0, |
---|
940 | G is the ideal of a finite group in K[s(1..r)], 'action' is a linear |
---|
941 | group action of G |
---|
942 | " |
---|
943 | { |
---|
944 | def ROBR = basering; |
---|
945 | int i, j, n, ns, primaryDec; |
---|
946 | ideal G1 = Grp; |
---|
947 | list solution, saction; |
---|
948 | string str; |
---|
949 | |
---|
950 | if(size(#) > 0) { primaryDec = #[1]; } |
---|
951 | else { primaryDec = 0; } |
---|
952 | kill #; |
---|
953 | |
---|
954 | n = nvars(basering); |
---|
955 | ns = n - size(Gaction); |
---|
956 | for(i = ns + 1; i <= n; i++) { G1 = G1, var(i);} |
---|
957 | |
---|
958 | def RORR = zeroSet(G1, primaryDec); |
---|
959 | setring ROBR; |
---|
960 | string parName, minPoly; |
---|
961 | if(npars(basering) == 0) { |
---|
962 | parName = "a"; |
---|
963 | minPoly = "0"; |
---|
964 | } |
---|
965 | else { |
---|
966 | parName = parstr(basering); |
---|
967 | minPoly = string(minpoly); |
---|
968 | } |
---|
969 | execute("ring RA1=0,(" + varstr(basering) + "," + parName + "), lp;"); |
---|
970 | if (minPoly!="0") { execute("ideal mpoly = std(" + minPoly + ");"); } |
---|
971 | ideal Grp = imap(ROBR,Grp); |
---|
972 | ideal Gaction = imap(ROBR,Gaction); |
---|
973 | setring RORR; |
---|
974 | map Phi = RA1, maxideal(1); |
---|
975 | Phi[nvars(RORR) + 1] = newA; |
---|
976 | id = Phi(Grp); // id already defined by zeroSet of level 0 |
---|
977 | ideal actionid = Phi(Gaction); |
---|
978 | kill parName,minPoly,Phi,RA1; |
---|
979 | // end of ersetzt durch |
---|
980 | list ROelements; |
---|
981 | ideal Rf; |
---|
982 | map groupElem; |
---|
983 | poly h1, h2; |
---|
984 | |
---|
985 | for(i = 1; i <= size(theZeroset); i++) { |
---|
986 | groupElem = theZeroset[i]; // element of G |
---|
987 | for(j = ns + 1; j<=n; j++) { groupElem[j] = var(j); } //do not change t's |
---|
988 | for(j = 1; j <= n - ns; j++) { |
---|
989 | h1 = actionid[j]; |
---|
990 | h2 = groupElem(h1); |
---|
991 | Rf[ns + j] = h2; |
---|
992 | } |
---|
993 | ROelements[i] = Rf; |
---|
994 | } |
---|
995 | export actionid, ROelements; |
---|
996 | setring ROBR; |
---|
997 | return(RORR); |
---|
998 | } |
---|
999 | |
---|
1000 | /////////////////////////////////////////////////////////////////////////////// |
---|
1001 | |
---|
1002 | proc ReynoldsImage(list reynoldsOp, poly f) |
---|
1003 | "USAGE: ReynoldsImage(RO, f); list RO, poly f |
---|
1004 | PURPOSE: compute the Reynolds image of the polynomial f, where RO represents |
---|
1005 | the Reynolds operator |
---|
1006 | RETURN: poly |
---|
1007 | " |
---|
1008 | { |
---|
1009 | def RIBR=basering; |
---|
1010 | map F; |
---|
1011 | poly h = 0; |
---|
1012 | |
---|
1013 | for(int i = 1; i <= size(reynoldsOp); i++) { |
---|
1014 | F = RIBR, reynoldsOp[i]; |
---|
1015 | h = h + F(f); |
---|
1016 | } |
---|
1017 | return(h/size(reynoldsOp)); |
---|
1018 | } |
---|
1019 | |
---|
1020 | /////////////////////////////////////////////////////////////////////////////// |
---|
1021 | |
---|
1022 | static proc SimplifyCoefficientMatrix(matrix coefMatrix) |
---|
1023 | "USAGE: SimplifyCoefficientMatrix(M); M matrix coming from coef(...) |
---|
1024 | PURPOSE: simplify the matrix, i.e. find linear dependencies among the columns |
---|
1025 | RETURN: matrix M, f = M[1,1]*M[2,1] + ... + M[1,n]*M[2,n] |
---|
1026 | " |
---|
1027 | { |
---|
1028 | int i, j , loop; |
---|
1029 | intvec columnList; |
---|
1030 | matrix decompMx = coefMatrix; |
---|
1031 | |
---|
1032 | loop = 1; |
---|
1033 | i = 1; |
---|
1034 | while(loop) { |
---|
1035 | columnList = 1..i; // current column |
---|
1036 | for(j = i + 1; j <= ncols(decompMx); j++) { |
---|
1037 | // test if decompMx[2, j] equals const * decompMx[2, i] |
---|
1038 | if(LinearCombinationQ(ideal(decompMx[2, i]), decompMx[2, j])) { // column not needed |
---|
1039 | decompMx[1, i] = decompMx[1, i] + decompMx[2, j] / decompMx[2, i] * decompMx[1, j]; |
---|
1040 | } |
---|
1041 | else { columnList[size(columnList) + 1] = j; } |
---|
1042 | } |
---|
1043 | if(defined(auxM)) { kill auxM;} |
---|
1044 | matrix auxM[2][size(columnList)]; // built new matrix and omit |
---|
1045 | for(j = 1; j <= size(columnList); j++) { // the linear dependent colums |
---|
1046 | auxM[1, j] = decompMx[1, columnList[j]]; // found above |
---|
1047 | auxM[2, j] = decompMx[2, columnList[j]]; |
---|
1048 | } |
---|
1049 | decompMx = auxM; |
---|
1050 | if(i < ncols(decompMx) - 1) { i++;} |
---|
1051 | else { loop = 0;} |
---|
1052 | } |
---|
1053 | return(decompMx); |
---|
1054 | } |
---|
1055 | |
---|
1056 | /////////////////////////////////////////////////////////////////////////////// |
---|
1057 | |
---|
1058 | proc SimplifyIdeal(ideal I, list #) |
---|
1059 | "USAGE: SimplifyIdeal(I [,m, name]); ideal I; int m, string name" |
---|
1060 | PURPOSE: simplify ideal I to the ideal I', do not change the names of the |
---|
1061 | first m variables, new ideal I' might contain less variables. |
---|
1062 | I' contains variables var(1..m) |
---|
1063 | RETURN: list |
---|
1064 | _[1] ideal I' |
---|
1065 | _[2] ideal representing a map phi to a ring with probably less vars. s.th. |
---|
1066 | phi(I) = I' |
---|
1067 | _[3] list of variables |
---|
1068 | _[4] list from 'elimpart' |
---|
1069 | " |
---|
1070 | { |
---|
1071 | int i, k, m; |
---|
1072 | string nameCMD; |
---|
1073 | ideal mId, In, mapId; // ideal for the map |
---|
1074 | list sList, result; |
---|
1075 | |
---|
1076 | sList = elimpart(I); |
---|
1077 | In = sList[1]; |
---|
1078 | mapId = sList[5]; |
---|
1079 | |
---|
1080 | if(size(#) > 0) |
---|
1081 | { |
---|
1082 | m = #[1]; |
---|
1083 | nameCMD = #[2]; |
---|
1084 | } |
---|
1085 | else { m = 0;} // nvars(basering); |
---|
1086 | k = 0; |
---|
1087 | for(i = 1; i <= nvars(basering); i++) |
---|
1088 | { |
---|
1089 | if(sList[4][i] != 0) |
---|
1090 | { |
---|
1091 | k++; |
---|
1092 | if(k <= m) { mId[i] = sList[4][i]; } |
---|
1093 | else { execute("mId["+string(i) +"] = "+nameCMD+"("+string(k-m)+");");} |
---|
1094 | } |
---|
1095 | else { mId[i] = 0;} |
---|
1096 | } |
---|
1097 | map phi = basering, mId; |
---|
1098 | result[1] = phi(In); |
---|
1099 | result[2] = phi(mapId); |
---|
1100 | result[3] = simplify(sList[4], 2); |
---|
1101 | result[4] = sList; |
---|
1102 | return(result); |
---|
1103 | } |
---|
1104 | |
---|
1105 | /////////////////////////////////////////////////////////////////////////////// |
---|
1106 | |
---|
1107 | proc RingVarProduct(index) |
---|
1108 | // list of indices |
---|
1109 | { |
---|
1110 | poly f = 1; |
---|
1111 | for(int i = 1; i <= size(index); i++) |
---|
1112 | { |
---|
1113 | f = f * var(index[i]); |
---|
1114 | } |
---|
1115 | return(f); |
---|
1116 | } |
---|
1117 | /////////////////////////////////////////////////////////////////////////////// |
---|