1 | //////////////////////////////////////////////////////////////////////////////// |
---|
2 | version="version autgradalg.lib 4.1.1.1 Feb_2018 "; // $Id$ |
---|
3 | category="Commutative Algebra, Algebraic Geometry"; |
---|
4 | info=" |
---|
5 | LIBRARY: autgradalg.lib Compute automorphism groups of pointedly graded algebras and of Mori dream spaces. |
---|
6 | |
---|
7 | AUTHORS: Simon Keicher |
---|
8 | |
---|
9 | OVERVIEW: This library provides a framework for computing automorphisms of integral, finitely generated algebras that are graded by a finitely generated abelian group. This library also contains functions to compute automorphism groups of Mori dream spaces. The results are ideals I such that the respective automorphism group is isomorphic to the subgroup V(I) in some GL(n). |
---|
10 | |
---|
11 | ASSUMPTIONS: |
---|
12 | * the algebra R is given as factor algebra S/I with a graded polynomial ring S = KK[T_1,...,T_r]. We will always assume that the basering is S and it is given over the rationals QQ or a number field QQ(a). |
---|
13 | * R must be minimally presented, i.e., I is contained in <T_1,...,T_r>^2. |
---|
14 | * S (and hence R) are graded via 'setBaseMultigrading(Q)' from 'multigrading.lib'. The last rows of the matrix Q are interpreted over ZZ/a_iZZ if the respective entry of the list TOR is a_i and has been provided as parameter to the respective function. (See the functions for more details.) |
---|
15 | * For all 1 <= i <= r: I_{w_i} = 0 where w_i := deg(T_i). |
---|
16 | * the grading is pointed, i.e., no generator has degree 0 and the cone over all generator degrees is pointed. |
---|
17 | * For Mori dream spaces X, we assume them to be given as X = X(R,w) with the Cox ring R of X (given as the algebra R before) and an ample class w in the grading group K with the torsion entries removed. |
---|
18 | |
---|
19 | NOTE: we require the user to execute 'LIB'gfanlib.so'' before using this library. |
---|
20 | |
---|
21 | PROCEDURES: |
---|
22 | autKS(): compute the automorphism group of the basering (must be a polynomial ring) as an algebraic subgroup V(I) of some GL(n) |
---|
23 | autGradAlg(I0, TOR): compute the automorphism group of R as an algebraic subgroup V(I) of some GL(n). |
---|
24 | autGenWeights(): compute the automorphisms of the grading group that fix the generator degrees. |
---|
25 | stabilizer(I0, TOR): compute the stabilizer of the given ideal |
---|
26 | autXhat(I0, w, TOR): compute the automorphism group of \widehat X as an algebraic subgroup V(I) of some GL(n). |
---|
27 | autX(I0, w, TOR): compute the automorphism group of X=X(R,w) as an algebraic subgroup V(I) of some GL(n). |
---|
28 | |
---|
29 | NOTE: the following functions were taken from 'quotsingcox.lib' by M.Donten-Bury and S.Keicher: 'hilbertBas'. |
---|
30 | NOTE: This library comes without any warranty whatsoever. Use it at your own risk. |
---|
31 | |
---|
32 | KEYWORDS: automorphisms; graded algebra; Mori dream spaces; automorphism group; symmetries |
---|
33 | "; |
---|
34 | |
---|
35 | /* Printlevel settings: |
---|
36 | * 0: Silent mode |
---|
37 | * >0: Show status information |
---|
38 | */ |
---|
39 | |
---|
40 | //Included libraries |
---|
41 | LIB "multigrading.lib"; |
---|
42 | LIB "gitfan.lib"; |
---|
43 | LIB "normaliz.lib"; |
---|
44 | |
---|
45 | //////////////////////// |
---|
46 | |
---|
47 | static proc col(intmat Q, int i) |
---|
48 | "USAGE: col(Q, i): Q is an intmat, i an integer. |
---|
49 | PURPOSE: return the i-th column as an intvec. |
---|
50 | RETURN: an intvec. |
---|
51 | EXAMPLE: shows an example." |
---|
52 | { |
---|
53 | return(intvec(Q[1..nrows(Q),i])); |
---|
54 | } |
---|
55 | example |
---|
56 | { |
---|
57 | echo=2; |
---|
58 | |
---|
59 | intmat Q[2][4] = |
---|
60 | -2, 2, -1, 1, |
---|
61 | 1, 1, 1, 1; |
---|
62 | |
---|
63 | col(Q, 2); |
---|
64 | } |
---|
65 | |
---|
66 | /////////////////////// |
---|
67 | |
---|
68 | static proc gradedCompIdeal(ideal RL, intvec w, int dd, list #) |
---|
69 | "USAGE: gradedCompIdeal(I, w, dd): I is an ideal, w an intvec, dd an integer (0 or 1). Optional input: a list of integers representing the torsion. |
---|
70 | ASSUME: the basering must be graded (see setBaseMultigrading()) and the cone over the degrees of the variables must be pointed; there must not be 0-degrees. The vector w must be an element of the cone over the degrees of the variables. |
---|
71 | PURPOSE: returns a basis for the component I_w of the ideal; if dd = 0, a list of basis vectors is returned, if dd = 1, a list of monomials is returned. |
---|
72 | RETURN: a list L where L[1] is a list of all monomials of degree w and L[2] is list of polynomials. |
---|
73 | EXAMPLE: shows an example." |
---|
74 | { |
---|
75 | list TOR; |
---|
76 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
77 | TOR = #[1]; |
---|
78 | } |
---|
79 | |
---|
80 | // columns of Q are the degrees of the variables of the basering |
---|
81 | intmat Q = getVariableWeights(); |
---|
82 | |
---|
83 | // compute all monomials of degree w: |
---|
84 | dbprint(printlevel, "wmonomials..."); |
---|
85 | list MON = wmonomials(w, 0, TOR); |
---|
86 | dbprint(printlevel, "...done"); |
---|
87 | |
---|
88 | list Iw0 = gradedCompIdeal2basevecs(w, Q, RL, MON, TOR); |
---|
89 | |
---|
90 | if(size(Iw0) == 0){ |
---|
91 | list L; |
---|
92 | L[1] = MON; |
---|
93 | L[2] = list(); |
---|
94 | return(L); |
---|
95 | } |
---|
96 | |
---|
97 | // Choose a maximal linearly independent |
---|
98 | // subset out of the elemnts of Iw0: |
---|
99 | // Iteratively add columns from Tmp: |
---|
100 | int rg1 = 0; |
---|
101 | int rg2 = 0; |
---|
102 | |
---|
103 | list Tmp; |
---|
104 | Tmp[1] = Iw0[1]; |
---|
105 | |
---|
106 | for(int m = 2; m <= size(Iw0); m++){ |
---|
107 | matrix IwTmp[size(Tmp)+1][size(MON)]; |
---|
108 | |
---|
109 | for(int j = 1; j <= size(Tmp); j++){ |
---|
110 | IwTmp[j,1..size(MON)] = Tmp[j]; |
---|
111 | } |
---|
112 | |
---|
113 | // add the new column: |
---|
114 | IwTmp[size(Tmp)+1,1..size(MON)] = Iw0[m]; |
---|
115 | |
---|
116 | rg1 = rg2; |
---|
117 | rg2 = rank(IwTmp); |
---|
118 | |
---|
119 | if(rg1 < rg2){ |
---|
120 | Tmp[size(Tmp)+1] = Iw0[m]; |
---|
121 | } |
---|
122 | |
---|
123 | kill IwTmp, j; |
---|
124 | } |
---|
125 | |
---|
126 | list Iw = Tmp; |
---|
127 | list L; // will be returned |
---|
128 | L[1] = MON; |
---|
129 | |
---|
130 | // translate back to polynomials unless 'basevecs' specified: |
---|
131 | if(dd == 0){ |
---|
132 | L[2] = Iw; |
---|
133 | return(L); |
---|
134 | } |
---|
135 | |
---|
136 | matrix MONmat[1][size(MON)] = MON[1..size(MON)]; |
---|
137 | matrix Iwmat[size(Iw)][size(MON)]; |
---|
138 | |
---|
139 | for(m = 1; m <= size(Iw); m++){ |
---|
140 | matrix BB = Iw[m]; // has only one column |
---|
141 | Iwmat[m, 1..size(MON)] = BB[1..nrows(BB), 1]; |
---|
142 | |
---|
143 | kill BB; |
---|
144 | } |
---|
145 | |
---|
146 | matrix Iwmons = Iwmat * transpose(MONmat); |
---|
147 | list Iwmonslist = Iwmons[1..nrows(Iwmons),1]; |
---|
148 | L[2] = Iwmonslist; |
---|
149 | |
---|
150 | return(L); |
---|
151 | } |
---|
152 | example |
---|
153 | { |
---|
154 | echo = 2; |
---|
155 | |
---|
156 | // 1st example ///////// |
---|
157 | // example with torsion: ZZ + ZZ/5ZZ: |
---|
158 | intmat Q[2][5] = |
---|
159 | 1,1,1,1,1, |
---|
160 | 2,3,1,4,0; |
---|
161 | |
---|
162 | list TOR = 5; |
---|
163 | ring R = 0,T(1..5),dp; |
---|
164 | |
---|
165 | // attach degree matrix Q to R: |
---|
166 | setBaseMultigrading(Q); |
---|
167 | |
---|
168 | ideal I = T(1)*T(2) + T(3)*T(4) + T(5)^2; |
---|
169 | intvec w = 3,1; |
---|
170 | |
---|
171 | // as list of polynomials: |
---|
172 | list Lpol = gradedCompIdeal(I, w, 1, TOR); |
---|
173 | Lpol; |
---|
174 | |
---|
175 | kill R, w, Q, TOR; |
---|
176 | |
---|
177 | // 2nd example ///////// |
---|
178 | ring R = 0, T(1..4), dp; |
---|
179 | |
---|
180 | // Weights of variables |
---|
181 | intmat Q[2][4] = |
---|
182 | -2, 2, -1, 1, |
---|
183 | 1, 1, 1, 1; |
---|
184 | |
---|
185 | // attach degree matrix Q to R: |
---|
186 | setBaseMultigrading(Q); |
---|
187 | |
---|
188 | ideal I = T(1)*T(2) + T(3)*T(4); |
---|
189 | intvec w = 0,2; |
---|
190 | |
---|
191 | // as basis vectors in \KK^n: |
---|
192 | list Lbas = gradedCompIdeal(I, w, 0); |
---|
193 | Lbas; |
---|
194 | |
---|
195 | // as list of polynomials: |
---|
196 | list Lpol = gradedCompIdeal(I, w, 1); |
---|
197 | Lpol; |
---|
198 | |
---|
199 | kill w, I, R, Q; |
---|
200 | |
---|
201 | // 3rd example ///////// |
---|
202 | // torsion, parameter and 2 generators: |
---|
203 | intmat Q[3][6] = |
---|
204 | 1,1,1,1,1,1, |
---|
205 | -1,1,1,-1,0,0, |
---|
206 | 0,0,1,1,1,0; |
---|
207 | |
---|
208 | list TOR = 2; // means CL(X) = ZZ + ZZ/TOR[1]*ZZ + ... |
---|
209 | |
---|
210 | //int lam = 13; |
---|
211 | ring R = (0,lam),T(1..6),dp; |
---|
212 | |
---|
213 | // attach degree matrix Q to R: |
---|
214 | setBaseMultigrading(Q); |
---|
215 | |
---|
216 | ideal I = |
---|
217 | T(1)*T(2) + T(3)*T(4) + T(5)^2, |
---|
218 | lam*T(3)*T(4) + T(5)^2 + T(6)^2; |
---|
219 | |
---|
220 | intvec w = 2,0,0; |
---|
221 | gradedCompIdeal(I, w, 1, TOR); |
---|
222 | } |
---|
223 | |
---|
224 | /////////////////////////////////// |
---|
225 | |
---|
226 | // helper |
---|
227 | // returns a list of matrices over the coeff. ring of the basering |
---|
228 | // see also the subsequent example. |
---|
229 | static proc gradedCompIdeal2basevecs(intvec w, intmat Q, ideal RL, list MON, list #){ |
---|
230 | list TOR; |
---|
231 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
232 | TOR = #[1]; |
---|
233 | } |
---|
234 | |
---|
235 | list RLw = gradedCompIdealhelper(w, Q, RL, TOR); |
---|
236 | list EL; |
---|
237 | |
---|
238 | for(int j = 1; j <= size(RLw); j++){ |
---|
239 | // translate e.g. T[1]^3-T[1]*T[2]^2 to e_1-e_3 |
---|
240 | // if T[1]^3 is the 1st entry and T[1]*T[2]^2 the 3rd entry |
---|
241 | // store then 1 in v[...] and -1 in v[...]: |
---|
242 | matrix v[1][size(MON)] = 0:size(MON); // Elements are in the coef-ring |
---|
243 | |
---|
244 | for(int k = 1; k <= size(MON); k++){ |
---|
245 | v[k,1] = moncoef(RLw[j], MON[k]); // Note: it is v[k,1], not v[1,k]. |
---|
246 | } |
---|
247 | |
---|
248 | EL[size(EL)+1] = v; |
---|
249 | |
---|
250 | kill v, k; |
---|
251 | } |
---|
252 | |
---|
253 | return(EL); |
---|
254 | } |
---|
255 | example |
---|
256 | { |
---|
257 | echo=2; |
---|
258 | |
---|
259 | ring R = 0, T(1..4), dp; |
---|
260 | |
---|
261 | // Weights of variables |
---|
262 | intmat Q[2][4] = |
---|
263 | -2, 2, -1, 1, |
---|
264 | 1, 1, 1, 1; |
---|
265 | |
---|
266 | // attach degree matrix Q to R: |
---|
267 | setBaseMultigrading(Q); |
---|
268 | |
---|
269 | ideal I = T(1)*T(2) + T(3)*T(4); |
---|
270 | |
---|
271 | intvec w = 0,4; |
---|
272 | list MON = wmonomials(w, 0); |
---|
273 | MON; |
---|
274 | gradedCompIdeal2basevecs(w, Q, I, MON); |
---|
275 | } |
---|
276 | |
---|
277 | ///////////////////////////////////// |
---|
278 | |
---|
279 | // helper |
---|
280 | // |
---|
281 | // Returns vector space generators for all polynomials of degree w |
---|
282 | // by shifting the generators in RL to degree w by a monomial. |
---|
283 | // |
---|
284 | // Returns a list of polynomials. |
---|
285 | // |
---|
286 | static proc gradedCompIdealhelper(intvec w, intmat Q, ideal RL, list #){ |
---|
287 | |
---|
288 | list TOR; |
---|
289 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
290 | TOR = #[1]; |
---|
291 | } |
---|
292 | |
---|
293 | list RLw; |
---|
294 | cone cQ = coneViaPoints(transpose(Q)); |
---|
295 | |
---|
296 | for(int i = 1; i <= size(RL); i++){ |
---|
297 | // shift RL[i] to deg w by multiplication with T^delta |
---|
298 | intvec delta = reduceIntvec(w - multiDeg(RL[i]), TOR); |
---|
299 | |
---|
300 | if(delta == intvec(0:size(w))){ |
---|
301 | RLw[size(RLw)+1] = RL[i]; |
---|
302 | } else { |
---|
303 | // if delta is not in cQ, then there is no monomial of this degree: |
---|
304 | if(containsInSupport(cQ, delta)){ |
---|
305 | // calculate all monomials of degree delta |
---|
306 | list deltaMON = wmonomials(delta, 0, TOR); |
---|
307 | |
---|
308 | for(int k = 1; k <= size(deltaMON); k++){ |
---|
309 | poly m = deltaMON[k]; |
---|
310 | RLw[size(RLw)+1] = RL[i] * m; |
---|
311 | |
---|
312 | kill m; |
---|
313 | } |
---|
314 | |
---|
315 | kill k; |
---|
316 | } |
---|
317 | } |
---|
318 | |
---|
319 | kill delta; |
---|
320 | } |
---|
321 | |
---|
322 | return(RLw); |
---|
323 | } |
---|
324 | example |
---|
325 | { |
---|
326 | echo=2; |
---|
327 | |
---|
328 | ring R = 0, T(1..4), dp; |
---|
329 | |
---|
330 | // Weights of variables |
---|
331 | intmat Q[2][4] = |
---|
332 | -2, 2, -1, 1, |
---|
333 | 1, 1, 1, 1; |
---|
334 | |
---|
335 | // attach degree matrix Q to R: |
---|
336 | setBaseMultigrading(Q); |
---|
337 | |
---|
338 | ideal I = T(1)*T(2) + T(3)*T(4); |
---|
339 | |
---|
340 | intvec w = 0,4; |
---|
341 | gradedCompIdealhelper(w, Q, I); |
---|
342 | } |
---|
343 | |
---|
344 | /////////////////////////////////// |
---|
345 | |
---|
346 | static proc wmonomials(intvec w1, int dd, list #) |
---|
347 | "USAGE: wmonomials(w, dd): w is an intvec and dd either 1 or 0; 1 means that the funtion should compute a list of exponent vectors and 0 means the function should compute a list of monomials. As an optional third argument a list of integers may be provided to indicate that the last rows of the degree matrix are residue classes in ZZ/aZZ. For instance [2,3] means that the second to last row consists of elements in ZZ/2ZZ and the last one of elements in ZZ/3ZZ. |
---|
348 | ASSUME: the basering must be graded (see setBAseMultigrading()) and the cone over |
---|
349 | the degrees of the variables must be pointed; there mustn't be 0-degrees. |
---|
350 | PURPOSE: computes all monomials T^\nu with deg(T^\nu) = w where |
---|
351 | the degree of the i-th variable of the basering is assumed to have |
---|
352 | RETURN: a list of monomials or a list of their exponent vectors if a second argument is provided (an integer). |
---|
353 | EXAMPLE: shows an example." |
---|
354 | { |
---|
355 | intmat Qfull = getVariableWeights(); |
---|
356 | |
---|
357 | // check whether a torsion list is given: |
---|
358 | list TOR; |
---|
359 | |
---|
360 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
361 | TOR = #[1]; |
---|
362 | |
---|
363 | // cut off the degree matrix (i.e., the free part): |
---|
364 | intmat Q[nrows(Qfull) - size(TOR)][ncols(Qfull)]; |
---|
365 | |
---|
366 | for(int i = 1; i <= nrows(Q); i++){ |
---|
367 | Q[i, 1..ncols(Q)] = Qfull[i, 1..ncols(Q)]; |
---|
368 | } |
---|
369 | |
---|
370 | // cut off the free part w0 of w and store as bigintmat |
---|
371 | // for easier multiplication: |
---|
372 | intvec w0 = w1[1..size(w1)-size(TOR)]; |
---|
373 | bigintmat w[1][size(w0)] = w0[1..size(w1)]; |
---|
374 | kill i; |
---|
375 | |
---|
376 | } else { |
---|
377 | // deg(T_i) =... |
---|
378 | intmat Q = Qfull; |
---|
379 | |
---|
380 | // for easier multiplication: |
---|
381 | intvec w0 = w1; |
---|
382 | bigintmat w[1][size(w0)] = w0[1..size(w0)]; |
---|
383 | } |
---|
384 | |
---|
385 | // look for a bound for monomials: |
---|
386 | cone c = coneViaPoints(transpose(Q)); |
---|
387 | cone cd = dualCone(c); |
---|
388 | bigintmat v = transpose(relativeInteriorPoint(cd)); // 1 column |
---|
389 | |
---|
390 | // if dotprod(a,w) > dotprod(v,w), then |
---|
391 | // we need not consider T^a any more |
---|
392 | // --> gives a degree bound bnd: |
---|
393 | bigint bnd = (w * v)[1,1]; |
---|
394 | |
---|
395 | // traverse all possible exponents v_i of T_i: |
---|
396 | // i-th entry of BNDlist will be maximum exponent for T_i |
---|
397 | // such that the bound can still be satisfied. |
---|
398 | int r = nvars(basering); |
---|
399 | intvec BNDlist = 0:r; |
---|
400 | |
---|
401 | for(int i = 1; i <= r; i++){ |
---|
402 | int bndi = 1; |
---|
403 | intvec coli = col(Q, i); |
---|
404 | bigintmat vi[1][size(coli)] = coli[1..nrows(Q)]; |
---|
405 | |
---|
406 | while(((bndi * vi) * v)[1,1] < bnd){ |
---|
407 | bndi++; |
---|
408 | } |
---|
409 | |
---|
410 | BNDlist[i] = bndi; |
---|
411 | |
---|
412 | kill bndi, vi, coli; |
---|
413 | } |
---|
414 | |
---|
415 | // build up solutions recursively: |
---|
416 | // traverse all possible exponents |
---|
417 | // that still satisfy the bound condition |
---|
418 | // |
---|
419 | // NOTE: this is rather brute-force, |
---|
420 | // but its running time is dominated by the |
---|
421 | // other steps. |
---|
422 | list sol; |
---|
423 | list WL0 = wmonomialsRec(v, bnd, Q, BNDlist, sol); // candidates |
---|
424 | |
---|
425 | // - in case of no torsion: |
---|
426 | // select those ww out of WL0 with Q*ww = w0 |
---|
427 | // - if case of torsion: |
---|
428 | // select those ww out of WL0 with reduce(Q*ww) = w1 |
---|
429 | // where reduce() means to take the last elements mod TOR[i]: |
---|
430 | list WL; |
---|
431 | |
---|
432 | for(int m = 1; m <= size(WL0); m++){ |
---|
433 | list v0 = WL0[m]; |
---|
434 | intvec vv = v0[1..size(v0)]; |
---|
435 | //bigintmat vv[1][size(v0)] = v0[1..size(v0)]; |
---|
436 | |
---|
437 | if(size(TOR) == 0){ // free case |
---|
438 | if(Q * vv == w0){ |
---|
439 | WL[size(WL) + 1] = vv; |
---|
440 | } |
---|
441 | } else { // torsion case |
---|
442 | // reduce the last entries mod p: |
---|
443 | intvec Qvvred = Qfull * vv; |
---|
444 | intvec w1red = w1; |
---|
445 | int pos; |
---|
446 | |
---|
447 | for(int l = 1; l <= size(TOR); l++){ |
---|
448 | pos = nrows(Qfull) - size(TOR) + l; |
---|
449 | Qvvred[pos] = Qvvred[pos] mod TOR[l]; |
---|
450 | w1red[pos] = w1red[pos] mod TOR[l]; |
---|
451 | |
---|
452 | // make positive: e.g. -1 becomes 4 in ZZ/5ZZ: |
---|
453 | if(Qvvred[pos] < 0){ |
---|
454 | Qvvred[pos] = Qvvred[pos] + TOR[l]; |
---|
455 | } |
---|
456 | if(w1red[pos] < 0){ |
---|
457 | w1red[pos] = w1red[pos] + TOR[l]; |
---|
458 | } |
---|
459 | } |
---|
460 | |
---|
461 | if(Qvvred == w1red){ |
---|
462 | WL[size(WL) + 1] = vv; |
---|
463 | } |
---|
464 | |
---|
465 | kill pos, l, Qvvred, w1red; |
---|
466 | } |
---|
467 | |
---|
468 | kill vv, v0; |
---|
469 | } |
---|
470 | |
---|
471 | // output the list of exponentvectors if 2nd argument provided: |
---|
472 | if(dd == 1){ |
---|
473 | return(WL); |
---|
474 | } |
---|
475 | |
---|
476 | // otherwise: as monomials: |
---|
477 | list MONs; |
---|
478 | |
---|
479 | for(i = 1; i <= size(WL); i++){ |
---|
480 | MONs[size(MONs)+1] = vec2monomial(WL[i]); |
---|
481 | } |
---|
482 | |
---|
483 | return(MONs); |
---|
484 | } |
---|
485 | example |
---|
486 | { |
---|
487 | echo=2; |
---|
488 | |
---|
489 | // example with torsion: ZZ + ZZ/5ZZ: |
---|
490 | intmat Q[2][5] = |
---|
491 | 1,1,1,1,1, |
---|
492 | 2,3,1,4,0; |
---|
493 | |
---|
494 | list TOR = 5; |
---|
495 | ring R = 0,T(1..5),dp; |
---|
496 | |
---|
497 | // attach degree matrix Q to R: |
---|
498 | setBaseMultigrading(Q); |
---|
499 | |
---|
500 | ideal I = T(1)*T(2) + T(3)*T(4) + T(5)^2; |
---|
501 | intvec w = 2,0; |
---|
502 | wmonomials(w, 0, TOR); |
---|
503 | |
---|
504 | kill R, w, Q; |
---|
505 | |
---|
506 | ////////////////////// |
---|
507 | // free example: |
---|
508 | ring R = 0, T(1..4), dp; |
---|
509 | |
---|
510 | // Weights of variables |
---|
511 | intmat Q[2][4] = |
---|
512 | -2, 2, -1, 1, |
---|
513 | 1, 1, 1, 1; |
---|
514 | |
---|
515 | // attach degree matrix Q to R: |
---|
516 | setBaseMultigrading(Q); |
---|
517 | |
---|
518 | intvec w = 0,2; |
---|
519 | |
---|
520 | // as list of exponent vectors |
---|
521 | wmonomials(w, 1); |
---|
522 | |
---|
523 | // as list of monomials |
---|
524 | wmonomials(w, 0); |
---|
525 | } |
---|
526 | |
---|
527 | /////////////////////// |
---|
528 | |
---|
529 | // helper: |
---|
530 | // returns all vectors (without looking at w0, Q) with i-th entry at most BND[i] |
---|
531 | // but only those v0 with <v,v0> <= bnd for all i |
---|
532 | static proc wmonomialsRec(bigintmat v, bigint bnd, intmat Q, intvec BNDs, list sol){ |
---|
533 | int pos = size(sol) + 1; |
---|
534 | list Res; |
---|
535 | |
---|
536 | if(size(sol) == nvars(basering)){ |
---|
537 | return(list(sol)); |
---|
538 | } |
---|
539 | |
---|
540 | for(int i = 0; i <= BNDs[pos]; i++){ |
---|
541 | list sol0 = sol; |
---|
542 | sol0[pos] = i; |
---|
543 | |
---|
544 | list sol0tmp = sol; |
---|
545 | |
---|
546 | for(int k = 1; k <= nvars(basering)-size(sol); k++){ |
---|
547 | sol0tmp[size(sol)+k] = 0; |
---|
548 | } |
---|
549 | |
---|
550 | intvec v0tmp = sol0tmp[1 .. size(sol0tmp)]; |
---|
551 | intvec ivQv0tmp = Q*v0tmp; |
---|
552 | bigintmat Qv0tmp[1][size(ivQv0tmp)] = ivQv0tmp[1..size(ivQv0tmp)]; |
---|
553 | |
---|
554 | // this monmial will be too big to have degree w0: |
---|
555 | if((Qv0tmp * v)[1,1] > bnd){ |
---|
556 | return(list(sol0tmp)); |
---|
557 | } |
---|
558 | |
---|
559 | // otherwise: recurse |
---|
560 | list Res0 = wmonomialsRec(v, bnd, Q, BNDs, sol0); |
---|
561 | |
---|
562 | for(k = 1; k <= size(Res0); k++){ |
---|
563 | Res[size(Res)+1] = Res0[k]; |
---|
564 | } |
---|
565 | |
---|
566 | kill k, sol0, Res0, sol0tmp, v0tmp, ivQv0tmp, Qv0tmp; |
---|
567 | } |
---|
568 | |
---|
569 | return(Res); |
---|
570 | } |
---|
571 | |
---|
572 | ////////////////////////// |
---|
573 | |
---|
574 | // helper |
---|
575 | static proc vec2monomial(intvec v){ |
---|
576 | poly f = 1; |
---|
577 | |
---|
578 | for(int i = 1; i <= size(v); i++){ |
---|
579 | f = f * var(i)^v[i]; |
---|
580 | } |
---|
581 | |
---|
582 | return(f); |
---|
583 | } |
---|
584 | |
---|
585 | ////////////////////////// |
---|
586 | |
---|
587 | static proc moncoef(poly f, poly mon) |
---|
588 | "USAGE: moncoef(f, mon): f is a polynomial, mon a monomial. |
---|
589 | PURPOSE: returns the (constant) coefficient of mon in f. |
---|
590 | NOTE: the coefficient of T(1)^2 in T(1)^2*T(2) is assumed to be 1 not T(2). See moncoef2 of the latter is wanted. |
---|
591 | RETURN: a ring element. |
---|
592 | EXAMPLE: shows an example." |
---|
593 | { |
---|
594 | |
---|
595 | poly p = f; |
---|
596 | |
---|
597 | while (p != 0) { |
---|
598 | if( leadmonom(p) / mon != 0){ |
---|
599 | return(leadcoef(p)); |
---|
600 | } |
---|
601 | |
---|
602 | p = p - lead(p); |
---|
603 | } |
---|
604 | |
---|
605 | return(0); |
---|
606 | } |
---|
607 | example |
---|
608 | { |
---|
609 | echo=2; |
---|
610 | |
---|
611 | ring R = (0,a),T(1..4),dp; |
---|
612 | |
---|
613 | poly f = T(1)^2*T(2)^3 + 7*a*T(3)^3 -8*T(3)^2 +7; |
---|
614 | poly mon = T(3)^3; |
---|
615 | |
---|
616 | moncoef(f, mon); |
---|
617 | kill f, mon, R; |
---|
618 | |
---|
619 | // 2nd example |
---|
620 | ring R = 0,(T(1..3), Y(1..12)),dp; |
---|
621 | poly f = T(1)^2*Y(1)^2; |
---|
622 | poly m = T(1)^2; |
---|
623 | moncoef(f,m); |
---|
624 | } |
---|
625 | |
---|
626 | ///////////////////////////////// |
---|
627 | |
---|
628 | // helper |
---|
629 | // for autGenWeights, the case of torsion. |
---|
630 | static proc autGenWeightsTorsion(intmat Q, list TOR, list Origs, list OrigDim){ |
---|
631 | // cut off the torsion rows: |
---|
632 | intmat Q0[nrows(Q)-size(TOR)][ncols(Q)]; |
---|
633 | |
---|
634 | for(int i = 1; i <= nrows(Q) - size(TOR); i++){ |
---|
635 | Q0[i, 1..ncols(Q)] = Q[i, 1..ncols(Q)]; |
---|
636 | } |
---|
637 | |
---|
638 | // compute automorphisms B in AUT0 fixing the free part of |
---|
639 | // the generator weights: |
---|
640 | list AUT0 = autGenWeights(Q0); |
---|
641 | list AUT; |
---|
642 | |
---|
643 | // each element of AUT should be of shape |
---|
644 | // |
---|
645 | // B | 0 |
---|
646 | // C | D |
---|
647 | // |
---|
648 | // where D = diag(d1,..,dn) and C has entries |
---|
649 | // 0 <= c_ij < TOR[i] |
---|
650 | |
---|
651 | // form all possible C-matrices and D-matrices: |
---|
652 | list DL = getDmats(TOR); |
---|
653 | list CL = getCmats(TOR, nrows(Q0)); |
---|
654 | |
---|
655 | int j; |
---|
656 | int k; |
---|
657 | |
---|
658 | for(i = 1; i <= size(AUT0); i++){ |
---|
659 | for(j = 1; j <= size(CL); j++){ |
---|
660 | for(k = 1; k <= size(DL); k++){ |
---|
661 | intmat A = concatBCD(AUT0[i], CL[j], DL[k]); |
---|
662 | |
---|
663 | // M * Origs = Origs?: |
---|
664 | if(fixesOrig(A, Origs, OrigDim, TOR)){ |
---|
665 | AUT[size(AUT)+1] = A; |
---|
666 | } |
---|
667 | |
---|
668 | kill A; |
---|
669 | } |
---|
670 | } |
---|
671 | } |
---|
672 | |
---|
673 | return(AUT); |
---|
674 | } |
---|
675 | |
---|
676 | ///////////////////////////////// |
---|
677 | |
---|
678 | // helper |
---|
679 | // returns all lattice bases among QQ of size size(QQ[1]) |
---|
680 | static proc allLatticeBases(list QQ){ |
---|
681 | int d = size(QQ[1]); |
---|
682 | int r = size(QQ); |
---|
683 | list Bases; |
---|
684 | int j; |
---|
685 | |
---|
686 | // compute all lattice bases of size d among QQ: |
---|
687 | // traverse subsets (given as binary vectors J): |
---|
688 | for(int i = 1; i <= 2^r; i++){ |
---|
689 | intvec J = int2face(i, r); |
---|
690 | list QJ; |
---|
691 | |
---|
692 | // status info since this may run for a longer time: |
---|
693 | if(i mod 300 == 0){ |
---|
694 | dbprint(printlevel, "i=" + string(i) + " of " + string(2^r)); |
---|
695 | } |
---|
696 | |
---|
697 | // translate J to a 'subset' QJ (given as a list) of QQ: |
---|
698 | for(j = 1; j <= size(J); j++){ |
---|
699 | if(J[j] == 1){ |
---|
700 | QJ[size(QJ) + 1] = QQ[j]; |
---|
701 | } |
---|
702 | } |
---|
703 | |
---|
704 | // sizes are invariant --> look for size d: |
---|
705 | if(size(QJ) == d){ |
---|
706 | intmat QJmat[size(QQ[1])][d]; |
---|
707 | |
---|
708 | for(int k = 1; k <= d; k++){ |
---|
709 | QJmat[1..size(QQ[1]), k] = QJ[k]; |
---|
710 | } |
---|
711 | if(absValue(det(QJmat)) == 1){ |
---|
712 | Bases[size(Bases)+1] = QJmat; |
---|
713 | } |
---|
714 | |
---|
715 | kill QJmat, k; |
---|
716 | } |
---|
717 | |
---|
718 | kill QJ, J; |
---|
719 | } |
---|
720 | |
---|
721 | if(size(Bases) < 1){ |
---|
722 | // for only one row, it is ok to return simply [1]: |
---|
723 | if(d == 1){ |
---|
724 | intmat QJmat[1][1] = 1; |
---|
725 | Bases[1] = QJmat; |
---|
726 | return(Bases); |
---|
727 | } |
---|
728 | |
---|
729 | ERROR("Sorry. Could not find a basis in the columns."); |
---|
730 | } |
---|
731 | |
---|
732 | return(Bases); |
---|
733 | } |
---|
734 | |
---|
735 | //////////////////////////////// |
---|
736 | |
---|
737 | // helper |
---|
738 | // for autGenWeights, the case of no torsion. |
---|
739 | static proc autGenWeightsFree(list QQ, list Origs, list OrigDim) |
---|
740 | { |
---|
741 | dbprint(printlevel, "autGenWeights: entering free case..."); |
---|
742 | list Bases = allLatticeBases(QQ); |
---|
743 | |
---|
744 | dbprint(printlevel, "Number of bases: " + string(size(Bases))); |
---|
745 | |
---|
746 | // take only those A, with A*Origs = Origs: |
---|
747 | list G; |
---|
748 | |
---|
749 | // Any basis is mapped to another basis, |
---|
750 | // so it suffices to fix one basis A and |
---|
751 | // see where it is mapped to. |
---|
752 | intmat A = Bases[1]; |
---|
753 | list AA; |
---|
754 | |
---|
755 | for(int j = 1; j <= ncols(A); j++){ |
---|
756 | AA[size(AA)+1] = col(A, j); |
---|
757 | } |
---|
758 | |
---|
759 | // does not work for 1x1: |
---|
760 | // workaround: |
---|
761 | if(nrows(A) == 1){ |
---|
762 | if(A[1,1] == 1){ |
---|
763 | intmat Ainv = A; |
---|
764 | } else{ // = -1 |
---|
765 | intmat Ainv = -A; |
---|
766 | } |
---|
767 | } else { |
---|
768 | intmat Ainv = intInverse(A); |
---|
769 | } |
---|
770 | |
---|
771 | // we also have to consider permutations of each |
---|
772 | // "image basis": |
---|
773 | int d = size(QQ[1]); |
---|
774 | intvec vd = 1..d; |
---|
775 | list Ld = vd[1..size(vd)]; |
---|
776 | list PER = permutations(Ld, list()); |
---|
777 | |
---|
778 | dbprint(printlevel, "Number of permutations: " + string(size(PER))); |
---|
779 | |
---|
780 | int b; |
---|
781 | list RES; |
---|
782 | |
---|
783 | for(j = 1; j <= size(Bases); j++){ |
---|
784 | dbprint(printlevel, "Checking Basis no. " + string(j) + " of " + string(size(Bases))); |
---|
785 | |
---|
786 | intmat B0 = Bases[j]; // note: d == ncols(B0) >= nrows(B0) |
---|
787 | |
---|
788 | for(b = 1; b <= size(PER); b++){ |
---|
789 | intmat B[nrows(B0)][ncols(B0)]; |
---|
790 | list sigma = PER[b]; |
---|
791 | |
---|
792 | for(int k = 1; k <= d; k++){ |
---|
793 | // the k-th col of B is the |
---|
794 | // sigma(k)-th one of B0: |
---|
795 | intvec v = col(B0, sigma[k]); |
---|
796 | B[1..nrows(B0), k] = v[1..size(v)]; |
---|
797 | |
---|
798 | kill v; |
---|
799 | } |
---|
800 | |
---|
801 | // init M: note that det(M) = +-1 |
---|
802 | // since det(B)=+-1 and det(Ainv)=+-1. |
---|
803 | intmat M = B * Ainv; |
---|
804 | |
---|
805 | // M * Origs = Origs?: |
---|
806 | int takeit = fixesOrig(M, Origs, OrigDim, list()); |
---|
807 | |
---|
808 | if(takeit){ |
---|
809 | // M already present?: |
---|
810 | for(int u = 1; u <= size(RES); u++){ |
---|
811 | if(RES[u] == M){ |
---|
812 | takeit = 0; |
---|
813 | break; |
---|
814 | } |
---|
815 | } |
---|
816 | |
---|
817 | if(takeit){ |
---|
818 | RES[size(RES)+1] = M; |
---|
819 | } |
---|
820 | |
---|
821 | kill u; |
---|
822 | } |
---|
823 | |
---|
824 | kill k, sigma, B, M, takeit; |
---|
825 | } |
---|
826 | |
---|
827 | kill B0; |
---|
828 | } |
---|
829 | |
---|
830 | return(RES); |
---|
831 | } |
---|
832 | |
---|
833 | ///////////////////////////////// |
---|
834 | |
---|
835 | proc autGenWeights(intmat Q, list #) |
---|
836 | "USAGE: autGenWeights(Q): Q is an intmat (columns must contain a lattice basis). |
---|
837 | ASSUME: the cone over Q must be pointed and the columns of Q contain a lattice basis; there must be no 0-columns in Q. We assume that, in the torsion case, the torsion rows of Q are reduced (for example, a row of Q standing for entries in ZZ/5ZZ must not contain elements > 5 or < 0). |
---|
838 | PURPOSE: computes generators for the subgroup aut(Omega_S) of GL(n, \ZZ) that consists of all invertible integer kxk matrices which fix the set Omega_S of degrees of the variables of the basering S. The set of columns of Q equals Omega_S. |
---|
839 | REFERENCE: Remark 3.1. |
---|
840 | RETURN: a list of integral matrices A with |det A| = 1 such that A*{columns of Q} = {columns of Q}. |
---|
841 | EXAMPLE:" |
---|
842 | { |
---|
843 | dbprint(printlevel, "Entering autGenWeights."); |
---|
844 | |
---|
845 | // if S is the basering, and w1, w2 are weights of some generators |
---|
846 | // the component S_w1 can only be mapped to S_w2 if the dimensions |
---|
847 | // coincide. --> store these in OrigDim. |
---|
848 | // Store in Origs the generator weights without repetition (also known as Omega_S). |
---|
849 | list Origs = Q2Origs(Q); |
---|
850 | list OrigDim = Origs[2]; |
---|
851 | list QQ = Origs[3]; // store columns of Q here |
---|
852 | Origs = Origs[1]; |
---|
853 | |
---|
854 | dbprint(printlevel, "--- Originary degrees ---"); |
---|
855 | dbprint(printlevel, Origs); |
---|
856 | dbprint(printlevel, "--- Dimension of the respective component ---"); |
---|
857 | dbprint(printlevel, OrigDim); |
---|
858 | |
---|
859 | // distinguish between torsion and free cases. |
---|
860 | list TOR; |
---|
861 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
862 | // this treats the torsion case |
---|
863 | dbprint(printlevel, "autGenWeights: entering torsion case..."); |
---|
864 | |
---|
865 | TOR = #[1]; |
---|
866 | |
---|
867 | return(autGenWeightsTorsion(Q, TOR, Origs, OrigDim)); |
---|
868 | } |
---|
869 | |
---|
870 | // now, we treat the free case: |
---|
871 | return(autGenWeightsFree(QQ, Origs, OrigDim)); |
---|
872 | } |
---|
873 | example |
---|
874 | { |
---|
875 | echo=2; |
---|
876 | |
---|
877 | // torsion example |
---|
878 | // ZZ + ZZ/5ZZ: |
---|
879 | intmat Q[2][5] = |
---|
880 | 1,1,1,1,1, |
---|
881 | 2,3,1,4,0; |
---|
882 | |
---|
883 | list TOR = 5; |
---|
884 | |
---|
885 | autGenWeights(Q, TOR); |
---|
886 | kill Q, TOR; |
---|
887 | |
---|
888 | // another free example |
---|
889 | intmat Q[2][6] = |
---|
890 | -2,2,-1,1,-1,1, |
---|
891 | 1,1,1,1,1,1; |
---|
892 | |
---|
893 | autGenWeights(Q); |
---|
894 | kill Q; |
---|
895 | |
---|
896 | //---------------- |
---|
897 | // 2nd free example |
---|
898 | intmat Q[2][4] = |
---|
899 | 1,0,1,1, |
---|
900 | 0,1,1,1; |
---|
901 | |
---|
902 | autGenWeights(Q); |
---|
903 | kill Q; |
---|
904 | } |
---|
905 | |
---|
906 | /////////////////////////////////// |
---|
907 | |
---|
908 | // converts e.g. n=5 to its binary representation, i.e. 0,1,0,1 |
---|
909 | // if r = 3. |
---|
910 | // and stores it in an intvec. |
---|
911 | // r gives the bound for n <= 2^r: |
---|
912 | static proc int2face(int n, int r) |
---|
913 | { |
---|
914 | int k = r; |
---|
915 | list v; |
---|
916 | int n0 = n; |
---|
917 | |
---|
918 | while(k >= 0){ |
---|
919 | if(2^k > n0){ |
---|
920 | v[size(v)+1] = 0; |
---|
921 | } else { |
---|
922 | v[size(v)+1] = 1; |
---|
923 | n0 = n0 - 2^k; |
---|
924 | } |
---|
925 | |
---|
926 | k--; |
---|
927 | } |
---|
928 | |
---|
929 | if(size(v)>=2){ |
---|
930 | v = v[2..size(v)]; |
---|
931 | } |
---|
932 | |
---|
933 | return(intvec(v[1..size(v)])); |
---|
934 | } |
---|
935 | example |
---|
936 | { |
---|
937 | echo = 2; |
---|
938 | int n = 5; |
---|
939 | int r = 4; |
---|
940 | int2face(n, r); |
---|
941 | |
---|
942 | n = 1; |
---|
943 | r = 1; |
---|
944 | int2face(n,r); |
---|
945 | } |
---|
946 | |
---|
947 | ////////////////////////////// |
---|
948 | |
---|
949 | // helper |
---|
950 | // returns all permutations of the input list L. |
---|
951 | static proc permutations(list Left, list sol){ |
---|
952 | list Res; |
---|
953 | |
---|
954 | if(size(Left) == 0){ |
---|
955 | return(list(sol)); |
---|
956 | } |
---|
957 | |
---|
958 | for(int i = 1; i <= size(Left); i++){ |
---|
959 | list sol0 = sol; |
---|
960 | sol0[size(sol0)+1] = Left[i]; |
---|
961 | |
---|
962 | if(i > 1){ |
---|
963 | if(i < size(Left)){ |
---|
964 | list Left0 = Left[1..i-1], Left[i+1..size(Left)]; |
---|
965 | } else { // i = size(Left) |
---|
966 | list Left0 = Left[1..i-1]; |
---|
967 | } |
---|
968 | } else{ // i = 1 |
---|
969 | if(1 == size(Left)){ |
---|
970 | list Left0; |
---|
971 | } else { |
---|
972 | list Left0 = Left[i+1..size(Left)]; |
---|
973 | } |
---|
974 | } |
---|
975 | |
---|
976 | list Res0 = permutations(Left0, sol0); |
---|
977 | |
---|
978 | for(int k = 1; k <= size(Res0); k++){ |
---|
979 | Res[size(Res)+1] = Res0[k]; |
---|
980 | } |
---|
981 | |
---|
982 | kill k, sol0, Res0, Left0; |
---|
983 | } |
---|
984 | |
---|
985 | return(Res); |
---|
986 | } |
---|
987 | example |
---|
988 | { |
---|
989 | echo=2; |
---|
990 | |
---|
991 | list L = 1,2,3; |
---|
992 | permutations(L, list()); |
---|
993 | |
---|
994 | kill L; |
---|
995 | } |
---|
996 | |
---|
997 | //////////////////////////// |
---|
998 | |
---|
999 | static proc fixesOrig(intmat M, list Origs, list OrigDim, list TOR){ |
---|
1000 | int takeit = 1; |
---|
1001 | intvec found = 0:size(Origs); |
---|
1002 | |
---|
1003 | for(int l = 1; l <= size(Origs); l++){ |
---|
1004 | intmat W = Origs[l]; // 1 col |
---|
1005 | intmat MW = M * W; // 1 col |
---|
1006 | |
---|
1007 | // test whether M*W = some orig |
---|
1008 | // (and also not yet found)?: |
---|
1009 | for(int m = 1; m <= size(Origs); m++){ |
---|
1010 | // reduce torsion rows: |
---|
1011 | intmat MWred = MW; // 1 col |
---|
1012 | |
---|
1013 | for(int i = 1; i <= size(TOR); i++){ |
---|
1014 | MWred[nrows(MWred) - size(TOR) + i,1] = MWred[nrows(MWred) - size(TOR) + i,1] mod TOR[i]; |
---|
1015 | |
---|
1016 | if(MWred[nrows(MWred) - size(TOR) + i,1] < 0){ |
---|
1017 | MWred[nrows(MWred) - size(TOR) + i,1] = MWred[nrows(MWred) - size(TOR) + i,1] + TOR[i]; |
---|
1018 | } |
---|
1019 | } |
---|
1020 | |
---|
1021 | if(Origs[m] == MWred){ |
---|
1022 | if(found[m] == OrigDim[m]){ |
---|
1023 | takeit = 0; |
---|
1024 | break; |
---|
1025 | } |
---|
1026 | |
---|
1027 | found[m] = 1; |
---|
1028 | } |
---|
1029 | |
---|
1030 | kill MWred, i; |
---|
1031 | } |
---|
1032 | |
---|
1033 | kill m, W, MW; |
---|
1034 | |
---|
1035 | if(!takeit){ |
---|
1036 | return(0); // false |
---|
1037 | } |
---|
1038 | } |
---|
1039 | |
---|
1040 | if(takeit and found == 1:size(Origs)){ |
---|
1041 | return(1); // true |
---|
1042 | } |
---|
1043 | |
---|
1044 | return(0); // false |
---|
1045 | } |
---|
1046 | |
---|
1047 | ///////////////////////////////////// |
---|
1048 | |
---|
1049 | // helper: |
---|
1050 | // returns a list of all matrices of shape |
---|
1051 | // diag(d_1,...,d_size(TOR)) |
---|
1052 | // where gcd(d_i, TOR[i]) = 1. |
---|
1053 | static proc getDmats(list TOR){ |
---|
1054 | list sol; |
---|
1055 | return(getDmatsrec(TOR, sol)); |
---|
1056 | } |
---|
1057 | example |
---|
1058 | { |
---|
1059 | list TOR = 3,5; |
---|
1060 | TOR; |
---|
1061 | getDmats(TOR); |
---|
1062 | } |
---|
1063 | |
---|
1064 | /////////////////////////// |
---|
1065 | |
---|
1066 | // helper |
---|
1067 | // for getDmats |
---|
1068 | static proc getDmatsrec(list TOR, list sol){ |
---|
1069 | int pos = size(sol) + 1; |
---|
1070 | list Res; |
---|
1071 | |
---|
1072 | if(size(sol) == size(TOR)){ |
---|
1073 | intmat D[size(TOR)][size(TOR)]; |
---|
1074 | |
---|
1075 | for(int k = 1; k <= size(TOR); k++){ |
---|
1076 | list L0 = sol[k]; |
---|
1077 | D[k, 1..ncols(D)] = L0[1..size(L0)]; |
---|
1078 | |
---|
1079 | kill L0; |
---|
1080 | } |
---|
1081 | |
---|
1082 | return(list(D)); |
---|
1083 | } |
---|
1084 | |
---|
1085 | for(int i = 1; i < TOR[pos]; i++){ |
---|
1086 | list sol0 = sol; |
---|
1087 | |
---|
1088 | if(gcd(i, TOR[pos]) == 1){ |
---|
1089 | sol0[pos] = i; |
---|
1090 | |
---|
1091 | list Res0 = getDmatsrec(TOR, sol0); |
---|
1092 | for(int k = 1; k <= size(Res0); k++){ |
---|
1093 | Res[size(Res)+1] = Res0[k]; |
---|
1094 | } |
---|
1095 | |
---|
1096 | kill k; |
---|
1097 | kill Res0; |
---|
1098 | } |
---|
1099 | |
---|
1100 | kill sol0; |
---|
1101 | } |
---|
1102 | |
---|
1103 | return(Res); |
---|
1104 | } |
---|
1105 | |
---|
1106 | /////////////////////////// |
---|
1107 | |
---|
1108 | // helper: returns all intvecs |
---|
1109 | // of length n with entries 0 <= c < m: |
---|
1110 | static proc getCvecsrec(int m, int n, list sol){ |
---|
1111 | int pos = size(sol) + 1; |
---|
1112 | list Res; |
---|
1113 | |
---|
1114 | if(size(sol) == n){ |
---|
1115 | return(list(sol)); |
---|
1116 | } |
---|
1117 | |
---|
1118 | for(int i = 0; i < m; i++){ |
---|
1119 | list sol0 = sol; |
---|
1120 | sol0[pos] = i; |
---|
1121 | |
---|
1122 | list Res0 = getCvecsrec(m, n, sol0); |
---|
1123 | for(int k = 1; k <= size(Res0); k++){ |
---|
1124 | Res[size(Res)+1] = Res0[k]; |
---|
1125 | } |
---|
1126 | |
---|
1127 | kill k, Res0, sol0; |
---|
1128 | } |
---|
1129 | |
---|
1130 | return(Res); |
---|
1131 | } |
---|
1132 | |
---|
1133 | ////////////////////////////////////////// |
---|
1134 | |
---|
1135 | // helper: |
---|
1136 | // returns a list of all size(TOR) x n |
---|
1137 | // matrices C with entries |
---|
1138 | // 0 <= c_ij < TOR[i] |
---|
1139 | static proc getCmats(list TOR, int n){ |
---|
1140 | list ROWS; |
---|
1141 | |
---|
1142 | for(int i = 1; i <= size(TOR); i++){ |
---|
1143 | list sol; |
---|
1144 | ROWS[i] = getCvecsrec(TOR[i], n, sol); |
---|
1145 | |
---|
1146 | kill sol; |
---|
1147 | } |
---|
1148 | |
---|
1149 | // choose one from each element of ROWs: |
---|
1150 | // i.e., form the cartesian product: |
---|
1151 | list CL = getCmatsrec(ROWS, list()); |
---|
1152 | |
---|
1153 | return(CL); |
---|
1154 | } |
---|
1155 | example |
---|
1156 | { |
---|
1157 | list TOR = 3,5; |
---|
1158 | |
---|
1159 | TOR; |
---|
1160 | |
---|
1161 | "ZZ^2 + ZZ/3ZZ + ZZ/5ZZ:"; |
---|
1162 | getCmats(TOR, 2); |
---|
1163 | |
---|
1164 | } |
---|
1165 | |
---|
1166 | /////////////////////////// |
---|
1167 | |
---|
1168 | // helper: chooses one element of each |
---|
1169 | // element of ROWs and forms the matrix |
---|
1170 | static proc getCmatsrec(list ROWS, list sol){ |
---|
1171 | int pos = size(sol) + 1; |
---|
1172 | list Res; |
---|
1173 | |
---|
1174 | if(size(sol) == size(ROWS)){ |
---|
1175 | intmat C[size(ROWS)][size(ROWS[1][1])]; |
---|
1176 | |
---|
1177 | for(int k = 1; k <= size(ROWS); k++){ |
---|
1178 | list ROWSk = sol[k]; |
---|
1179 | C[k, 1..ncols(C)] = ROWSk[1..size(ROWSk)]; |
---|
1180 | |
---|
1181 | kill ROWSk; |
---|
1182 | } |
---|
1183 | |
---|
1184 | return(list(C)); //return(list(sol)); |
---|
1185 | } |
---|
1186 | |
---|
1187 | for(int i = 1; i <= size(ROWS[pos]); i++){ |
---|
1188 | list sol0 = sol; |
---|
1189 | sol0[pos] = ROWS[pos][i]; |
---|
1190 | |
---|
1191 | list Res0 = getCmatsrec(ROWS, sol0); |
---|
1192 | for(int k = 1; k <= size(Res0); k++){ |
---|
1193 | Res[size(Res)+1] = Res0[k]; |
---|
1194 | } |
---|
1195 | |
---|
1196 | kill k, Res0, sol0; |
---|
1197 | } |
---|
1198 | |
---|
1199 | return(Res); |
---|
1200 | } |
---|
1201 | |
---|
1202 | ////////////////////////////////////////// |
---|
1203 | |
---|
1204 | // helper: concats the given matrices to |
---|
1205 | // B | 0 |
---|
1206 | // C | D |
---|
1207 | static proc concatBCD(intmat B, intmat C, intmat D){ |
---|
1208 | intmat A[nrows(B) + nrows(C)][ncols(B) + ncols(D)]; |
---|
1209 | |
---|
1210 | for(int i = 1; i <= nrows(B); i++){ |
---|
1211 | A[i, 1..ncols(B)] = B[i,1..ncols(B)]; //, 0:ncols(D); |
---|
1212 | } |
---|
1213 | for(i = nrows(B)+1; i <= nrows(B) + nrows(C); i++){ |
---|
1214 | //A[i, 1..ncols(A)] = C[i - nrows(B), 1..ncols(C)], D[i - nrows(B), 1..ncols(D)]; |
---|
1215 | A[i, 1..ncols(C)] = C[i - nrows(B), 1..ncols(C)]; |
---|
1216 | A[i, ncols(C)+1..ncols(A)] = D[i - nrows(B), 1..ncols(D)]; |
---|
1217 | } |
---|
1218 | |
---|
1219 | return(A); |
---|
1220 | } |
---|
1221 | |
---|
1222 | ///////////////////////////////// |
---|
1223 | |
---|
1224 | // helper |
---|
1225 | // assume: BL of shape [[d, w, Rw],...] where d is the dimension of R_w, |
---|
1226 | // Rw a basis of R_w and w the weight vector. |
---|
1227 | // Returns a ring S and exports a matrix of name Aexported over S |
---|
1228 | // and a list of monomials MONSexported. |
---|
1229 | static proc createAutMatrix(list BL) |
---|
1230 | { |
---|
1231 | // A will be nxn; compute n: |
---|
1232 | list MON = sortMons(BL); |
---|
1233 | int n = size(MON); |
---|
1234 | |
---|
1235 | // the first rows of A correspond to the variables T(i): |
---|
1236 | def R = basering; |
---|
1237 | int n0 = nvars(basering); |
---|
1238 | intmat Q = getVariableWeights(); |
---|
1239 | intmat QS[nrows(Q)][ncols(Q) + n0*n]; |
---|
1240 | |
---|
1241 | for(int l = 1; l <= ncols(Q); l++){ |
---|
1242 | QS[1..nrows(Q),l] = Q[1..nrows(Q),l]; |
---|
1243 | } |
---|
1244 | |
---|
1245 | string Sstr = "ring S = (" + charstr(basering) + "),(T(1..n0), Y(1..n0*n)),dp;"; |
---|
1246 | execute(Sstr); // creates the ring 0,(T(1..n0), Y(1..n0*n)),dp; |
---|
1247 | setring S; |
---|
1248 | setBaseMultigrading(QS); |
---|
1249 | |
---|
1250 | matrix A[n][n]; |
---|
1251 | map f = R, T(1..n0); |
---|
1252 | list MONS = f(MON); |
---|
1253 | list BLS = f(BL); |
---|
1254 | int k; |
---|
1255 | |
---|
1256 | for(int i = 1; i <= n0; i++){ |
---|
1257 | // find out j such that BLS[j] contains var(i): |
---|
1258 | int ind = 0; |
---|
1259 | |
---|
1260 | for(int j = 1; j <= size(BLS); j++){ |
---|
1261 | for(k = 1; k <= size(BLS[j][3]); k++){ |
---|
1262 | if(var(i) == BLS[j][3][k]){ |
---|
1263 | ind = j; |
---|
1264 | break; |
---|
1265 | } |
---|
1266 | } |
---|
1267 | |
---|
1268 | if(ind > 0){ |
---|
1269 | break; |
---|
1270 | } |
---|
1271 | } |
---|
1272 | |
---|
1273 | list MONi = BLS[ind][3]; |
---|
1274 | |
---|
1275 | for(j = 1; j <= n; j++){ |
---|
1276 | // test if MON[j] is in the set {MONi}: |
---|
1277 | for(int m = 1; m <= size(MONi); m++){ |
---|
1278 | if(MONi[m] == MONS[j]){ |
---|
1279 | A[i,j] = Y((i-1)*n+j); // the Y-variables are ordered row-wise |
---|
1280 | break; |
---|
1281 | } |
---|
1282 | } |
---|
1283 | |
---|
1284 | kill m; |
---|
1285 | } |
---|
1286 | |
---|
1287 | kill MONi, ind, j; |
---|
1288 | } |
---|
1289 | |
---|
1290 | // Form the A*T[i] first for the lower rows: |
---|
1291 | // store A*T[i] in H[1,i]: |
---|
1292 | matrix H[1][n0]; |
---|
1293 | |
---|
1294 | for(k = 1; k <= n0; k++){ |
---|
1295 | for(i = 1; i <= size(MONS); i++){ |
---|
1296 | H[1,k] = H[1,k] + A[k,i] * MONS[i]; |
---|
1297 | } |
---|
1298 | } |
---|
1299 | |
---|
1300 | // the lower rows of of A |
---|
1301 | // are determined by the first ones: |
---|
1302 | // e.g. A*(T_1^2) = (A*T_1)^2: |
---|
1303 | for(i = n0 + 1; i <= size(MONS); i++){ |
---|
1304 | // e.g. for MON[i] = T[1]*T[2]^2, |
---|
1305 | // we have v = [1,2,0,0] and |
---|
1306 | // A * (T[1]*T[2]^2) = (A*T[1])(A*T[2])^2: |
---|
1307 | poly Av = 1; |
---|
1308 | intvec v = leadexp(MONS[i]); // the last entries are all 0s |
---|
1309 | |
---|
1310 | for(int m = 1; m <= n0; m++){ |
---|
1311 | Av = Av * H[1,m]^v[m]; |
---|
1312 | } |
---|
1313 | |
---|
1314 | // if in Av there is e.g. the monomial Y(22)^2*T(1)^2 |
---|
1315 | // then A[i,j] = Y(22)^2 where MONS[j] = T(1)^2: |
---|
1316 | for(int j = 1; j <= size(MONS); j++){ |
---|
1317 | A[i,j] = moncoef2(Av, MONS[j], n0); |
---|
1318 | } |
---|
1319 | |
---|
1320 | kill Av, v, m, j; |
---|
1321 | } |
---|
1322 | |
---|
1323 | matrix Aexported = A; |
---|
1324 | list MONSexported = MONS; |
---|
1325 | |
---|
1326 | // ring-dependent: |
---|
1327 | export(Aexported); |
---|
1328 | export(MONSexported); |
---|
1329 | |
---|
1330 | return(S); |
---|
1331 | } |
---|
1332 | |
---|
1333 | //////////////////////////// |
---|
1334 | |
---|
1335 | // helper |
---|
1336 | // returns bases for <RL>_w for all w in Orig. |
---|
1337 | static proc allMonomials(ideal RL, list #){ |
---|
1338 | list TOR; |
---|
1339 | |
---|
1340 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
1341 | TOR = #[1]; |
---|
1342 | } |
---|
1343 | |
---|
1344 | list BL; |
---|
1345 | intmat Q = getVariableWeights(); |
---|
1346 | |
---|
1347 | // by assumption: Origs = degrees (no repetition) |
---|
1348 | list Origs = Q2Origs(Q)[1]; |
---|
1349 | |
---|
1350 | for(int i = 1; i <= size(Origs); i++){ |
---|
1351 | intvec w = Origs[i]; |
---|
1352 | list L = gradedCompRing(RL, w, TOR); |
---|
1353 | list Rw = L[1]; |
---|
1354 | |
---|
1355 | BL[size(BL)+1] = list(size(Rw), w, Rw); |
---|
1356 | |
---|
1357 | kill L, w, Rw; |
---|
1358 | } |
---|
1359 | |
---|
1360 | return(BL); |
---|
1361 | } |
---|
1362 | |
---|
1363 | //////////////////////////// |
---|
1364 | |
---|
1365 | // helper |
---|
1366 | // returns the columns of Q without repetition |
---|
1367 | // and the list of dimensions. |
---|
1368 | static proc Q2Origs(intmat Q){ |
---|
1369 | list Origs; |
---|
1370 | list OrigDim; |
---|
1371 | list QQ; |
---|
1372 | |
---|
1373 | for(int i = 1; i <= ncols(Q); i++){ |
---|
1374 | int takeit = 1; |
---|
1375 | intvec v = col(Q, i); |
---|
1376 | QQ[i] = v; |
---|
1377 | |
---|
1378 | for(int j = 1; j <= size(Origs); j++){ |
---|
1379 | if(Origs[j] == v){ |
---|
1380 | OrigDim[j] = OrigDim[j] + 1; // OrigDim[j] is already defined |
---|
1381 | takeit = 0; |
---|
1382 | break; |
---|
1383 | } |
---|
1384 | } |
---|
1385 | |
---|
1386 | if(takeit == 1){ |
---|
1387 | Origs[size(Origs)+1] = v; |
---|
1388 | OrigDim[size(OrigDim)+1] = 1; |
---|
1389 | } |
---|
1390 | |
---|
1391 | kill j, v, takeit; |
---|
1392 | } |
---|
1393 | |
---|
1394 | return(list(Origs, OrigDim, QQ)); |
---|
1395 | } |
---|
1396 | |
---|
1397 | ////////////////////////////////////////// |
---|
1398 | |
---|
1399 | static proc gradedCompRing(ideal RL, intvec w, list #) |
---|
1400 | "USAGE: gradedCompRing(I, w): I is an ideal, w an intvec. Optional 3rd argument: a list of integers representing the torsion part. |
---|
1401 | ASSUME: the basering must be graded (see setBAseMultigrading()) and the cone over |
---|
1402 | the degrees of the variables must be pointed; there mustn't be 0-degrees. The vector |
---|
1403 | w must be an element of the cone over the degrees of the variables. |
---|
1404 | PURPOSE: returns a basis for the vector space R_w where R is the factor ring of the basering by I. |
---|
1405 | RETURN: a list L where L[1] = is the (monomial) Basis, L[2] = is a matrix with columns representing the basis vectors, L[3] = Monomials of degree w; |
---|
1406 | EXAMPLE: shows an example." |
---|
1407 | { |
---|
1408 | list TOR; |
---|
1409 | |
---|
1410 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
1411 | TOR = #[1]; |
---|
1412 | } |
---|
1413 | |
---|
1414 | // return a basis for I_w as a list of basis vectors: |
---|
1415 | list L = gradedCompIdeal(RL, w, 0, TOR); |
---|
1416 | list MON = L[1]; |
---|
1417 | list RLw = L[2]; |
---|
1418 | |
---|
1419 | list Bas; |
---|
1420 | int r; |
---|
1421 | |
---|
1422 | if(size(RLw) == 0){ |
---|
1423 | r = 0; |
---|
1424 | } else { |
---|
1425 | matrix B[size(RLw)][size(MON)]; |
---|
1426 | |
---|
1427 | for(int i = 1; i <= size(RLw); i++){ |
---|
1428 | matrix RLwi = RLw[i]; |
---|
1429 | B[i, 1..size(MON)] = RLwi[1..nrows(RLwi), 1]; |
---|
1430 | |
---|
1431 | kill RLwi; |
---|
1432 | } |
---|
1433 | kill i; |
---|
1434 | |
---|
1435 | r = rank(B); |
---|
1436 | } |
---|
1437 | |
---|
1438 | // Add Elements to Basis 'Bas' as long as the rank r |
---|
1439 | // of the matrix B increases: |
---|
1440 | for(int j = 1; j <= size(MON); j++){ |
---|
1441 | // translate MON[j] to v= -e_j |
---|
1442 | // the new row: e_j, i.e., all zeros (standard) and j-th entry is a 1: |
---|
1443 | if(r == 0){ // this means B is not defined! |
---|
1444 | matrix Btmp[1][size(MON)]; |
---|
1445 | Btmp[1,j] = 1; |
---|
1446 | } else { |
---|
1447 | matrix Btmp[nrows(B)+1][ncols(B)] = B[1..nrows(B), 1..ncols(B)]; |
---|
1448 | Btmp[nrows(B)+1, j] = 1; |
---|
1449 | } |
---|
1450 | |
---|
1451 | int rv = rank(Btmp); |
---|
1452 | |
---|
1453 | if(rv > r){ |
---|
1454 | if(r == 0){ |
---|
1455 | matrix B = Btmp; |
---|
1456 | } else{ |
---|
1457 | B = Btmp; |
---|
1458 | } |
---|
1459 | |
---|
1460 | r = rv; |
---|
1461 | |
---|
1462 | Bas[size(Bas)+1] = MON[j]; |
---|
1463 | } |
---|
1464 | |
---|
1465 | kill rv, Btmp; |
---|
1466 | } |
---|
1467 | |
---|
1468 | // remove columns of RL_w in B: |
---|
1469 | matrix B2[nrows(B) - size(RLw)][ncols(B)] = B[size(RLw)+1..nrows(B), 1..ncols(B)]; |
---|
1470 | |
---|
1471 | list LL; |
---|
1472 | LL[1] = Bas; |
---|
1473 | LL[2] = B2; |
---|
1474 | LL[3] = MON; |
---|
1475 | |
---|
1476 | return(LL); |
---|
1477 | } |
---|
1478 | example |
---|
1479 | { |
---|
1480 | echo=2; |
---|
1481 | |
---|
1482 | // example with torsion: ZZ + ZZ/5ZZ: |
---|
1483 | intmat Q[2][5] = |
---|
1484 | 1,1,1,1,1, |
---|
1485 | 2,3,1,4,0; |
---|
1486 | |
---|
1487 | list TOR = 5; |
---|
1488 | ring R = 0,T(1..5),dp; |
---|
1489 | |
---|
1490 | // attach degree matrix Q to R: |
---|
1491 | setBaseMultigrading(Q); |
---|
1492 | |
---|
1493 | ideal I = T(1)*T(2) + T(3)*T(4) + T(5)^2; |
---|
1494 | intvec w = 3,1; |
---|
1495 | |
---|
1496 | // as list of polynomials: |
---|
1497 | gradedCompRing(I, w, TOR); |
---|
1498 | kill R, w, Q, TOR; |
---|
1499 | |
---|
1500 | // 2nd example: no torsion |
---|
1501 | ring R = 0, T(1..4), dp; |
---|
1502 | |
---|
1503 | // Weights of variables |
---|
1504 | intmat Q[2][4] = |
---|
1505 | -2, 2, -1, 1, |
---|
1506 | 1, 1, 1, 1; |
---|
1507 | |
---|
1508 | // attach degree matrix Q to R: |
---|
1509 | setBaseMultigrading(Q); |
---|
1510 | |
---|
1511 | ideal I = T(1)*T(2) + T(3)*T(4); |
---|
1512 | intvec w = 0,2; |
---|
1513 | |
---|
1514 | gradedCompRing(I, w); |
---|
1515 | } |
---|
1516 | |
---|
1517 | |
---|
1518 | //////////////////////// |
---|
1519 | |
---|
1520 | // helper |
---|
1521 | // sort the monomials in the 3rd entry |
---|
1522 | // of each element of BL into a list |
---|
1523 | // according to the dp-ordering (descendingly) |
---|
1524 | static proc sortMons(list BL){ |
---|
1525 | list MON; |
---|
1526 | |
---|
1527 | // extract monomials |
---|
1528 | for(int i = 1; i <= size(BL); i++){ |
---|
1529 | list Tmp = BL[i][3]; |
---|
1530 | |
---|
1531 | for(int j = 1; j <= size(Tmp); j++){ |
---|
1532 | MON[size(MON)+1] = Tmp[j]; |
---|
1533 | } |
---|
1534 | |
---|
1535 | kill Tmp, j; |
---|
1536 | } |
---|
1537 | |
---|
1538 | // sort MON according to the degrevlex ordering (dp) |
---|
1539 | def R = basering; |
---|
1540 | |
---|
1541 | string Sstr = "ring S = (" + charstr(basering) + "), Y(nvars(basering)..1), dp;"; |
---|
1542 | execute(Sstr); |
---|
1543 | setring S; //creates a ring of shape '0, Y(nvars(basering)..1), dp' |
---|
1544 | |
---|
1545 | map f = R, Y(1..nvars(basering)); |
---|
1546 | list fMON = f(MON); |
---|
1547 | list MONS; |
---|
1548 | |
---|
1549 | // to sort MONS: |
---|
1550 | // form Sum_i fMON[i] and look |
---|
1551 | // for the leading terms iteratively: |
---|
1552 | poly p = 0; |
---|
1553 | |
---|
1554 | for(i = 1; i <= size(fMON); i++){ |
---|
1555 | p = p + fMON[i]; |
---|
1556 | } |
---|
1557 | |
---|
1558 | // sort it descendingly: |
---|
1559 | int c = size(fMON); |
---|
1560 | |
---|
1561 | while(p != 0){ |
---|
1562 | MONS[c] = lead(p); |
---|
1563 | p = p - lead(p); |
---|
1564 | c--; |
---|
1565 | } |
---|
1566 | |
---|
1567 | // translate back to R: |
---|
1568 | setring R; |
---|
1569 | |
---|
1570 | map g = S, T(nvars(basering)..1); |
---|
1571 | MON = g(MONS); |
---|
1572 | |
---|
1573 | return(MON); |
---|
1574 | } |
---|
1575 | |
---|
1576 | //////////////////////// |
---|
1577 | |
---|
1578 | // helper: |
---|
1579 | // computes the nxn identity matrix: |
---|
1580 | static proc getIdMat(int n){ |
---|
1581 | intmat A[n][n]; |
---|
1582 | |
---|
1583 | for(int i = 1; i <= n; i++){ |
---|
1584 | A[i, 1..n] = 0:n; |
---|
1585 | A[i,i] = 1; |
---|
1586 | } |
---|
1587 | |
---|
1588 | return(A); |
---|
1589 | } |
---|
1590 | |
---|
1591 | ////////////////////////////////////// |
---|
1592 | |
---|
1593 | // helper |
---|
1594 | static proc insertIntvecIfNew(list L0, intvec v){ |
---|
1595 | list L = L0; |
---|
1596 | int takeit = 1; |
---|
1597 | |
---|
1598 | for(int j = 1; j <= size(L); j++){ |
---|
1599 | if(L[j] == v){ |
---|
1600 | takeit = 0; |
---|
1601 | break; |
---|
1602 | } |
---|
1603 | } |
---|
1604 | |
---|
1605 | if(takeit == 1){ |
---|
1606 | L[size(L) + 1] = v; |
---|
1607 | } |
---|
1608 | |
---|
1609 | return(L); |
---|
1610 | } |
---|
1611 | |
---|
1612 | ////////////////////////////////////// |
---|
1613 | |
---|
1614 | // helper: |
---|
1615 | // returns the set |
---|
1616 | // OmegaI = {w in K; I_w \subseteq I_<w} |
---|
1617 | // of unique minimal generator degrees. |
---|
1618 | // Elements of components are of shape |
---|
1619 | // [w, I_w, K[T]_w] |
---|
1620 | // We assume that if I = <f_1,...,f_s> we have |
---|
1621 | // OmegaI = {deg(f_1),...,deg(f_s)} |
---|
1622 | static proc getOmegaI(ideal I, list #){ |
---|
1623 | dbprint(printlevel, "Warning: we assume that OmegaI = {deg(f_1),...,deg(f_s)} if the input ideal is generated by f_1,...,f_s. "); |
---|
1624 | |
---|
1625 | list TOR; |
---|
1626 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
1627 | TOR = #[1]; |
---|
1628 | } |
---|
1629 | |
---|
1630 | // OmegaI = {w in K; I_w \subseteq I_<w} |
---|
1631 | list OmegaI; |
---|
1632 | |
---|
1633 | // go through each generator f of the ideal: |
---|
1634 | // compute a basis for I_deg(f) |
---|
1635 | for(int i = 1; i <= size(I); i++){ |
---|
1636 | poly f = I[i]; |
---|
1637 | intvec w = multiDegRedTor(f, TOR); |
---|
1638 | |
---|
1639 | OmegaI = insertIntvecIfNew(OmegaI, w); |
---|
1640 | kill f, w; |
---|
1641 | } |
---|
1642 | |
---|
1643 | return(OmegaI); |
---|
1644 | } |
---|
1645 | example |
---|
1646 | { |
---|
1647 | echo=2; |
---|
1648 | |
---|
1649 | intmat Q[1][5] = 3,3,2,2,1; |
---|
1650 | ring R = 0,T(1..5),dp; |
---|
1651 | |
---|
1652 | // attach degree matrix Q to R: |
---|
1653 | setBaseMultigrading(Q); |
---|
1654 | |
---|
1655 | ideal I = T(1)*T(2) + T(3)^2*T(4) + T(5)^6, |
---|
1656 | T(3)*T(4) + T(1)*T(5) + T(5)^4 + T(4)^2; |
---|
1657 | |
---|
1658 | // expect: OmegaI = {4,6} |
---|
1659 | getOmegaI(I); |
---|
1660 | } |
---|
1661 | |
---|
1662 | ///////////////////////////////////// |
---|
1663 | |
---|
1664 | // helper: |
---|
1665 | // write the variables of the basering in the rows of a matrix. |
---|
1666 | // n0 is the number of variables of the very first basering, |
---|
1667 | // i.e., the number of 'meaningful' rows of the resulting matrix. |
---|
1668 | static proc getAgeneral(int n0){ |
---|
1669 | int coldim = (nvars(basering) - 1) div n0; // there is the additonal var 'Z' |
---|
1670 | matrix A[coldim][coldim]; |
---|
1671 | |
---|
1672 | // write the variables into A |
---|
1673 | int j; |
---|
1674 | int v = 1; |
---|
1675 | for(int i = 1; i <= n0; i++){ |
---|
1676 | for(j = 1; j <= coldim; j++){ |
---|
1677 | A[i,j] = var(v); |
---|
1678 | v++; |
---|
1679 | } |
---|
1680 | } |
---|
1681 | |
---|
1682 | return(A); |
---|
1683 | } |
---|
1684 | example |
---|
1685 | { |
---|
1686 | echo = 2; |
---|
1687 | ring R = 0,(Y(1..45),Z),dp; |
---|
1688 | matrix A = getAgeneral(5); |
---|
1689 | print(A); |
---|
1690 | } |
---|
1691 | |
---|
1692 | ///////////////////////////////////// |
---|
1693 | |
---|
1694 | // helper |
---|
1695 | // Applies the action given by A. |
---|
1696 | static proc applyA(matrix A, int n0, list AMONS){ |
---|
1697 | // Define the map |
---|
1698 | // T_i --> phi(T_i) = A * T_i: |
---|
1699 | // store A*T[i] in H[1,i]: |
---|
1700 | matrix H[1][n0]; |
---|
1701 | |
---|
1702 | int l; |
---|
1703 | for(int k = 1; k <= n0; k++){ |
---|
1704 | for(l = 1; l <= size(AMONS); l++){ |
---|
1705 | H[1,k] = H[1,k] + A[k,l] * AMONS[l]; |
---|
1706 | } |
---|
1707 | } |
---|
1708 | |
---|
1709 | return(H); |
---|
1710 | } |
---|
1711 | example |
---|
1712 | { |
---|
1713 | echo = 2; |
---|
1714 | ring R = 0,(Y(1..45),Z),dp; |
---|
1715 | matrix AR = getAgeneral(5); |
---|
1716 | |
---|
1717 | ring S = 0,(T(1..5),Y(1..45),Z),dp; |
---|
1718 | matrix A = imap(R, AR); |
---|
1719 | print(A); |
---|
1720 | list AMONS = T(1), T(2), T(3), T(4), T(5), T(3)*T(5), T(4)*T(5), T(5)^2, T(5)^3; |
---|
1721 | int n0 = 5; |
---|
1722 | applyA(A, n0, AMONS); |
---|
1723 | } |
---|
1724 | |
---|
1725 | ////////////////////////////////////// |
---|
1726 | |
---|
1727 | // helper |
---|
1728 | // returns A * (generator corresponding to u) |
---|
1729 | // The action of A is stored in H. |
---|
1730 | static proc applyAtoGenerator(matrix u, matrix H, list KTwS, int n0){ |
---|
1731 | poly g0 = 0; |
---|
1732 | |
---|
1733 | for(int m = 1; m <= nrows(u); m++){ |
---|
1734 | if(u[m,1] != 0){ |
---|
1735 | intvec v = leadexp(KTwS[m]); // only the first n0 entries are interesting |
---|
1736 | poly g = u[m,1]; |
---|
1737 | |
---|
1738 | for(int x = 1; x <= n0; x++){ |
---|
1739 | g = g * H[1,x]^v[x]; |
---|
1740 | } |
---|
1741 | |
---|
1742 | g0 = g0 + g; |
---|
1743 | |
---|
1744 | kill v, g, x; |
---|
1745 | } |
---|
1746 | } |
---|
1747 | |
---|
1748 | return(g0); |
---|
1749 | } |
---|
1750 | |
---|
1751 | |
---|
1752 | ///////////////////////////////////// |
---|
1753 | |
---|
1754 | // helper |
---|
1755 | static proc linEqs(list IBw, list MON){ |
---|
1756 | // compute linear equations for the vector space IBw: |
---|
1757 | // the elements of the kernel MM correspond to linear forms: |
---|
1758 | // e.g., [1,0,-1,0] means S[1] - S[3]: |
---|
1759 | matrix B[size(IBw)][size(MON)]; |
---|
1760 | |
---|
1761 | for(int j = 1; j <= size(IBw); j++){ |
---|
1762 | B[j, 1..size(MON)] = IBw[j]; |
---|
1763 | } |
---|
1764 | |
---|
1765 | dbprint(printlevel, "Graded component as vectors:"); |
---|
1766 | dbprint(printlevel, B); |
---|
1767 | |
---|
1768 | // in this case, this computes the kernel |
---|
1769 | // (since there are only constant entries in B): |
---|
1770 | matrix M = syz(B); |
---|
1771 | |
---|
1772 | dbprint(printlevel, "Kernel:"); |
---|
1773 | dbprint(printlevel, M); |
---|
1774 | |
---|
1775 | return(M); |
---|
1776 | } |
---|
1777 | |
---|
1778 | ////////////////////////////////////// |
---|
1779 | |
---|
1780 | // helper |
---|
1781 | // creates the ring 0,(T(1..n0), Y(1..n1),Z),(dp(n0+n1),dp(1)); |
---|
1782 | static proc getFullRingS(intmat Q, int n0, int n1){ |
---|
1783 | intmat QS[nrows(Q)][ncols(Q)+1]; |
---|
1784 | |
---|
1785 | for(int l = 1; l <= ncols(Q); l++){ |
---|
1786 | QS[1..nrows(Q),l] = Q[1..nrows(Q),l]; |
---|
1787 | } |
---|
1788 | |
---|
1789 | string Sstr = "ring S = (" + charstr(basering) + "),(T(1..n0), Y(1..n1),Z),(dp(n0+n1),dp(1));"; |
---|
1790 | execute(Sstr); |
---|
1791 | setring S; |
---|
1792 | setBaseMultigrading(QS); |
---|
1793 | |
---|
1794 | return(S); |
---|
1795 | } |
---|
1796 | |
---|
1797 | ///////////////////////////////////// |
---|
1798 | |
---|
1799 | // helper |
---|
1800 | static proc monomials2basis(poly g0, list BMONS, int n0){ |
---|
1801 | // replace in g0 e.g. T[1]^2 by e_1: |
---|
1802 | // store coeffs for e_1 in Res[1] etc: |
---|
1803 | list RES; |
---|
1804 | |
---|
1805 | for(int m = 1; m <= size(BMONS); m++){ |
---|
1806 | RES[m] = 0; |
---|
1807 | } |
---|
1808 | |
---|
1809 | for(m = 1; m <= size(BMONS); m++){ |
---|
1810 | poly u0 = moncoef2(g0, BMONS[m], n0); |
---|
1811 | |
---|
1812 | if(u0 != 0){ |
---|
1813 | RES[m] = RES[m] + u0; |
---|
1814 | } |
---|
1815 | |
---|
1816 | kill u0; |
---|
1817 | } |
---|
1818 | |
---|
1819 | return(RES); |
---|
1820 | } |
---|
1821 | |
---|
1822 | ///////////////////////////////////// |
---|
1823 | |
---|
1824 | // helper |
---|
1825 | static proc getEqs(matrix MS, list RES){ |
---|
1826 | ideal GL; |
---|
1827 | |
---|
1828 | for(int m = 1; m <= ncols(MS); m++){ |
---|
1829 | poly f0 = 0; |
---|
1830 | |
---|
1831 | for(int l = 1; l <= nrows(MS); l++){ |
---|
1832 | f0 = f0 + RES[l] * MS[l,m]; |
---|
1833 | } |
---|
1834 | |
---|
1835 | GL[size(GL)+1] = f0; |
---|
1836 | kill f0, l; |
---|
1837 | } |
---|
1838 | |
---|
1839 | return(GL); |
---|
1840 | } |
---|
1841 | |
---|
1842 | ////////////////////////////////////// |
---|
1843 | |
---|
1844 | proc stabilizer(ideal RL, list #) |
---|
1845 | "USAGE: stabilizer(RL, A, BB, AMON, n0): RL is an ideal, A a matrix (standing for a subgroup of GL(n)), BB is an intmat (standing for an automorphism of the grading group), AMON a list of monomials corresponding to the rows/columns of A, n0 an integer such that the first n0 variables of the basering are the T(i), optional: a list of elementary divisors if there is torsion. |
---|
1846 | ASSUME: the basering must be graded (see setBaseMultigrading()) and the cone over |
---|
1847 | the degrees of the variables must be pointed; there mustn't be 0-degrees. The vector |
---|
1848 | w must be an element of the cone over the degrees of the variables. Moreover, B must be such that it permutes the degrees of the variables and the degrees of the generators of RL. |
---|
1849 | PURPOSE: returns relations such that A*I = I. |
---|
1850 | RETURN: a ring. Also exports an ideal Jexported and a list stabExported. |
---|
1851 | EXAMPLE: shows an example." |
---|
1852 | { |
---|
1853 | def R = basering; |
---|
1854 | intmat Q = getVariableWeights(); |
---|
1855 | |
---|
1856 | // torsion: |
---|
1857 | list TOR; |
---|
1858 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
1859 | TOR = #[1]; |
---|
1860 | } |
---|
1861 | |
---|
1862 | //list Components = stabPreprocessor(RL); |
---|
1863 | //list OmegaI = getOmegaI(RL); |
---|
1864 | int nTvars = nvars(basering); |
---|
1865 | list DegL = getGenDegsDims(RL, TOR); |
---|
1866 | |
---|
1867 | // output of aut_K(S): |
---|
1868 | def RR = autKS(TOR); // = \KK[Y_{ij},Z] |
---|
1869 | setring RR; |
---|
1870 | string AMONSstring = MONexported; // needed for later, dependent on T_i |
---|
1871 | |
---|
1872 | list listAutKS = autKSexported; |
---|
1873 | ideal J; // will be the result |
---|
1874 | list stabExported; // also export this |
---|
1875 | |
---|
1876 | // ring with both T_i and the Y_{ij} |
---|
1877 | int nYvars = nvars(basering) - 1; // no of Y variables |
---|
1878 | def S = getFullRingS(Q, nTvars, nYvars); // = \KK[T_k,Y_{ij},Z] |
---|
1879 | setring S; |
---|
1880 | |
---|
1881 | // prepare for later: |
---|
1882 | // matrix A = imap(RR, Agen); |
---|
1883 | execute("list AMONS = " + AMONSstring); // define AMONS |
---|
1884 | |
---|
1885 | int i; |
---|
1886 | setring RR; // KK[Y_i] |
---|
1887 | for(int p = 1; p <= size(listAutKS); p++){ |
---|
1888 | |
---|
1889 | matrix A = listAutKS[p][1]; |
---|
1890 | intmat BB = listAutKS[p][2]; |
---|
1891 | ideal JBA = listAutKS[p][3]; |
---|
1892 | |
---|
1893 | if(!isDimInvar(BB, DegL, TOR)){ |
---|
1894 | dbprint(printlevel, "B was not diminvar."); |
---|
1895 | |
---|
1896 | kill A, BB, JBA; |
---|
1897 | } else { |
---|
1898 | |
---|
1899 | setring S; |
---|
1900 | ideal EQs; |
---|
1901 | |
---|
1902 | setring R; // = \KK[T_i] |
---|
1903 | |
---|
1904 | // go through each generator g of the ideal RL: |
---|
1905 | // compute a basis for RL_deg(g), linear equations |
---|
1906 | for(i = 1; i <= size(RL); i++){ |
---|
1907 | dbprint(printlevel, "computing stabilizer: starting loop with i = " + string(i)); |
---|
1908 | |
---|
1909 | // w = multidegree and reduce later entries |
---|
1910 | // if there is torsion: |
---|
1911 | intvec w = multiDegRedTor(RL[i], TOR); |
---|
1912 | |
---|
1913 | // compute a basis KTw of \KK[T_1,...,T_r]_w: |
---|
1914 | list KTw = wmonomials(w, 0, TOR); |
---|
1915 | |
---|
1916 | // compute a basis Iw of I_w: |
---|
1917 | // I_w will be a subspace of KTw: |
---|
1918 | list L = gradedCompIdeal(RL, w, 0, TOR); |
---|
1919 | list Iw = L[2]; |
---|
1920 | list MON = L[1]; |
---|
1921 | |
---|
1922 | // compute a basis IBw of I_(B*w) if B*w != w: |
---|
1923 | // I_(B*w) will be a subspace of KTBw: |
---|
1924 | intvec Bw = BB * w; |
---|
1925 | |
---|
1926 | if(Bw != w){ |
---|
1927 | list LB = gradedCompIdeal(RL, Bw, 0, TOR); |
---|
1928 | list IBw = LB[2]; |
---|
1929 | list BMON = LB[1]; |
---|
1930 | } else { |
---|
1931 | list LB = L; |
---|
1932 | list IBw = L[2]; |
---|
1933 | list BMON = L[1]; |
---|
1934 | } |
---|
1935 | |
---|
1936 | matrix M = linEqs(IBw, MON); // kernel computation |
---|
1937 | |
---|
1938 | // Define the map |
---|
1939 | // T_i --> phi(T_i) = A * T_i: |
---|
1940 | // store A*T[i] in H[1,i]: |
---|
1941 | setring S; |
---|
1942 | matrix A = imap(RR, A); |
---|
1943 | matrix H = applyA(A, nTvars, AMONS); |
---|
1944 | |
---|
1945 | dbprint(printlevel, "the map phi (stored in H[1,j] = A*T_j):"); |
---|
1946 | dbprint(printlevel, H); |
---|
1947 | |
---|
1948 | // for each basis vector u of Iw: |
---|
1949 | // form g0 := A * (current generator) = Sum A*u_i where u_i <> 0: |
---|
1950 | list IwS = imap(R, Iw); |
---|
1951 | list KTwS = imap(R, KTw); |
---|
1952 | |
---|
1953 | for(int k = 1; k <= size(IwS); k++){ |
---|
1954 | matrix u = IwS[k]; // ... x 1 matrix |
---|
1955 | |
---|
1956 | poly g0 = applyAtoGenerator(u, H, KTwS, nTvars); |
---|
1957 | |
---|
1958 | dbprint(printlevel, "Iw="); |
---|
1959 | dbprint(printlevel, IwS); |
---|
1960 | dbprint(printlevel, "current basis vector u of Iw:"); |
---|
1961 | dbprint(printlevel, u); |
---|
1962 | dbprint(printlevel, "g0 = A * (current generator) = "); |
---|
1963 | dbprint(printlevel, g0); |
---|
1964 | |
---|
1965 | // replace in g0 e.g. T[1]^2 by e_1: |
---|
1966 | // store coeffs for e_1 in Res[1] etc: |
---|
1967 | |
---|
1968 | // NOTE: I_w gets mapped to I_(B*w): |
---|
1969 | list BMON = imap(R, BMON); |
---|
1970 | list RES = monomials2basis(g0, BMON, nTvars); // AMONS = BMONS? |
---|
1971 | |
---|
1972 | dbprint(printlevel, "after replacing in g0 e.g. T[1]^2 by e_1: (where e_i <--> KTwS[i]), RES = "); |
---|
1973 | dbprint(printlevel, RES); |
---|
1974 | matrix MS = imap(R, M); |
---|
1975 | ideal GL = getEqs(MS, RES); |
---|
1976 | |
---|
1977 | if(size(EQs) == 0){ |
---|
1978 | EQs = GL[1..size(GL)]; |
---|
1979 | } else { |
---|
1980 | EQs = EQs, GL[1..size(GL)]; |
---|
1981 | } |
---|
1982 | |
---|
1983 | dbprint(printlevel, "applying the linear forms of the kernel MS = "); |
---|
1984 | dbprint(printlevel, MS); |
---|
1985 | dbprint(printlevel, "yields equations GL = "); |
---|
1986 | dbprint(printlevel, GL); |
---|
1987 | dbprint(printlevel, "Total equations so far = EQs = "); |
---|
1988 | dbprint(printlevel, EQs); |
---|
1989 | |
---|
1990 | kill MS, GL, u, BMON, g0, RES; |
---|
1991 | setring S; |
---|
1992 | } |
---|
1993 | |
---|
1994 | setring S; |
---|
1995 | kill IwS, KTwS, A, H; |
---|
1996 | |
---|
1997 | setring R; |
---|
1998 | kill M, w, KTw, L, Iw, MON, Bw, LB, IBw, BMON; |
---|
1999 | } |
---|
2000 | |
---|
2001 | //kill k; |
---|
2002 | |
---|
2003 | setring RR; |
---|
2004 | ideal JBAnew = JBA + imap(S, EQs); |
---|
2005 | stabExported[size(stabExported) + 1] = list(A, BB, JBAnew); |
---|
2006 | |
---|
2007 | if(size(J) == 0){ |
---|
2008 | J = JBAnew; |
---|
2009 | } else { |
---|
2010 | //J = J * JBAnew; |
---|
2011 | J = intersect(J, JBAnew); // in Singular, intersection is usually quicker |
---|
2012 | } |
---|
2013 | |
---|
2014 | |
---|
2015 | setring S; |
---|
2016 | kill EQs; |
---|
2017 | setring RR; |
---|
2018 | kill JBAnew, BB, A, JBA; |
---|
2019 | } |
---|
2020 | } |
---|
2021 | |
---|
2022 | // return the ring RR, export the ideal J: |
---|
2023 | setring RR; |
---|
2024 | ideal Jexported = J; |
---|
2025 | export(Jexported); |
---|
2026 | export(stabExported); |
---|
2027 | |
---|
2028 | return(RR); |
---|
2029 | } |
---|
2030 | example |
---|
2031 | { |
---|
2032 | echo=2; |
---|
2033 | |
---|
2034 | ////////////////// |
---|
2035 | // example: fano 15: |
---|
2036 | intmat Q[1][5] = 3,3,2,2,1; |
---|
2037 | ring R = 0,T(1..5),dp; |
---|
2038 | |
---|
2039 | // attach degree matrix Q to R: |
---|
2040 | setBaseMultigrading(Q); |
---|
2041 | |
---|
2042 | ideal I = T(1)*T(2) + T(3)^2*T(4) + T(5)^6; |
---|
2043 | def RR = stabilizer(I); |
---|
2044 | setring RR; |
---|
2045 | RR; |
---|
2046 | Jexported; |
---|
2047 | dim(std(Jexported)); |
---|
2048 | getVariableWeights(); |
---|
2049 | |
---|
2050 | kill RR, Q, R; |
---|
2051 | |
---|
2052 | ///////////// |
---|
2053 | // example 3.14 from the paper |
---|
2054 | intmat Q[3][5] = |
---|
2055 | 1,1,1,1,1, |
---|
2056 | 1,-1,0,0,1, |
---|
2057 | 1,1,1,0,0; |
---|
2058 | |
---|
2059 | list TOR = 2; |
---|
2060 | ring R = 0,T(1..5),dp; |
---|
2061 | |
---|
2062 | // attach degree matrix Q to R: |
---|
2063 | setBaseMultigrading(Q); |
---|
2064 | |
---|
2065 | ideal I = T(1)*T(2) + T(3)^2 + T(4)^2; |
---|
2066 | list TOR = 2; |
---|
2067 | def RR = stabilizer(I, TOR); |
---|
2068 | setring RR; |
---|
2069 | RR; |
---|
2070 | Jexported; |
---|
2071 | dim(std(Jexported)); |
---|
2072 | |
---|
2073 | stabExported; |
---|
2074 | kill RR, Q, R; |
---|
2075 | } |
---|
2076 | |
---|
2077 | |
---|
2078 | ////////////////////////////////// |
---|
2079 | |
---|
2080 | // helper: |
---|
2081 | // computes the multidegree of f and reduces its later entries |
---|
2082 | // mod TOR[i] if # is defined |
---|
2083 | static proc multiDegRedTor(poly f, list #){ |
---|
2084 | list TOR; |
---|
2085 | |
---|
2086 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2087 | TOR = #[1]; |
---|
2088 | } |
---|
2089 | |
---|
2090 | intmat Q = getVariableWeights(); |
---|
2091 | intvec w = multiDeg(f); |
---|
2092 | |
---|
2093 | // reduce w if there is torsion: |
---|
2094 | return(reduceIntvec(w, TOR)); |
---|
2095 | } |
---|
2096 | |
---|
2097 | /////////////////////////////////// |
---|
2098 | |
---|
2099 | // helper: |
---|
2100 | // reduce later entries of w0 |
---|
2101 | // mod TOR[i] if TOR is non-empty: |
---|
2102 | static proc reduceIntvec(intvec w0, list TOR){ |
---|
2103 | intvec w = w0; |
---|
2104 | int pos; |
---|
2105 | |
---|
2106 | for(int l = 1; l <= size(TOR); l++){ |
---|
2107 | pos = size(w0) - size(TOR) + l; |
---|
2108 | w[pos] = w[pos] mod TOR[l]; |
---|
2109 | |
---|
2110 | // make positive: |
---|
2111 | if(w[pos] < 0){ |
---|
2112 | w[pos] = w[pos] + TOR[l]; |
---|
2113 | } |
---|
2114 | } |
---|
2115 | |
---|
2116 | return(w); |
---|
2117 | } |
---|
2118 | |
---|
2119 | ///////////////////////////////// |
---|
2120 | |
---|
2121 | static proc moncoef2(poly f, poly mon, int n0) |
---|
2122 | "USAGE: moncoef(f, mon): f is a polynomial, mon a monomial, n0 an integer. |
---|
2123 | PURPOSE: returns the (not necessarily constant) coefficient of mon in f. |
---|
2124 | For example the coefficient of T(1)^2 in T(1)^2*T(2) will be T(2). |
---|
2125 | The integer n0 means that the variables var(n0+1),... will be considered to be coefficients. |
---|
2126 | RETURN: a ring element. |
---|
2127 | EXAMPLE: shows an example." |
---|
2128 | { |
---|
2129 | poly p = f; |
---|
2130 | poly res = 0; |
---|
2131 | |
---|
2132 | while (p != 0) { |
---|
2133 | poly lp = lead(p) / mon; |
---|
2134 | |
---|
2135 | if(lp != 0){ |
---|
2136 | // test wether there is still some T(i)-factor in lp: |
---|
2137 | for(int i = 1; i <= n0; i++){ |
---|
2138 | lp = subst(lp, var(i), 0); |
---|
2139 | } |
---|
2140 | |
---|
2141 | if(lp != 0){ |
---|
2142 | //return(lp); |
---|
2143 | res = res + lp; |
---|
2144 | } |
---|
2145 | |
---|
2146 | kill i; |
---|
2147 | } |
---|
2148 | |
---|
2149 | p = p - lead(p); |
---|
2150 | |
---|
2151 | kill lp; |
---|
2152 | } |
---|
2153 | |
---|
2154 | return(res); |
---|
2155 | } |
---|
2156 | example |
---|
2157 | { |
---|
2158 | echo=2; |
---|
2159 | |
---|
2160 | ring R = (0,a),T(1..4),dp; |
---|
2161 | |
---|
2162 | poly f = T(1)^2*T(2)^3 + 7*a*T(3)^3 -8*T(3)^2 +7; |
---|
2163 | poly mon = T(3)^3; |
---|
2164 | poly mon = 1; |
---|
2165 | |
---|
2166 | moncoef2(f, mon,4); |
---|
2167 | |
---|
2168 | // example 2: |
---|
2169 | ring R = 0,(T(1..3), Y(1..12)),dp; |
---|
2170 | poly f = T(1)^2*Y(1)^2 + Y(9)*T(1)*Y(10)^2*T(1); |
---|
2171 | poly m = T(1)^2; |
---|
2172 | |
---|
2173 | // only the first three variables |
---|
2174 | // are considered for taking the coefficent: |
---|
2175 | moncoef2(f, m, 3); |
---|
2176 | } |
---|
2177 | |
---|
2178 | ////////////////////////////// |
---|
2179 | |
---|
2180 | // helper |
---|
2181 | static proc fixesDim(intmat B, list ABL, list TOR){ |
---|
2182 | // ABL is of shape |
---|
2183 | // [1]: |
---|
2184 | // [1]: |
---|
2185 | // 2 = dim of basering_w |
---|
2186 | // [2]: |
---|
2187 | // 1,0 = w |
---|
2188 | // [3]: = generators of basering_w |
---|
2189 | // [1]: |
---|
2190 | // T(2) |
---|
2191 | // [2]: |
---|
2192 | // T(1) |
---|
2193 | int j; |
---|
2194 | for(int i = 1; i <= size(ABL); i++){ |
---|
2195 | int dimw = ABL[i][1]; // the dimension |
---|
2196 | intvec w = ABL[i][2]; // the weight vector |
---|
2197 | intvec Bw = reduceIntvec(B * w, TOR); // Bw must appear among some ABL[j] |
---|
2198 | |
---|
2199 | for(j = 1; j <= size(ABL); j++){ |
---|
2200 | if(ABL[j][2] == Bw){ |
---|
2201 | if(ABL[j][1] != dimw){ |
---|
2202 | return(0); |
---|
2203 | } |
---|
2204 | |
---|
2205 | break; |
---|
2206 | } |
---|
2207 | } |
---|
2208 | |
---|
2209 | if(j > size(ABL)){ |
---|
2210 | ERROR("B * w not found among generator weights. This should not happen."); |
---|
2211 | } |
---|
2212 | |
---|
2213 | kill dimw, w, Bw; |
---|
2214 | } |
---|
2215 | |
---|
2216 | return(1); |
---|
2217 | } |
---|
2218 | |
---|
2219 | /////////////////////////////// |
---|
2220 | |
---|
2221 | proc autKS(list #) |
---|
2222 | "USAGE: autKS(TOR); TOR: optional list of elementary divisors in case of torsion. |
---|
2223 | ASSUME: the basering is multigraded having used the command setBaseMultigrading(Q) from 'multigrading.lib'. |
---|
2224 | PURPOSE: Compute the subgroup Aut_K(S) of GL(n) of graded automorphisms of the polynomial ring S (the basering). |
---|
2225 | RETURN: returns a ring S and exports an ideal ideal Iexported in the coordinate ring S = K[Y_ij] of GL(n) such that Aut_K(S) = V(I). |
---|
2226 | EXAMPLE: shows an example." |
---|
2227 | { |
---|
2228 | list TOR; |
---|
2229 | |
---|
2230 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2231 | TOR = #[1]; |
---|
2232 | } |
---|
2233 | |
---|
2234 | def R = basering; |
---|
2235 | int n0 = nvars(basering); |
---|
2236 | |
---|
2237 | list BL = allMonomials(ideal(0), TOR); //list BL = allMonomials(RL, TOR); |
---|
2238 | list MONS = sortMons(BL); |
---|
2239 | |
---|
2240 | // needed later for the S-admissible equations: |
---|
2241 | // Note: the 2nd components of the elements of BL |
---|
2242 | // are the origs so use BL: |
---|
2243 | // form first the list of all [w, [M, N]] |
---|
2244 | // where M and N contain the monomials T^a, T^b |
---|
2245 | // such that deg(T^(a+b)) = w. |
---|
2246 | list sums = origsSumUp(BL, TOR); |
---|
2247 | list adMons = getSadmissibleMonomials(sums); |
---|
2248 | int nadMons = size(adMons); |
---|
2249 | |
---|
2250 | // create formal matrix out of this: |
---|
2251 | // phi(R_w) = R_w for all w in Orig and all automorphisms phi. |
---|
2252 | def S = createAutMatrix(BL); |
---|
2253 | setring S; |
---|
2254 | basering; |
---|
2255 | |
---|
2256 | matrix A = Aexported; |
---|
2257 | list AMON = MONSexported; |
---|
2258 | string MONexported = string(AMON); |
---|
2259 | int n = size(MONSexported); |
---|
2260 | |
---|
2261 | dbprint(printlevel, ".... matrix A, the monomials corresponding to rows/cols:..."); |
---|
2262 | dbprint(printlevel, A); |
---|
2263 | dbprint(printlevel, AMON); |
---|
2264 | |
---|
2265 | // will be needed later for grading: |
---|
2266 | intmat Qnew = getCharacteristicGrading(AMON, TOR); |
---|
2267 | |
---|
2268 | // compute originary weights: |
---|
2269 | // return the elements as permutation matrices |
---|
2270 | setring R; |
---|
2271 | intmat Q = getVariableWeights(); |
---|
2272 | list Autor0 = autGenWeights(Q, TOR); |
---|
2273 | |
---|
2274 | // redefine omegaSdiagEqs as the product |
---|
2275 | // omegaSdiagEqs * (B^* omegaSdiagEqs) |
---|
2276 | // where B in Autor0: |
---|
2277 | setring S; |
---|
2278 | ideal J; |
---|
2279 | |
---|
2280 | // convert the elements of Autor0 to permutation matrices: |
---|
2281 | list Autor; |
---|
2282 | list ABL = imap(R, BL); |
---|
2283 | |
---|
2284 | for(int i = 1; i <= size(Autor0); i++){ |
---|
2285 | if(fixesDim(Autor0[i], ABL, TOR)){ |
---|
2286 | Autor[size(Autor)+1] = matrix2compper(Autor0[i], ABL, AMON, Q, TOR); // of type matrix |
---|
2287 | } else { |
---|
2288 | dbprint(printlevel, "Did not fix dimension."); |
---|
2289 | dbprint(printlevel, string(Autor0[i])); |
---|
2290 | } |
---|
2291 | } |
---|
2292 | |
---|
2293 | dbprint(printlevel, ".... automorphisms of the originary weight vectors as permutation matrices: ...."); |
---|
2294 | dbprint(printlevel, Autor); |
---|
2295 | |
---|
2296 | // equations cutting out the S-admissible matrices: |
---|
2297 | // A*(T^(a + b)) - (A*(T^a))(A*(T^b)) = 0 |
---|
2298 | // where A*f means to substitute T_i by sum(A_(i*)T_j): |
---|
2299 | list MONS = imap(R, MONS); |
---|
2300 | list adMons; |
---|
2301 | |
---|
2302 | if(nadMons > 0){ |
---|
2303 | adMons = imap(R, adMons); |
---|
2304 | } |
---|
2305 | |
---|
2306 | // add determinant condition: |
---|
2307 | // we need one more variable for this: |
---|
2308 | def S2 = adjoinVar(n0); |
---|
2309 | setring S2; |
---|
2310 | poly deter; // we need to store it for the grading |
---|
2311 | |
---|
2312 | ideal J = 1; // init with 1 --> used for product later |
---|
2313 | list listAutKS; // elements are of shape list(BA, B, equations for BA) |
---|
2314 | setring S; |
---|
2315 | |
---|
2316 | for(i = 1; i <= size(Autor); i++){ |
---|
2317 | intmat BB = Autor0[i]; |
---|
2318 | intmat B = Autor[i]; |
---|
2319 | |
---|
2320 | // compute B*A and then admissible equations |
---|
2321 | matrix BA = B*A; |
---|
2322 | |
---|
2323 | dbprint(printlevel, "Starting computation of admissible equations:"); |
---|
2324 | |
---|
2325 | ideal Iadmiss = getAdmissibleEquations(adMons, BA, n0, MONS); |
---|
2326 | dbprint(printlevel, "Admissible equations: done."); |
---|
2327 | |
---|
2328 | BA = relabelEntries(BA, n0); |
---|
2329 | |
---|
2330 | dbprint(printlevel, "permuted matrix A:"); |
---|
2331 | dbprint(printlevel, BA); |
---|
2332 | |
---|
2333 | // add variable Y((i-1)*n+j) to Jexported |
---|
2334 | // if BA[i,j] = 0 where 1 <= i <= n0: |
---|
2335 | ideal omegaSdiagEqs = getMonomialsFor0Entries(BA, n0); |
---|
2336 | |
---|
2337 | // also store in listAutKS |
---|
2338 | // will be useful for stabilizer |
---|
2339 | setring S2; |
---|
2340 | matrix BA2 = imap(S, BA); |
---|
2341 | |
---|
2342 | dbprint(printlevel, "computing determinant..."); |
---|
2343 | deter = det(BA2); |
---|
2344 | poly detEq = deter * Z - 1; |
---|
2345 | dbprint(printlevel, "Determinant: done."); |
---|
2346 | |
---|
2347 | ideal JBA = imap(S, Iadmiss) + imap(S, omegaSdiagEqs) + ideal(detEq); |
---|
2348 | listAutKS[size(listAutKS) + 1] = list(BA2, BB, JBA, MONexported); // MONexported is an explanatory string |
---|
2349 | |
---|
2350 | dbprint(printlevel, "Computing intersection of ideals..."); |
---|
2351 | //J = J * JBA; |
---|
2352 | J = intersect(J, JBA); // in Singular, this is usually quicker |
---|
2353 | dbprint(printlevel, "Intersection of ideal: done."); |
---|
2354 | |
---|
2355 | kill JBA, detEq, BA2; |
---|
2356 | setring S; |
---|
2357 | kill BA, B, BB, Iadmiss, omegaSdiagEqs; |
---|
2358 | } |
---|
2359 | |
---|
2360 | setring S2; |
---|
2361 | |
---|
2362 | setGLnGrading(Qnew, deter); |
---|
2363 | ideal Iexported = J; //imap(S, J) + ideal(detEq); |
---|
2364 | list autKSexported = listAutKS; |
---|
2365 | |
---|
2366 | export(Iexported); |
---|
2367 | export(autKSexported); // list of elements of shape list(A, B) |
---|
2368 | export(MONexported); |
---|
2369 | return(S2); |
---|
2370 | } |
---|
2371 | example |
---|
2372 | { |
---|
2373 | echo=2; |
---|
2374 | |
---|
2375 | ////////////////// |
---|
2376 | // example: fano 15: |
---|
2377 | intmat Q[1][5] = 3,3,2,2,1; |
---|
2378 | ring R = 0,T(1..5),dp; |
---|
2379 | |
---|
2380 | // attach degree matrix Q to R: |
---|
2381 | setBaseMultigrading(Q); |
---|
2382 | |
---|
2383 | //ideal I = T(1)*T(2) + T(3)^2*T(4) + T(5)^6; |
---|
2384 | def S = autKS(); |
---|
2385 | setring S; |
---|
2386 | |
---|
2387 | dim(std(Iexported)); |
---|
2388 | basering; |
---|
2389 | |
---|
2390 | autKSexported; |
---|
2391 | getVariableWeights(); |
---|
2392 | |
---|
2393 | kill S, Q, R; |
---|
2394 | |
---|
2395 | ///////////// |
---|
2396 | // example 3.14 from the paper |
---|
2397 | intmat Q[3][5] = |
---|
2398 | 1,1,1,1,1, |
---|
2399 | 1,-1,0,0,1, |
---|
2400 | 1,1,1,0,0; |
---|
2401 | |
---|
2402 | list TOR = 2; |
---|
2403 | ring R = 0,T(1..5),dp; |
---|
2404 | |
---|
2405 | // attach degree matrix Q to R: |
---|
2406 | setBaseMultigrading(Q); |
---|
2407 | |
---|
2408 | //ideal I = T(1)*T(2) + T(3)^2 + T(4)^2; |
---|
2409 | def S = autKS(); |
---|
2410 | setring S; |
---|
2411 | |
---|
2412 | Iexported; |
---|
2413 | print(getVariableWeights()); |
---|
2414 | kill S, R, Q; |
---|
2415 | } |
---|
2416 | |
---|
2417 | //////////////////////////////////// |
---|
2418 | |
---|
2419 | // helper |
---|
2420 | static proc setGLnGrading(intmat Qnew, poly deter, list #){ |
---|
2421 | list TOR; |
---|
2422 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2423 | TOR = #[1]; |
---|
2424 | } |
---|
2425 | |
---|
2426 | // set deg(Y_ij) = j-th col of Qnew |
---|
2427 | int k = nrows(Qnew); |
---|
2428 | int n = ncols(Qnew); |
---|
2429 | |
---|
2430 | // the last variable is the rabinovic trick variable Z |
---|
2431 | int nv = nvars(basering) - 1; |
---|
2432 | intmat Qlarge[nrows(Qnew)][nv + 1]; |
---|
2433 | |
---|
2434 | for(int m = 1; m <= nv; m++){ |
---|
2435 | int i = m div n; // 9 div 9 = 1 |
---|
2436 | int j = m mod n; |
---|
2437 | |
---|
2438 | if(j == 0){ // 9 --> i = 0, j = 9 |
---|
2439 | i = i - 1; |
---|
2440 | j = n; |
---|
2441 | } |
---|
2442 | |
---|
2443 | Qlarge[1..k, m] = Qnew[1..k, j]; |
---|
2444 | kill i, j; |
---|
2445 | } |
---|
2446 | |
---|
2447 | // grading is valid for all variables |
---|
2448 | // except Z: use it for deter: |
---|
2449 | setBaseMultigrading(Qlarge); |
---|
2450 | |
---|
2451 | // treat the last variable Z: |
---|
2452 | // deg(deter) = - deg(Z): |
---|
2453 | intvec degDet = reduceIntvec(- multiDeg(deter), TOR); |
---|
2454 | Qlarge[1..k, nvars(basering)] = degDet[1..size(degDet)]; |
---|
2455 | |
---|
2456 | // now set the final grading |
---|
2457 | setBaseMultigrading(Qlarge); |
---|
2458 | } |
---|
2459 | |
---|
2460 | //////////////////////////////////// |
---|
2461 | |
---|
2462 | // helper |
---|
2463 | static proc adjoinVar(int n0){ |
---|
2464 | string S2str = "ring S2 = (" + charstr(basering) + "),(("; |
---|
2465 | |
---|
2466 | for(int i = n0 + 1; i <= nvars(basering); i++){ |
---|
2467 | S2str = S2str + string(var(i)); |
---|
2468 | |
---|
2469 | if(i < nvars(basering)){ |
---|
2470 | S2str = S2str + ", "; |
---|
2471 | } else { |
---|
2472 | S2str = S2str + "), Z),(dp(nvars(basering) - n0), dp(1))"; |
---|
2473 | } |
---|
2474 | } |
---|
2475 | |
---|
2476 | execute(S2str); |
---|
2477 | return(S2); |
---|
2478 | } |
---|
2479 | |
---|
2480 | |
---|
2481 | ///////////////////////////////////// |
---|
2482 | |
---|
2483 | // helper |
---|
2484 | static proc getMonomialsFor0Entries(matrix BA, int n0) { |
---|
2485 | ideal relB; |
---|
2486 | int j; |
---|
2487 | |
---|
2488 | for(int i = 1; i <= n0; i++){ |
---|
2489 | for( j = 1; j <= ncols(BA); j++){ |
---|
2490 | if(BA[i,j] == 0){ |
---|
2491 | relB[size(relB)+1] = Y((i-1)*ncols(BA)+j); |
---|
2492 | } |
---|
2493 | } |
---|
2494 | } |
---|
2495 | |
---|
2496 | return(relB); |
---|
2497 | } |
---|
2498 | |
---|
2499 | ///////////////////////////////////// |
---|
2500 | |
---|
2501 | // helper |
---|
2502 | static proc getAdmissibleEquations(list adMons, matrix A, int n0, list MONS){ |
---|
2503 | // S is the name of the current basering when calling this function, S --> S |
---|
2504 | ideal imageVars; // images of the T_i |
---|
2505 | int j; |
---|
2506 | |
---|
2507 | for(int i = 1; i <= n0; i++){ |
---|
2508 | imageVars[i] = 0; |
---|
2509 | |
---|
2510 | for(j = 1; j <= size(MONS); j++){ |
---|
2511 | imageVars[i] = imageVars[i] + A[i, j] * MONS[j]; |
---|
2512 | } |
---|
2513 | } |
---|
2514 | def S = basering; |
---|
2515 | map applyA = S, imageVars; |
---|
2516 | |
---|
2517 | // go through all possiblities: |
---|
2518 | int k, l; |
---|
2519 | ideal IadmissibleExported; |
---|
2520 | |
---|
2521 | for(i = 1; i <= size(adMons); i++){ |
---|
2522 | list AL = adMons[i][2][1]; |
---|
2523 | list BL = adMons[i][2][2]; |
---|
2524 | |
---|
2525 | for(k = 1; k <= size(AL); k++){ |
---|
2526 | for(l = 1; l <= size(BL); l++){ |
---|
2527 | poly Ta = AL[k]; |
---|
2528 | poly Tb = BL[l]; |
---|
2529 | poly Tab = Ta * Tb; |
---|
2530 | |
---|
2531 | IadmissibleExported[size(IadmissibleExported) + 1] = applyA(Tab) - applyA(Ta) * applyA(Tb); |
---|
2532 | |
---|
2533 | kill Tab, Ta, Tb; |
---|
2534 | } |
---|
2535 | } |
---|
2536 | |
---|
2537 | kill AL, BL; |
---|
2538 | } |
---|
2539 | |
---|
2540 | return(IadmissibleExported); |
---|
2541 | } |
---|
2542 | |
---|
2543 | /////////////////////////////////////// |
---|
2544 | |
---|
2545 | // Get generator degrees w1,...,ws --> store in GenDegs. |
---|
2546 | // Also compute dimensions of I_wi where wi in GenDegs: |
---|
2547 | static proc getGenDegsDims(ideal I, list TOR){ |
---|
2548 | list GenDegs; |
---|
2549 | list GenDims; |
---|
2550 | int i = 1; |
---|
2551 | int c = 1; |
---|
2552 | |
---|
2553 | while(c <= size(I)){ // there may be 0-entries in I |
---|
2554 | if(I[i] != 0){ |
---|
2555 | c++; |
---|
2556 | |
---|
2557 | GenDegs[i] = reduceIntvec(multiDeg(I[i]), TOR); |
---|
2558 | list L = gradedCompIdeal(I, GenDegs[i], 0, TOR); //gradedcompbasis(I, GenDegs[i], TOR); |
---|
2559 | GenDims[i] = size(L[1]); // this is dim(R_(deg f_i)), not dim(I_(deg f_i)) |
---|
2560 | |
---|
2561 | kill L; |
---|
2562 | } |
---|
2563 | |
---|
2564 | i++; |
---|
2565 | } |
---|
2566 | |
---|
2567 | list RES; |
---|
2568 | RES[1] = GenDegs; |
---|
2569 | RES[2] = GenDims; |
---|
2570 | |
---|
2571 | return(RES); |
---|
2572 | } |
---|
2573 | |
---|
2574 | /////////////////////////////////// |
---|
2575 | |
---|
2576 | // helper: |
---|
2577 | // checks a given matrix B in Autor0 |
---|
2578 | // if it satisfies dim(I_wi) = dim(I_(B*wi)) |
---|
2579 | // for all i where w1,...,ws |
---|
2580 | // are the generator degrees of I. |
---|
2581 | static proc isDimInvar(intmat B, list GenDegsDims, list TOR){ |
---|
2582 | list GenDegs = GenDegsDims[1]; |
---|
2583 | list GenDims = GenDegsDims[2]; |
---|
2584 | |
---|
2585 | // return true iff B is |
---|
2586 | // such that dim(I_wi) = dim(I_(B*wi)) |
---|
2587 | // holds for all i, where wi in GenDegs: |
---|
2588 | int j; |
---|
2589 | |
---|
2590 | for(j = 1; j <= size(GenDegs); j++){ |
---|
2591 | intvec wj = GenDegs[j]; |
---|
2592 | |
---|
2593 | //intvec Bwj = B * wj; |
---|
2594 | intvec Bwj = reduceIntvec(intvec(B * wj), TOR); |
---|
2595 | |
---|
2596 | // find out dim(I_Bwj): |
---|
2597 | int dimBwj; |
---|
2598 | for(int bb = 1; bb <= size(GenDegs); bb++){ |
---|
2599 | if(GenDegs[bb] == Bwj){ |
---|
2600 | dimBwj = GenDims[bb]; |
---|
2601 | break; |
---|
2602 | } |
---|
2603 | } |
---|
2604 | |
---|
2605 | // if dim(I_wi) != dim(I_(B*wi)), then B is not valid. |
---|
2606 | if(dimBwj != GenDims[j]){ |
---|
2607 | return(0); |
---|
2608 | } |
---|
2609 | |
---|
2610 | kill bb, wj, Bwj, dimBwj; |
---|
2611 | } |
---|
2612 | |
---|
2613 | return(1); |
---|
2614 | } |
---|
2615 | |
---|
2616 | |
---|
2617 | //////////////////////////////////////// |
---|
2618 | |
---|
2619 | static proc getSadmissibleMonomials(list sums){ |
---|
2620 | list Combs; |
---|
2621 | |
---|
2622 | // the elements of sums are of shape |
---|
2623 | // Comb = [c, [a,b]] where c = a + b. |
---|
2624 | // Form first the list of all [K, [M, N]] |
---|
2625 | // where M and N contain the monomials T^a, T^b |
---|
2626 | // such that deg(T^(a+b)) = deg(T^c) for each T^c in K. |
---|
2627 | for(int i= 1; i <= size(sums); i++){ |
---|
2628 | list K = wmonomials(sums[i][1], 0); // as monomials |
---|
2629 | list M = wmonomials(sums[i][2][1], 0); // as monomials |
---|
2630 | list N = wmonomials(sums[i][2][2], 0); // as monomials |
---|
2631 | |
---|
2632 | Combs[size(Combs) + 1] = list(K, list(M, N)); |
---|
2633 | |
---|
2634 | kill M, N, K; |
---|
2635 | } |
---|
2636 | |
---|
2637 | return(Combs); |
---|
2638 | } |
---|
2639 | |
---|
2640 | /////////////////////////////////////// |
---|
2641 | |
---|
2642 | // helper |
---|
2643 | static proc origsSumUp(list BL, list #) { |
---|
2644 | list TOR; |
---|
2645 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2646 | TOR = #[1]; |
---|
2647 | } |
---|
2648 | |
---|
2649 | list RES; // elements of the form [c, [a,b]] such that c=a+b |
---|
2650 | int j, k; |
---|
2651 | |
---|
2652 | // note: the 2nd components of the entries |
---|
2653 | // of BL are the origs |
---|
2654 | for(int i = 1; i <= size(BL); i++){ |
---|
2655 | for(j = 1; j <= size(BL); j++){ |
---|
2656 | intvec sum = reduceIntvec(BL[i][2] + BL[j][2], TOR); |
---|
2657 | |
---|
2658 | // check if sum is not already in RES (no duplicates): |
---|
2659 | for(k = 1; k <= size(RES); k++){ |
---|
2660 | if(RES[k][1] == sum){ |
---|
2661 | break; |
---|
2662 | } |
---|
2663 | } |
---|
2664 | |
---|
2665 | if(k > size(RES)){ // then is it new |
---|
2666 | // check if sum is also in Origs |
---|
2667 | for(k = 1; k <= size(BL); k++){ |
---|
2668 | if(BL[k][2] == sum){ |
---|
2669 | RES[size(RES) + 1] = list(sum, list(BL[i][2], BL[j][2])); |
---|
2670 | } |
---|
2671 | } |
---|
2672 | } |
---|
2673 | |
---|
2674 | kill sum; |
---|
2675 | } |
---|
2676 | } |
---|
2677 | |
---|
2678 | return(RES); |
---|
2679 | } |
---|
2680 | example |
---|
2681 | { |
---|
2682 | echo = 2; |
---|
2683 | |
---|
2684 | // 1st example |
---|
2685 | list BL = |
---|
2686 | list(0, intvec(2,1), 0), |
---|
2687 | list(0, intvec(1,1), 0), |
---|
2688 | list(0, intvec(1,0), 0), |
---|
2689 | list(0, intvec(2,1), 0); |
---|
2690 | |
---|
2691 | list TOR = 2; |
---|
2692 | |
---|
2693 | origsSumUp(BL); |
---|
2694 | kill BL; |
---|
2695 | |
---|
2696 | // 2nd example |
---|
2697 | list BL = |
---|
2698 | list(0, intvec(3), 0), |
---|
2699 | list(0, intvec(3), 0), |
---|
2700 | list(0, intvec(2), 0), |
---|
2701 | list(0, intvec(2), 0), |
---|
2702 | list(0, intvec(1), 0); |
---|
2703 | |
---|
2704 | origsSumUp(BL); |
---|
2705 | } |
---|
2706 | |
---|
2707 | /////////////////////////////////////// |
---|
2708 | |
---|
2709 | // helper |
---|
2710 | // Given an automorphism K --> K as an invertible matrix A |
---|
2711 | // this function computes a permutation matrix. |
---|
2712 | // Assume: BL is of the form [[dim, w, [T[1]*T[2]^2, T[3]]],...] |
---|
2713 | // where the w are the originary weights. |
---|
2714 | // we also assume that Origs are ordered as occurring in Q |
---|
2715 | // returns a list of matrices (not intmats). |
---|
2716 | static proc matrix2compper(intmat B, list BL, list MON, intmat Q, list TOR){ |
---|
2717 | list Origs; |
---|
2718 | list MONweight; |
---|
2719 | |
---|
2720 | for(int i = 1; i <= size(BL); i++){ |
---|
2721 | Origs[i] = BL[i][2]; |
---|
2722 | } |
---|
2723 | |
---|
2724 | for(int j = 1; j <= size(MON); j++){ |
---|
2725 | MONweight[j] = reduceIntvec(multiDeg(MON[j]), TOR); |
---|
2726 | } |
---|
2727 | |
---|
2728 | // initialize the permutation matrix (to be returned) |
---|
2729 | // as zero-rows: |
---|
2730 | int d = size(MON); |
---|
2731 | intmat PER[d][d]; |
---|
2732 | intvec done = 0:size(MONweight); |
---|
2733 | |
---|
2734 | for(i = 1; i <= size(MONweight); i++){ |
---|
2735 | intvec w = MONweight[i]; |
---|
2736 | intmat mW[size(w)][1]; |
---|
2737 | mW[1..size(w),1] = w; |
---|
2738 | |
---|
2739 | intmat BmW = B * mW; // ...x1 matrix |
---|
2740 | intvec v = BmW[1..nrows(BmW), 1]; |
---|
2741 | intvec vred = reduceIntvec(v, TOR); |
---|
2742 | |
---|
2743 | for(j = 1; j <= size(MONweight); j++){ |
---|
2744 | intvec zred = reduceIntvec(MONweight[j], TOR); |
---|
2745 | |
---|
2746 | // test if MONweight[j] == v (possibly with Torsion, i.e. after reduction) |
---|
2747 | // and done[j] != 1: |
---|
2748 | if(vred == zred and done[j] != 1){ |
---|
2749 | PER[i,j] = 1; |
---|
2750 | done[j] = 1; |
---|
2751 | |
---|
2752 | kill zred; |
---|
2753 | break; |
---|
2754 | } |
---|
2755 | |
---|
2756 | kill zred; |
---|
2757 | } |
---|
2758 | |
---|
2759 | kill vred, v, w, mW, BmW; |
---|
2760 | } |
---|
2761 | |
---|
2762 | return(PER); |
---|
2763 | } |
---|
2764 | |
---|
2765 | //////////////////////////////////////// |
---|
2766 | |
---|
2767 | proc autXhat(ideal RL, intvec w, list #) |
---|
2768 | " |
---|
2769 | USAGE: autXhat(RL, w0, TOR): RL is an ideal, w an intvec, TOR a list of integers |
---|
2770 | ASSUME: the basering is multigraded, the elements of TOR stand for the torsion rows of the matrix getVariableWeights(), w is an ample class or the free part of such a class. |
---|
2771 | PURPOSE: compute an ideal J such that V(J) in some GL(n) is isomorphic to the H-equivariant automorphisms \widehat X --> \widehat X. |
---|
2772 | EXAMPLE: example autXhat; shows an example |
---|
2773 | " |
---|
2774 | { |
---|
2775 | list TOR; |
---|
2776 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2777 | TOR = #[1]; |
---|
2778 | } |
---|
2779 | |
---|
2780 | def R = basering; |
---|
2781 | intmat Q = getVariableWeights(); |
---|
2782 | intmat Q0 = gradingFreePart(Q, TOR); |
---|
2783 | |
---|
2784 | int k0 = nrows(Q0); |
---|
2785 | bigintmat w0[1][k0] = w[1..k0]; |
---|
2786 | |
---|
2787 | if(size(w) < nrows(Q)){ |
---|
2788 | ERROR("size of w must equal the number of rows of the degree matrix."); |
---|
2789 | } |
---|
2790 | |
---|
2791 | cone c = gitCone(RL, Q0, w0); |
---|
2792 | def RR = stabilizer(RL, TOR); |
---|
2793 | setring RR; |
---|
2794 | |
---|
2795 | list RES; |
---|
2796 | for(int i = 1; i <= size(stabExported); i++){ |
---|
2797 | intmat B = stabExported[i][2]; |
---|
2798 | intvec wB = B * w; |
---|
2799 | |
---|
2800 | setring R; |
---|
2801 | bigintmat wB0[1][k0] = wB[1..k0]; |
---|
2802 | cone cB = gitCone(RL, Q0, wB0); |
---|
2803 | kill wB0; |
---|
2804 | setring RR; |
---|
2805 | |
---|
2806 | if(cB == c){ |
---|
2807 | RES[size(RES) + 1] = stabExported[i]; |
---|
2808 | } |
---|
2809 | |
---|
2810 | kill B, wB, cB; |
---|
2811 | } |
---|
2812 | |
---|
2813 | export(RES); |
---|
2814 | return(RR); |
---|
2815 | } |
---|
2816 | example |
---|
2817 | { |
---|
2818 | echo=2; |
---|
2819 | |
---|
2820 | intmat Q[3][5] = |
---|
2821 | 1,1,1,1,1, |
---|
2822 | 1,-1,0,0,1, |
---|
2823 | 1,1,1,0,0; |
---|
2824 | |
---|
2825 | list TOR = 2; |
---|
2826 | ring R = 0,T(1..5),dp; |
---|
2827 | |
---|
2828 | setBaseMultigrading(Q); |
---|
2829 | |
---|
2830 | ideal I = T(1)*T(2) + T(3)^2 + T(4)^2; |
---|
2831 | list TOR = 2; |
---|
2832 | |
---|
2833 | intvec w0 = 2,1,0; |
---|
2834 | def RR = autXhat(I, w0, TOR); |
---|
2835 | setring RR; |
---|
2836 | |
---|
2837 | RES; |
---|
2838 | kill RR, Q, R; |
---|
2839 | } |
---|
2840 | |
---|
2841 | ////////////////////////////////////////// |
---|
2842 | |
---|
2843 | static proc gradingFreePart(intmat Q, list TOR){ |
---|
2844 | intmat Q0[nrows(Q) - size(TOR)][ncols(Q)]; |
---|
2845 | |
---|
2846 | for(int i = 1; i <= nrows(Q0); i++){ |
---|
2847 | Q0[i, 1..ncols(Q0)] = Q[i, 1..ncols(Q0)]; |
---|
2848 | } |
---|
2849 | |
---|
2850 | return(Q0); |
---|
2851 | } |
---|
2852 | |
---|
2853 | //////////////////////////////////////// |
---|
2854 | |
---|
2855 | // helper |
---|
2856 | // compute the image cone by applying A to |
---|
2857 | // the rays of c. We assume c is pointed. |
---|
2858 | static proc imageCone(cone c, intmat A){ |
---|
2859 | bigintmat R = rays(c); |
---|
2860 | cone cc = coneViaPoints(R * transpose(A)); |
---|
2861 | |
---|
2862 | return(cc); |
---|
2863 | } |
---|
2864 | example |
---|
2865 | { |
---|
2866 | echo=2; |
---|
2867 | |
---|
2868 | intmat M[2][2] = |
---|
2869 | 1,0, |
---|
2870 | 1,2; |
---|
2871 | |
---|
2872 | cone c = coneViaPoints(M); |
---|
2873 | rays(c); |
---|
2874 | |
---|
2875 | intmat A[2][2] = |
---|
2876 | 1,0, |
---|
2877 | 0,2; |
---|
2878 | |
---|
2879 | cone cc = imageCone(c, A); |
---|
2880 | rays(cc); |
---|
2881 | } |
---|
2882 | |
---|
2883 | ///////////////////////////////////// |
---|
2884 | |
---|
2885 | // helper. |
---|
2886 | // Assume: basering variables are |
---|
2887 | // T(1..n0), Y(1..), Z: |
---|
2888 | // Replaces in M each non-zero entry M[i,j] by V[i,j]: |
---|
2889 | // however: replace the lower entries, e.g., Y(11)^2, |
---|
2890 | // by Y(2)^2 if Y(11) --> Y(2). |
---|
2891 | static proc relabelEntries(matrix A, int n0){ |
---|
2892 | def R = basering; |
---|
2893 | int n = ncols(A); |
---|
2894 | |
---|
2895 | // define a map: A[i,j] --> V[i,j] |
---|
2896 | // for the case of M[i,j] being a single variable; |
---|
2897 | // this is true for the first n0 rows of A: |
---|
2898 | // Store in Img[i] the image of Y(i): |
---|
2899 | intvec v = 0:(nvars(R)); |
---|
2900 | list Img = v[1..size(v)]; // initialze with 0. |
---|
2901 | |
---|
2902 | int i, j, pos, k, m; |
---|
2903 | |
---|
2904 | for(i = 1; i <= n0; i++){ |
---|
2905 | for(j = 1; j <= ncols(A); j++){ |
---|
2906 | if(A[i,j] != 0){ // then it is some Y(k) --> replace it by V[i,j]: |
---|
2907 | // ordering of variables in R is |
---|
2908 | // T(1..n0), Y(1..n^2), Z: |
---|
2909 | pos = (i-1)*n + j; |
---|
2910 | |
---|
2911 | // A[i,j] should be Y(pos): |
---|
2912 | // find out k with A[i,j] = Y(k): |
---|
2913 | for(m = 1; m <= n*n; m++){ |
---|
2914 | if(A[i,j] == Y(m)){ |
---|
2915 | Img[m + n0] = Y(pos); //+n0 since vars T(1..n0) are at front |
---|
2916 | break; |
---|
2917 | } |
---|
2918 | } |
---|
2919 | } |
---|
2920 | } |
---|
2921 | } |
---|
2922 | |
---|
2923 | // define the map: |
---|
2924 | map f = R, Img[1..size(Img)]; |
---|
2925 | |
---|
2926 | return(f(A)); |
---|
2927 | } |
---|
2928 | |
---|
2929 | /////////////////////// |
---|
2930 | |
---|
2931 | // helper |
---|
2932 | // returns the grading by the characteristic |
---|
2933 | // quasitorus. |
---|
2934 | static proc getCharacteristicGrading(list BL, list #){ |
---|
2935 | list TOR; |
---|
2936 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
2937 | TOR = #[1]; |
---|
2938 | } |
---|
2939 | |
---|
2940 | intmat Q = getVariableWeights(); |
---|
2941 | intmat Qnew[nrows(Q)][size(BL)]; |
---|
2942 | |
---|
2943 | for(int i = 1; i <= size(BL); i++){ |
---|
2944 | intvec w = reduceIntvec(multiDeg(BL[i]), TOR); |
---|
2945 | |
---|
2946 | Qnew[1..nrows(Q), i] = w[1..size(w)]; |
---|
2947 | kill w; |
---|
2948 | } |
---|
2949 | |
---|
2950 | return(Qnew); |
---|
2951 | } |
---|
2952 | |
---|
2953 | /////////////////////////// |
---|
2954 | |
---|
2955 | // helper |
---|
2956 | // compute the linear hull over the columns of P. |
---|
2957 | static proc linearHull(intmat P){ |
---|
2958 | // the linear hull over the columns of P: |
---|
2959 | // equivalent: cone(P, -P): |
---|
2960 | intmat M[ncols(P) * 2][nrows(P)]; // rows are rays |
---|
2961 | |
---|
2962 | for(int i = 1; i <= ncols(P); i++){ |
---|
2963 | M[i, 1..nrows(P)] = P[1..nrows(P), i]; |
---|
2964 | M[i + ncols(P), 1..nrows(P)] = -P[1..nrows(P), i]; |
---|
2965 | } |
---|
2966 | cone V = coneViaPoints(M); |
---|
2967 | |
---|
2968 | return(V); |
---|
2969 | } |
---|
2970 | |
---|
2971 | //////////////////////////// |
---|
2972 | |
---|
2973 | // helper |
---|
2974 | // compute generators for the veronese subalgebra |
---|
2975 | static proc veron(intmat P){ |
---|
2976 | // linear hull of P: |
---|
2977 | intmat Pplusminus[2*nrows(P)][ncols(P)] = P, -P; |
---|
2978 | |
---|
2979 | cone V = coneViaPoints(Pplusminus); |
---|
2980 | cone posorth = coneViaPoints(getIdMat(ambientDimension(V))); |
---|
2981 | cone c = convexIntersection(V, posorth); |
---|
2982 | |
---|
2983 | intmat H = hilbertBas(c); |
---|
2984 | return(H); |
---|
2985 | } |
---|
2986 | example |
---|
2987 | { |
---|
2988 | echo = 2; |
---|
2989 | |
---|
2990 | intmat P[2][3] = |
---|
2991 | 1,0,-1, |
---|
2992 | 0,1,-1; |
---|
2993 | |
---|
2994 | veron(transpose(P)); |
---|
2995 | } |
---|
2996 | |
---|
2997 | ////////////////////////// |
---|
2998 | |
---|
2999 | proc autX(ideal RL, intvec w, list #) |
---|
3000 | " |
---|
3001 | USAGE: autX(RL, w, TOR); RL: ideal, w: intvec, TOR: optional list of integers. |
---|
3002 | PURPOSE: compute generators for the hopf algebra O(Aut(X)) |
---|
3003 | of the Mori dream space X given by Cox(X) := basering/RL and |
---|
3004 | the ample class w. |
---|
3005 | ASSUME: there is no torsion. |
---|
3006 | RETURN: a ring. Also exports an ideal Iexported. |
---|
3007 | EXAMPLE: example autX; shows an example |
---|
3008 | " |
---|
3009 | { |
---|
3010 | list TOR; |
---|
3011 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
3012 | TOR = #[1]; |
---|
3013 | } |
---|
3014 | |
---|
3015 | def RR = autXhat(RL, w, TOR); |
---|
3016 | setring RR; |
---|
3017 | intmat Q = getVariableWeights(); |
---|
3018 | |
---|
3019 | // ideal: |
---|
3020 | ideal J = RES[1][3]; |
---|
3021 | for(int i = 2; i <= size(RES); i++){ |
---|
3022 | J = J * RES[i][3]; |
---|
3023 | } |
---|
3024 | |
---|
3025 | intmat P = degMat2P(Q, TOR); |
---|
3026 | intmat V = veron(transpose(P)); |
---|
3027 | |
---|
3028 | // creat map: |
---|
3029 | ideal imMap; |
---|
3030 | for(int i = 1; i <= nrows(V); i++){ |
---|
3031 | intvec v = V[i, 1..ncols(V)]; |
---|
3032 | |
---|
3033 | imMap[size(imMap) + 1] = vec2monomial(v); |
---|
3034 | kill v; |
---|
3035 | } |
---|
3036 | |
---|
3037 | string Sstr = "ring S = (" + charstr(RR) + "),(T(1..size(V))),dp;"; |
---|
3038 | execute(Sstr); // creates the ring 0,(T(1..size(V))),dp; |
---|
3039 | setring S; |
---|
3040 | setring RR; |
---|
3041 | |
---|
3042 | // f: S --> RR, T_i --> T^mu |
---|
3043 | map f = S, imMap; |
---|
3044 | |
---|
3045 | setring S; |
---|
3046 | ideal Iexported = preimage(RR, f, J); |
---|
3047 | |
---|
3048 | export(Iexported); |
---|
3049 | return(S); |
---|
3050 | } |
---|
3051 | example |
---|
3052 | { |
---|
3053 | /////////////// |
---|
3054 | //// CAREFUL: the following examples seems to be unfeasible at the moment, see remark in the paper |
---|
3055 | |
---|
3056 | //echo=2; |
---|
3057 | /////////////// |
---|
3058 | //// PP2 |
---|
3059 | //intmat Q[1][4] = |
---|
3060 | // 1,1,1,1; |
---|
3061 | |
---|
3062 | //ring R = 0,T(1..ncols(Q)),dp; |
---|
3063 | |
---|
3064 | //// attach degree matrix Q to R: |
---|
3065 | //setBaseMultigrading(Q); |
---|
3066 | //ideal I = 0; |
---|
3067 | //intvec w0 = 1; |
---|
3068 | |
---|
3069 | //def RR = autX(I, w0); |
---|
3070 | //setring RR; |
---|
3071 | //Iexported; |
---|
3072 | |
---|
3073 | //basering; |
---|
3074 | //dim(std(Iexported)); |
---|
3075 | |
---|
3076 | //kill RR, Q, R; |
---|
3077 | |
---|
3078 | /////////////// |
---|
3079 | //// example 3.14 from the paper |
---|
3080 | //intmat Q[3][5] = |
---|
3081 | // 1,1,1,1,1, |
---|
3082 | // 1,-1,0,0,1, |
---|
3083 | // 1,1,1,0,0; |
---|
3084 | |
---|
3085 | //list TOR = 2; |
---|
3086 | //ring R = 0,T(1..5),dp; |
---|
3087 | |
---|
3088 | //// attach degree matrix Q to R: |
---|
3089 | //setBaseMultigrading(Q); |
---|
3090 | |
---|
3091 | //ideal I = T(1)*T(2) + T(3)^2 + T(4)^2; |
---|
3092 | //list TOR = 2; |
---|
3093 | |
---|
3094 | //intvec w0 = 2,1,0; |
---|
3095 | //def RR = autX(I, w0, TOR); |
---|
3096 | //setring RR; |
---|
3097 | |
---|
3098 | //kill RR, Q, R; |
---|
3099 | } |
---|
3100 | |
---|
3101 | //////////////////// |
---|
3102 | |
---|
3103 | // helper |
---|
3104 | // compute the hilbert basis of c. |
---|
3105 | static proc hilbertBas(cone c){ |
---|
3106 | intmat A = intmat(rays(c)); |
---|
3107 | intmat B = normaliz(A, 0); |
---|
3108 | |
---|
3109 | return(B); |
---|
3110 | } |
---|
3111 | example |
---|
3112 | { |
---|
3113 | echo = 2; |
---|
3114 | |
---|
3115 | intmat A[2][2] = |
---|
3116 | 1,0, |
---|
3117 | 1,3; |
---|
3118 | |
---|
3119 | intmat B = hilbertBas(coneViaPoints(A)); |
---|
3120 | print(B); |
---|
3121 | |
---|
3122 | // 2nd ex: |
---|
3123 | intmat C[3][4] = |
---|
3124 | 1, 0, 0, 0, |
---|
3125 | 1, 1, 0, 0, |
---|
3126 | 6, 3, 4, 2; |
---|
3127 | |
---|
3128 | intmat D = hilbertBas(coneViaPoints(C)); |
---|
3129 | print(D); |
---|
3130 | |
---|
3131 | } |
---|
3132 | |
---|
3133 | ///////////////////////// |
---|
3134 | |
---|
3135 | // helper |
---|
3136 | // compute the gale dual P of the degree matrix Q |
---|
3137 | static proc degMat2P(intmat Q, list TOR){ |
---|
3138 | int k = nrows(Q); |
---|
3139 | int nfree = nrows(Q) - size(TOR); |
---|
3140 | |
---|
3141 | int n = size(TOR); |
---|
3142 | if(n == 0){ |
---|
3143 | n = 1; // then L = (0,...0)^t |
---|
3144 | } |
---|
3145 | |
---|
3146 | intmat L[k][n]; |
---|
3147 | |
---|
3148 | for(int i = 1; i <= size(TOR); i++){ |
---|
3149 | L[i + nfree, i] = TOR[i]; |
---|
3150 | } |
---|
3151 | intmat U0 = preimageLattice(Q, L); |
---|
3152 | |
---|
3153 | return(transpose(U0)); |
---|
3154 | } |
---|
3155 | example |
---|
3156 | { |
---|
3157 | echo = 2; |
---|
3158 | |
---|
3159 | intmat Q[2][4] = |
---|
3160 | 1,1,1,1, |
---|
3161 | 1,0,1,0; |
---|
3162 | |
---|
3163 | list TOR = 2; |
---|
3164 | intmat P = degMat2P(Q, TOR); |
---|
3165 | print(P); |
---|
3166 | |
---|
3167 | } |
---|
3168 | |
---|
3169 | /////////////////////////// |
---|
3170 | |
---|
3171 | // helper |
---|
3172 | static proc compsAreTrivial(ideal RL, list TOR){ |
---|
3173 | // for each col w of Q |
---|
3174 | // we require I_w = 0: |
---|
3175 | intmat Q = getVariableWeights(); |
---|
3176 | |
---|
3177 | for(int i = 1; i <= ncols(Q); i++){ |
---|
3178 | intvec w = Q[1..nrows(Q), i]; |
---|
3179 | |
---|
3180 | // compute a basis Iw of I_w: |
---|
3181 | // I_w will be a subspace of KTw: |
---|
3182 | list Iw = gradedCompIdeal(RL, w, 0, TOR)[2]; |
---|
3183 | |
---|
3184 | if(size(Iw) > 0){ |
---|
3185 | return(0); |
---|
3186 | } |
---|
3187 | |
---|
3188 | kill w, Iw; |
---|
3189 | } |
---|
3190 | |
---|
3191 | return(1); |
---|
3192 | } |
---|
3193 | |
---|
3194 | /////////////////////////// |
---|
3195 | |
---|
3196 | proc autGradAlg(ideal I, list #) |
---|
3197 | " |
---|
3198 | USAGE: autGradAlg(I, TOR); I is an ideal, TOR is an optional list of integers representing the torsion part of the grading group. |
---|
3199 | ASSUME: minimally presented, degrees of the generators of I |
---|
3200 | are the minimal degrees, basering multigraded pointedly, I_w = 0 |
---|
3201 | for all w = deg(var(i)) |
---|
3202 | RETURN: a ring. Also exports an ideal Jexported and a list stabExported. |
---|
3203 | EXAMPLE: example autGradAlg; shows an example |
---|
3204 | " |
---|
3205 | { |
---|
3206 | list TOR; |
---|
3207 | if(size(#) > 0 and typeof(#) == "list" and typeof(#[1]) == "int"){ |
---|
3208 | TOR = #[1]; |
---|
3209 | } |
---|
3210 | |
---|
3211 | // for each col w of Q |
---|
3212 | // we require I_w = 0: |
---|
3213 | if(!compsAreTrivial(I, TOR)){ |
---|
3214 | ERROR("For some i, w = deg(var(i)) did not satisfy I_w = 0. We do not support this case at the moment. Sorry."); |
---|
3215 | } |
---|
3216 | |
---|
3217 | def RR = stabilizer(I, TOR); |
---|
3218 | setring RR; |
---|
3219 | |
---|
3220 | // Jexported is already being exported |
---|
3221 | return(RR); |
---|
3222 | } |
---|
3223 | example |
---|
3224 | { |
---|
3225 | echo = 2; |
---|
3226 | |
---|
3227 | intmat Q[1][3] = |
---|
3228 | 1,1,1; |
---|
3229 | |
---|
3230 | ring R = 0,T(1..3), dp; |
---|
3231 | setBaseMultigrading(Q); |
---|
3232 | |
---|
3233 | ideal I = 0; //T(1)*T(2) + T(3)*T(4); |
---|
3234 | def RR = autGradAlg(I); |
---|
3235 | setring RR; |
---|
3236 | |
---|
3237 | "resulting ideal:"; |
---|
3238 | Jexported; |
---|
3239 | |
---|
3240 | "dimension:"; |
---|
3241 | dim(std(Jexported)); |
---|
3242 | |
---|
3243 | "as a detailed list:"; |
---|
3244 | stabExported; |
---|
3245 | } |
---|
3246 | |
---|
3247 | ////////////////////////// |
---|
3248 | |
---|
3249 | static proc shrink(ideal I) |
---|
3250 | " |
---|
3251 | USAGE: shrink(I): I is an ideal |
---|
3252 | ASSUME: There are variable generators in I and I does not contain 0-generators. |
---|
3253 | PURPOSE: returns a new ring S obtained from the old one by removing all variables Y(i) |
---|
3254 | such that some generator of I is Y(i). Exports the image of the given ideal in S. |
---|
3255 | RETURN: a ring. Exports an ideal Ishrink. |
---|
3256 | EXAMPLE: example shrink; shows an example |
---|
3257 | " |
---|
3258 | { |
---|
3259 | // create smaller ring: |
---|
3260 | // we will map Y(i) --> 0 if i is in the list zeros: |
---|
3261 | def R = basering; |
---|
3262 | ideal take = var(1); // initialize as the list of all variables |
---|
3263 | |
---|
3264 | for(int i = 2; i <= nvars(R); i++){ |
---|
3265 | take = take, var(i); |
---|
3266 | } |
---|
3267 | |
---|
3268 | list zeros; |
---|
3269 | int j; |
---|
3270 | i = 1; |
---|
3271 | int c = 1; |
---|
3272 | |
---|
3273 | while(c <= size(I)){ // i may have 0-entries: |
---|
3274 | for(j = 1; j <= nvars(R); j++){ |
---|
3275 | if(I[i] == var(j)){ |
---|
3276 | zeros[size(zeros)+1] = j; |
---|
3277 | break; |
---|
3278 | } |
---|
3279 | } |
---|
3280 | |
---|
3281 | if(I[i] != 0){ |
---|
3282 | c++; |
---|
3283 | } |
---|
3284 | |
---|
3285 | i++; |
---|
3286 | } |
---|
3287 | |
---|
3288 | for(i = 1; i <= size(zeros); i++){ |
---|
3289 | take[zeros[i]] = 0; |
---|
3290 | } |
---|
3291 | |
---|
3292 | string s = "ring S = ("+ charstr(R) + "), ("; //charstr: e.g. 0,a |
---|
3293 | int firstone = 1; |
---|
3294 | int n = 0; // no of variables in new ring |
---|
3295 | |
---|
3296 | for(i = 1; i <= nvars(R); i++){ |
---|
3297 | if(take[i] != 0){ |
---|
3298 | if(firstone){ |
---|
3299 | s = s + string(take[i]); |
---|
3300 | firstone = 0; |
---|
3301 | n++; |
---|
3302 | } else { |
---|
3303 | s = s + ", " + string(take[i]); |
---|
3304 | n++; |
---|
3305 | } |
---|
3306 | } |
---|
3307 | } |
---|
3308 | |
---|
3309 | s = s + "),(dp(" + string(n-1) + "), dp(1));"; |
---|
3310 | execute(s); |
---|
3311 | |
---|
3312 | // map the ideal to Small: |
---|
3313 | ideal Ishrink = imap(R, I); |
---|
3314 | |
---|
3315 | export Ishrink; |
---|
3316 | return(S); |
---|
3317 | } |
---|
3318 | example |
---|
3319 | { |
---|
3320 | echo=2; |
---|
3321 | |
---|
3322 | ring R = 0,(T(1..10),Y(1..3),Z),dp; |
---|
3323 | ideal I = |
---|
3324 | T(1)*T(3), |
---|
3325 | Y(1), |
---|
3326 | T(2)*Y(1), |
---|
3327 | Y(3), |
---|
3328 | Z*T(7)-7*Y(3), |
---|
3329 | T(8); |
---|
3330 | |
---|
3331 | def S = shrink(I); |
---|
3332 | setring S; |
---|
3333 | |
---|
3334 | Ishrink; |
---|
3335 | |
---|
3336 | } |
---|