Annotation of OpenXM/src/k097/lib/minimal/minimal.k, Revision 1.21
1.21 ! takayama 1: /* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.20 2000/07/31 02:25:34 takayama Exp $ */
1.1 takayama 2: #define DEBUG 1
1.19 takayama 3: Sordinary = false;
1.4 takayama 4: /* If you run this program on openxm version 1.1.2 (FreeBSD),
5: make a symbolic link by the command
6: ln -s /usr/bin/cpp /lib/cpp
7: */
1.6 takayama 8: #define OFFSET 0
9: /* #define OFFSET 20*/
1.1 takayama 10: /* Test sequences.
11: Use load["minimal.k"];;
12:
13: a=Sminimal(v);
14: b=a[0];
15: b[1]*b[0]:
16: b[2]*b[1]:
17:
18: a = test0();
19: b = a[0];
20: b[1]*b[0]:
21: b[2]*b[1]:
22: a = Sminimal(b[0]);
23:
24: a = test1();
25: b=a[0];
26: b[1]*b[0]:
27: b[2]*b[1]:
28:
29: */
30:
31:
32: load("cohom.k");
33: def load_tower() {
34: if (Boundp("k0-tower.sm1.loaded")) {
35: }else{
36: sm1(" [(parse) (k0-tower.sm1) pushfile ] extension ");
1.21 ! takayama 37: sm1(" [(parse) (new.sm1) pushfile ] extension ");
1.1 takayama 38: sm1(" /k0-tower.sm1.loaded 1 def ");
39: }
1.7 takayama 40: sm1(" oxNoX ");
1.1 takayama 41: }
42: load_tower();
43: SonAutoReduce = true;
44: def Factor(f) {
45: sm1(f, " fctr /FunctionValue set");
46: }
47: def Reverse(f) {
48: sm1(f," reverse /FunctionValue set");
49: }
50: def Sgroebner(f) {
51: sm1(" [f] groebner /FunctionValue set");
52: }
1.19 takayama 53:
1.21 ! takayama 54: def Sinvolutive(f,w) {
! 55: local g,m;
! 56: if (IsArray(f[0])) {
! 57: m = NewArray(Length(f[0]));
! 58: }else{
! 59: m = [0];
! 60: }
! 61: g = Sgroebner(f);
! 62: /* This is a temporary code. */
! 63: sm1(" g 0 get { w m init_w<m>} map /FunctionValue set ");
! 64: }
! 65:
! 66:
1.19 takayama 67:
68: def Error(s) {
69: sm1(" s error ");
70: }
71:
72: def IsNull(s) {
73: if (Stag(s) == 0) return(true);
74: else return(false);
75: }
76:
77: def MonomialPart(f) {
78: sm1(" [(lmonom) f] gbext /FunctionValue set ");
79: }
80:
81: def Warning(s) {
82: Print("Warning: ");
83: Println(s);
84: }
85: def RingOf(f) {
86: local r;
87: if (IsPolynomial(f)) {
88: if (f != Poly("0")) {
89: sm1(f," (ring) dc /r set ");
90: }else{
91: sm1(" [(CurrentRingp)] system_variable /r set ");
92: }
93: }else{
94: Warning("RingOf(f): the argument f must be a polynomial. Return the current ring.");
95: sm1(" [(CurrentRingp)] system_variable /r set ");
96: }
97: return(r);
98: }
99:
1.21 ! takayama 100: def Ord_w_m(f,w,m) {
! 101: sm1(" f w m ord_w<m> { (universalNumber) dc } map /FunctionValue set ");
! 102: }
! 103: HelpAdd(["Ord_w_m",
! 104: ["Ord_w_m(f,w,m) returns the order of f with respect to w with the shift m.",
! 105: "Note that the order of the ring and the weight w must be the same.",
! 106: "When f is zero, it returns -intInfinity = -999999999.",
! 107: "Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ",
! 108: " Ord_w_m([x*Dx+1,Dx^2+x^5],[\"x\",-1,\"Dx\",1],[2,0]):"]]);
! 109:
! 110: def Init_w_m(f,w,m) {
! 111: sm1(" f w m init_w<m> /FunctionValue set ");
! 112: }
! 113: HelpAdd(["Init_w_m",
! 114: ["Init_w_m(f,w,m) returns the initial of f with respect to w with the shift m.",
! 115: "Note that the order of the ring and the weight w must be the same.",
! 116: "Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ",
! 117: " Init_w_m([x*Dx+1,Dx^2+x^5],[\"x\",-1,\"Dx\",1],[2,0]):"]]);
! 118:
! 119: def Max(v) {
! 120: local i,t,n;
! 121: n = Length(v);
! 122: if (n == 0) return(null);
! 123: t = v[0];
! 124: for (i=0; i<n; i++) {
! 125: if (v[i] > t) { t = v[i];}
! 126: }
! 127: return(t);
! 128: }
! 129: HelpAdd(["Max",
! 130: ["Max(v) returns the maximal element in v."]]);
! 131:
1.19 takayama 132: /* End of standard functions that should be moved to standard libraries. */
1.1 takayama 133: def test0() {
134: local f;
135: Sweyl("x,y,z");
136: f = [x^2+y^2+z^2, x*y+x*z+y*z, x*z^2+y*z^2, y^3-x^2*z - x*y*z+y*z^2,
137: -y^2*z^2 + x*z^3 + y*z^3, -z^4];
138: frame=SresolutionFrame(f);
139: Println(frame);
140: /* return(frame); */
141: return(SlaScala(f));
142: }
143: def test1() {
144: local f;
145: Sweyl("x,y,z");
146: f = [x^2+y^2+z^2, x*y+x*z+y*z, x*z^2+y*z^2, y^3-x^2*z - x*y*z+y*z^2,
147: -y^2*z^2 + x*z^3 + y*z^3, -z^4];
148: return(Sminimal(f));
149: }
150:
151:
152:
153: def Sweyl(v,w) {
154: /* extern WeightOfSweyl ; */
155: local ww,i,n;
156: if(Length(Arglist) == 1) {
157: sm1(" [v s_ring_of_differential_operators 0 [(schreyer) 1]] define_ring ");
158: sm1(" define_ring_variables ");
159:
160: sm1(" [ v to_records pop ] /ww set ");
161: n = Length(ww);
162: WeightOfSweyl = NewArray(n*4);
163: for (i=0; i< n; i++) {
164: WeightOfSweyl[2*i] = ww[i];
165: WeightOfSweyl[2*i+1] = 1;
166: }
167: for (i=0; i< n; i++) {
168: WeightOfSweyl[2*n+2*i] = AddString(["D",ww[i]]);
169: WeightOfSweyl[2*n+2*i+1] = 1;
170: }
171:
172: }else{
173: sm1(" [v s_ring_of_differential_operators w s_weight_vector 0 [(schreyer) 1]] define_ring ");
174: sm1(" define_ring_variables ");
175: WeightOfSweyl = w[0];
176: }
177: }
178:
179:
180: def Spoly(f) {
181: sm1(f, " toString tparse /FunctionValue set ");
182: }
183:
184: def SreplaceZeroByZeroPoly(f) {
185: if (IsArray(f)) {
186: return(Map(f,"SreplaceZeroByZeroPoly"));
187: }else{
188: if (IsInteger(f)) {
189: return(Poly(ToString(f)));
190: }else{
191: return(f);
192: }
193: }
194: }
195: def Shomogenize(f) {
196: f = SreplaceZeroByZeroPoly(f);
197: if (IsArray(f)) {
198: sm1(f," sHomogenize2 /FunctionValue set ");
199: /* sm1(f," {sHomogenize2} map /FunctionValue set "); */
200: /* Is it correct? Double check.*/
201: }else{
202: sm1(f, " sHomogenize /FunctionValue set ");
203: }
204: }
205:
206: def StoTower() {
207: sm1(" [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv ");
208: }
209:
210: def SsetTower(tower) {
211: sm1(" [(AvoidTheSameRing)] pushEnv
212: [ [(AvoidTheSameRing) 0] system_variable
213: [(gbListTower) tower (list) dc] system_variable
214: ] pop popEnv ");
1.14 takayama 215: /* sm1("(hoge) message show_ring "); */
1.1 takayama 216: }
217:
218: def SresolutionFrameWithTower(g,opt) {
219: local gbTower, ans, ff, count, startingGB, opts, skelton,withSkel, autof,
1.19 takayama 220: gbasis, nohomog,i,n;
221: /* extern Sordinary */
1.15 takayama 222: nohomog = false;
1.19 takayama 223: count = -1; Sordinary = false; /* default value for options. */
1.1 takayama 224: if (Length(Arglist) >= 2) {
1.19 takayama 225: if (IsArray(opt)) {
226: n = Length(opt);
227: for (i=0; i<n; i++) {
228: if (IsInteger(opt[i])) {
229: count = opt[i];
230: }
231: if (IsString(opt[i])) {
232: if (opt[i] == "homogenized") {
233: nohomog = true;
234: }else if (opt[i] == "Sordinary") {
235: Sordinary = true;
236: }else{
237: Println("Warning: unknown option");
238: Println(opt);
239: }
240: }
1.15 takayama 241: }
1.19 takayama 242: }else{
243: Println("Warning: option should be given by an array.");
1.15 takayama 244: }
1.1 takayama 245: }
246:
247: sm1(" setupEnvForResolution ");
248: /* If I do not put this macro, homogenization
249: make a strange behavior. For example,
250: [(2*x*Dx + 3*y*Dy+6) (0)] homogenize returns
251: [(2*x*Dx*h + 3*y*Dy*h+6*h^3) (0)].
252: 4/19, 2000.
253: */
254:
255: sm1(" (mmLarger) (matrix) switch_function ");
1.15 takayama 256: if (! nohomog) {
257: Println("Automatic homogenization.");
258: g = Map(g,"Shomogenize");
259: }else{
260: Println("No automatic homogenization.");
261: }
1.1 takayama 262: if (SonAutoReduce) {
263: sm1("[ (AutoReduce) ] system_variable /autof set ");
264: sm1("[ (AutoReduce) 1 ] system_variable ");
265: }
266: gbasis = Sgroebner(g);
267: g = gbasis[0];
268: if (SonAutoReduce) {
269: sm1("[ (AutoReduce) autof] system_variable ");
270: }
271:
272: g = Init(g);
273:
274: /* sm1(" setupEnvForResolution-sugar "); */
275: /* -sugar is fine? */
276: sm1(" setupEnvForResolution ");
277:
278: Println(g);
279: startingGB = g;
280: /* ans = [ SzeroMap(g) ]; It has not been implemented. see resol1.withZeroMap */
281: ans = [ ];
282: gbTower = [ ];
283: skelton = [ ];
284: while (true) {
285: /* sm1(g," res0Frame /ff set "); */
286: withSkel = Sres0FrameWithSkelton(g);
287: ff = withSkel[0];
288: ans = Append(ans, ff[0]);
289: gbTower = Join([ ff[1] ], gbTower);
290: skelton = Join([ withSkel[1] ], skelton);
291: g = ff[0];
292: if (Length(g) == 0) break;
293: SsetTower( gbTower );
294: if (count == 0) break;
295: count = count - 1;
296: }
297: return([ans,Reverse(gbTower),Join([ [ ] ], Reverse(skelton)),gbasis]);
298: }
299: HelpAdd(["SresolutionFrameWithTower",
300: ["It returs [resolution of the initial, gbTower, skelton, gbasis]",
1.15 takayama 301: "option: \"homogenized\" (no automatic homogenization) ",
1.1 takayama 302: "Example: Sweyl(\"x,y\");",
303: " a=SresolutionFrameWithTower([x^3,x*y,y^3-1]);"]]);
304:
305: def SresolutionFrame(f,opt) {
306: local ans;
1.15 takayama 307: ans = SresolutionFrameWithTower(f,opt);
1.1 takayama 308: return(ans[0]);
309: }
310: /* ---------------------------- */
311: def ToGradedPolySet(g) {
312: sm1(g," (gradedPolySet) dc /FunctionValue set ");
313: }
314:
315: def NewPolynomialVector(size) {
316: sm1(size," (integer) dc newPolyVector /FunctionValue set ");
317: }
318:
319: def SturnOffHomogenization() {
320: sm1("
321: [(Homogenize)] system_variable 1 eq
322: { (Warning: Homogenization and ReduceLowerTerms options are automatically turned off.) message
323: [(Homogenize) 0] system_variable
324: [(ReduceLowerTerms) 0] system_variable
325: } { } ifelse
326: ");
327: }
328: def SturnOnHomogenization() {
329: sm1("
330: [(Homogenize)] system_variable 0 eq
331: { (Warning: Homogenization and ReduceLowerTerms options are automatically turned ON.) message
332: [(Homogenize) 1] system_variable
333: [(ReduceLowerTerms) 1] system_variable
334: } { } ifelse
335: ");
336: }
337:
338: def SschreyerSkelton(g) {
339: sm1(" [(schreyerSkelton) g] gbext /FunctionValue set ");
340: }
341: def Stoes(g) {
342: if (IsArray(g)) {
343: sm1(g," {toes} map /FunctionValue set ");
344: }else{
345: sm1(g," toes /FunctionValue set ");
346: }
347: }
348: def Stoes_vec(g) {
349: sm1(g," toes /FunctionValue set ");
350: }
351:
352: def Sres0Frame(g) {
353: local ans;
354: ans = Sres0FrameWithSkelton(g);
355: return(ans[0]);
356: }
357: def Sres0FrameWithSkelton(g) {
358: local t_syz, nexttower, m, t_gb, skel, betti,
359: gg, k, i, j, pair, tmp, si, sj, grG, syzAll, gLength;
360:
361: SturnOffHomogenization();
362:
363: g = Stoes(g);
364: skel = SschreyerSkelton(g);
365: /* Print("Skelton is ");
366: sm1_pmat(skel); */
367: betti = Length(skel);
368:
369: gLength = Length(g);
370: grG = ToGradedPolySet(g);
371: syzAll = NewPolynomialVector(betti);
372: for (k=0; k<betti; k++) {
373: pair = skel[k];
374: i = pair[0,0];
375: j = pair[0,1];
376: si = pair[1,0];
377: sj = pair[1,1];
378: /* si g[i] + sj g[j] + \sum tmp[2][k] g[k] = 0 in res0 */
379: Print(".");
380:
381: t_syz = NewPolynomialVector(gLength);
382: t_syz[i] = si;
383: t_syz[j] = sj;
384: syzAll[k] = t_syz;
385: }
386: t_syz = syzAll;
387: Print("Done. betti="); Println(betti);
388: /* Println(g); g is in a format such as
389: [e_*x^2 , e_*x*y , 2*x*Dx*h , ...]
390: [e_*x^2 , e_*x*y , 2*x*Dx*h , ...]
391: [y-es*x , 3*es^4*y*Dy-es^5*x , 3*es^5*y*Dy-es^6*x , ...]
392: [3*es^3*y*Dy-es^5*x ]
393: */
394: nexttower = Init(g);
395: SturnOnHomogenization();
396: return([[t_syz, nexttower],skel]);
397: }
398:
399:
400: def StotalDegree(f) {
1.14 takayama 401: local d0;
402: sm1(" [(grade) f] gbext (universalNumber) dc /d0 set ");
403: /* Print("degree of "); Print(f); Print(" is "); Println(d0); */
404: return(d0);
1.1 takayama 405: }
406:
1.20 takayama 407: HelpAdd(["Sord_w",
408: ["Sord_w(f,w) returns the w-order of f",
409: "Example: Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]):"]]);
1.1 takayama 410: /* Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]); */
411: def Sord_w(f,w) {
412: local neww,i,n;
413: n = Length(w);
414: neww = NewArray(n);
415: for (i=0; i<n; i=i+2) {
416: neww[i] = ToString(w[i]);
417: }
418: for (i=1; i<n; i=i+2) {
419: neww[i] = IntegerToSm1Integer(w[i]);
420: }
421: sm1(" f neww ord_w (universalNumber) dc /FunctionValue set ");
422: }
423:
424:
425: /* This is not satisfactory. */
426: def SinitOfArray(f) {
427: local p,pos,top;
428: if (IsArray(f)) {
429: sm1(f," toes init /p set ");
430: sm1(p," (es). degree (universalNumber) dc /pos set ");
431: return([Init(f[pos]),pos]);
432: } else {
433: return(Init(f));
434: }
435: }
436:
437: def test_SinitOfArray() {
438: local f, frame,p,tower,i,j,k;
439: Sweyl("x,y,z");
440: f = [x^2+y^2+z^2, x*y+x*z+y*z, x*z^2+y*z^2, y^3-x^2*z - x*y*z+y*z^2,
441: -y^2*z^2 + x*z^3 + y*z^3, -z^4];
442: p=SresolutionFrameWithTower(f);
443: sm1_pmat(p);
444: sm1_pmat(SgenerateTable(p[1]));
445: return(p);
446: frame = p[0];
447: sm1_pmat(p[1]);
448: sm1_pmat(frame);
449: sm1_pmat(Map(frame[0],"SinitOfArray"));
450: sm1_pmat(Map(frame[1],"SinitOfArray"));
451: return(p);
452: }
453:
454: /* f is assumed to be a monomial with toes. */
455: def Sdegree(f,tower,level) {
1.6 takayama 456: local i,ww, wd;
457: /* extern WeightOfSweyl; */
458: ww = WeightOfSweyl;
1.5 takayama 459: f = Init(f);
1.1 takayama 460: if (level <= 1) return(StotalDegree(f));
461: i = Degree(f,es);
1.6 takayama 462: return(StotalDegree(f)+Sdegree(tower[level-2,i],tower,level-1));
463:
1.1 takayama 464: }
465:
466: def SgenerateTable(tower) {
467: local height, n,i,j, ans, ans_at_each_floor;
1.16 takayama 468:
469: /*
470: Print("SgenerateTable: tower=");Println(tower);
471: sm1(" print_switch_status "); */
1.1 takayama 472: height = Length(tower);
473: ans = NewArray(height);
474: for (i=0; i<height; i++) {
475: n = Length(tower[i]);
476: ans_at_each_floor=NewArray(n);
477: for (j=0; j<n; j++) {
1.6 takayama 478: ans_at_each_floor[j] = Sdegree(tower[i,j],tower,i+1)-(i+1)
479: + OFFSET;
1.1 takayama 480: /* Println([i,j,ans_at_each_floor[j]]); */
481: }
482: ans[i] = ans_at_each_floor;
483: }
484: return(ans);
485: }
486: Sweyl("x,y,z");
487: v=[[2*x*Dx + 3*y*Dy+6, 0],
488: [3*x^2*Dy + 2*y*Dx, 0],
489: [0, x^2+y^2],
490: [0, x*y]];
491: /* SresolutionFrameWithTower(v); */
492:
493: def SnewArrayOfFormat(p) {
494: if (IsArray(p)) {
495: return(Map(p,"SnewArrayOfFormat"));
496: }else{
497: return(null);
498: }
499: }
1.4 takayama 500: def ScopyArray(a) {
501: local n, i,ans;
502: n = Length(a);
503: ans = NewArray(n);
504: for (i=0; i<n; i++) {
505: ans[i] = a[i];
506: }
507: return(ans);
508: }
1.1 takayama 509: def SminOfStrategy(a) {
510: local n,i,ans,tt;
511: ans = 100000; /* very big number */
512: if (IsArray(a)) {
513: n = Length(a);
514: for (i=0; i<n; i++) {
515: if (IsArray(a[i])) {
516: tt = SminOfStrategy(a[i]);
517: if (tt < ans) ans = tt;
518: }else{
519: if (a[i] < ans) ans = a[i];
520: }
521: }
522: }else{
523: if (a < ans) ans = a;
524: }
525: return(ans);
526: }
527: def SmaxOfStrategy(a) {
528: local n,i,ans,tt;
529: ans = -100000; /* very small number */
530: if (IsArray(a)) {
531: n = Length(a);
532: for (i=0; i<n; i++) {
533: if (IsArray(a[i])) {
534: tt = SmaxOfStrategy(a[i]);
535: if (tt > ans) ans = tt;
536: }else{
537: if (a[i] > ans) ans = a[i];
538: }
539: }
540: }else{
541: if (a > ans) ans = a;
542: }
543: return(ans);
544: }
545:
546:
1.15 takayama 547: def SlaScala(g,opt) {
1.1 takayama 548: local rf, tower, reductionTable, skel, redundantTable, bases,
549: strategy, maxOfStrategy, height, level, n, i,
550: freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww,
1.4 takayama 551: redundantTable_ordinary, redundant_seq_ordinary,
552: reductionTable_tmp;
1.1 takayama 553: /* extern WeightOfSweyl; */
554: ww = WeightOfSweyl;
1.6 takayama 555: Print("WeightOfSweyl="); Println(WeightOfSweyl);
1.15 takayama 556: rf = SresolutionFrameWithTower(g,opt);
1.14 takayama 557: Print("rf="); sm1_pmat(rf);
1.1 takayama 558: redundant_seq = 1; redundant_seq_ordinary = 1;
559: tower = rf[1];
1.16 takayama 560:
561: Println("Generating reduction table which gives an order of reduction.");
562: Print("WeghtOfSweyl="); Println(WeightOfSweyl);
563: Print("tower"); Println(tower);
1.1 takayama 564: reductionTable = SgenerateTable(tower);
1.16 takayama 565: Print("reductionTable="); sm1_pmat(reductionTable);
566:
1.1 takayama 567: skel = rf[2];
568: redundantTable = SnewArrayOfFormat(rf[1]);
569: redundantTable_ordinary = SnewArrayOfFormat(rf[1]);
570: reducer = SnewArrayOfFormat(rf[1]);
571: freeRes = SnewArrayOfFormat(rf[1]);
572: bettiTable = SsetBettiTable(rf[1],g);
573:
574: strategy = SminOfStrategy( reductionTable );
575: maxOfStrategy = SmaxOfStrategy( reductionTable );
576: height = Length(reductionTable);
577: while (strategy <= maxOfStrategy) {
578: for (level = 0; level < height; level++) {
579: n = Length(reductionTable[level]);
1.4 takayama 580: reductionTable_tmp = ScopyArray(reductionTable[level]);
581: while (SthereIs(reductionTable_tmp,strategy)) {
582: i = SnextI(reductionTable_tmp,strategy,redundantTable,
583: skel,level,freeRes);
584: Println([level,i]);
585: reductionTable_tmp[i] = -200000;
1.1 takayama 586: if (reductionTable[level,i] == strategy) {
1.16 takayama 587: Print("Processing [level,i]= "); Print([level,i]);
1.1 takayama 588: Print(" Strategy = "); Println(strategy);
589: if (level == 0) {
590: if (IsNull(redundantTable[level,i])) {
591: bases = freeRes[level];
592: /* Println(["At floor : GB=",i,bases,tower[0,i]]); */
593: pos = SwhereInGB(tower[0,i],rf[3,0]);
594: bases[i] = rf[3,0,pos];
595: redundantTable[level,i] = 0;
596: redundantTable_ordinary[level,i] = 0;
597: freeRes[level] = bases;
598: /* Println(["GB=",i,bases,tower[0,i]]); */
599: }
600: }else{ /* level >= 1 */
601: if (IsNull(redundantTable[level,i])) {
602: bases = freeRes[level];
603: f = SpairAndReduction(skel,level,i,freeRes,tower,ww);
604: if (f[0] != Poly("0")) {
605: place = f[3];
606: /* (level-1, place) is the place for f[0],
607: which is a newly obtained GB. */
1.19 takayama 608: if (Sordinary) {
1.1 takayama 609: redundantTable[level-1,place] = redundant_seq;
610: redundant_seq++;
1.19 takayama 611: }else{
1.1 takayama 612: if (f[4] > f[5]) {
613: /* Zero in the gr-module */
614: Print("v-degree of [org,remainder] = ");
615: Println([f[4],f[5]]);
616: Print("[level,i] = "); Println([level,i]);
617: redundantTable[level-1,place] = 0;
618: }else{
619: redundantTable[level-1,place] = redundant_seq;
620: redundant_seq++;
621: }
1.19 takayama 622: }
1.1 takayama 623: redundantTable_ordinary[level-1,place]
624: =redundant_seq_ordinary;
625: redundant_seq_ordinary++;
626: bases[i] = SunitOfFormat(place,f[1])-f[1]; /* syzygy */
627: redundantTable[level,i] = 0;
628: redundantTable_ordinary[level,i] = 0;
629: /* i must be equal to f[2], I think. Double check. */
630: freeRes[level] = bases;
631: bases = freeRes[level-1];
632: bases[place] = f[0];
633: freeRes[level-1] = bases;
634: reducer[level-1,place] = f[1];
635: }else{
636: redundantTable[level,i] = 0;
637: bases = freeRes[level];
638: bases[i] = f[1]; /* Put the syzygy. */
639: freeRes[level] = bases;
640: }
641: }
642: } /* end of level >= 1 */
643: }
644: }
645: }
646: strategy++;
647: }
648: n = Length(freeRes);
649: freeResV = SnewArrayOfFormat(freeRes);
650: for (i=0; i<n; i++) {
651: bases = freeRes[i];
652: bases = Sbases_to_vec(bases,bettiTable[i]);
653: freeResV[i] = bases;
654: }
1.17 takayama 655: return([freeResV, redundantTable,reducer,bettiTable,redundantTable_ordinary,rf]);
1.1 takayama 656: }
1.4 takayama 657:
658: def SthereIs(reductionTable_tmp,strategy) {
659: local n,i;
660: n = Length(reductionTable_tmp);
661: for (i=0; i<n; i++) {
662: if (reductionTable_tmp[i] == strategy) {
663: return(true);
664: }
665: }
666: return(false);
667: }
668:
669: def SnextI(reductionTable_tmp,strategy,redundantTable,
670: skel,level,freeRes)
671: {
672: local ii,n,p,myindex,i,j,bases;
673: n = Length(reductionTable_tmp);
674: if (level == 0) {
675: for (ii=0; ii<n; ii++) {
676: if (reductionTable_tmp[ii] == strategy) {
677: return(ii);
678: }
679: }
680: }else{
681: for (ii=0; ii<n; ii++) {
682: if (reductionTable_tmp[ii] == strategy) {
683: p = skel[level,ii];
684: myindex = p[0];
685: i = myindex[0]; j = myindex[1];
686: bases = freeRes[level-1];
687: if (IsNull(bases[i]) || IsNull(bases[j])) {
688:
689: }else{
690: return(ii);
691: }
692: }
693: }
694: }
1.5 takayama 695: Print("reductionTable_tmp=");
1.4 takayama 696: Println(reductionTable_tmp);
1.5 takayama 697: Println("See also reductionTable, strategy, level,i");
1.4 takayama 698: Error("SnextI: bases[i] or bases[j] is null for all combinations.");
699: }
700:
701:
1.1 takayama 702:
703: def SsetBettiTable(freeRes,g) {
704: local level,i, n,bases,ans;
705: ans = NewArray(Length(freeRes)+1);
706: n = Length(freeRes);
707: if (IsArray(g[0])) {
708: ans[0] = Length(g[0]);
709: }else{
710: ans[0] = 1;
711: }
712: for (level=0; level<n; level++) {
713: bases = freeRes[level];
714: if (IsArray(bases)) {
715: ans[level+1] = Length(bases);
716: }else{
717: ans[level+1] = 1;
718: }
719: }
720: return(ans);
721: }
722:
723: def SwhereInGB(f,tower) {
724: local i,n,p,q;
725: n = Length(tower);
726: for (i=0; i<n; i++) {
727: p = MonomialPart(tower[i]);
728: q = MonomialPart(f);
729: if (p == q) return(i);
730: }
731: Println([f,tower]);
732: Error("whereInGB : [f,myset]: f could not be found in the myset.");
733: }
734: def SunitOfFormat(pos,forms) {
735: local ans,i,n;
736: n = Length(forms);
737: ans = NewArray(n);
738: for (i=0; i<n; i++) {
739: if (i != pos) {
740: ans[i] = Poly("0");
741: }else{
742: ans[i] = Poly("1");
743: }
744: }
745: return(ans);
746: }
747:
748:
749: def StowerOf(tower,level) {
750: local ans,i;
751: ans = [ ];
752: if (level == 0) return([[]]);
753: for (i=0; i<level; i++) {
754: ans = Append(ans,tower[i]);
755: }
756: return(Reverse(ans));
757: }
758:
759: def Sspolynomial(f,g) {
760: if (IsArray(f)) {
761: f = Stoes_vec(f);
762: }
763: if (IsArray(g)) {
764: g = Stoes_vec(g);
765: }
766: sm1("f g spol /FunctionValue set");
767: }
768:
769:
1.14 takayama 770: /* WARNING:
771: When you use SwhereInTower, you have to change gbList
772: as below. Ofcourse, you should restrore the gbList
773: SsetTower(StowerOf(tower,level));
774: pos = SwhereInTower(syzHead,tower[level]);
775: */
1.1 takayama 776: def SwhereInTower(f,tower) {
777: local i,n,p,q;
778: if (f == Poly("0")) return(-1);
779: n = Length(tower);
780: for (i=0; i<n; i++) {
781: p = MonomialPart(tower[i]);
782: q = MonomialPart(f);
783: if (p == q) return(i);
784: }
785: Println([f,tower]);
786: Error("[f,tower]: f could not be found in the tower.");
787: }
788:
789: def Stag(f) {
790: sm1(f," tag (universalNumber) dc /FunctionValue set");
791: }
792:
793: def SpairAndReduction(skel,level,ii,freeRes,tower,ww) {
794: local i, j, myindex, p, bases, tower2, gi, gj,
795: si, sj, tmp, t_syz, pos, ans, ssp, syzHead,pos2,
796: vdeg,vdeg_reduced;
797: Println("SpairAndReduction:");
798:
799: if (level < 1) Error("level should be >= 1 in SpairAndReduction.");
800: p = skel[level,ii];
801: myindex = p[0];
802: i = myindex[0]; j = myindex[1];
803: bases = freeRes[level-1];
804: Println(["p and bases ",p,bases]);
805: if (IsNull(bases[i]) || IsNull(bases[j])) {
806: Println([level,i,j,bases[i],bases[j]]);
807: Error("level, i, j : bases[i], bases[j] must not be NULL.");
808: }
809:
810: tower2 = StowerOf(tower,level-1);
811: SsetTower(tower2);
1.14 takayama 812: Println(["level=",level]);
813: Println(["tower2=",tower2]);
1.1 takayama 814: /** sm1(" show_ring "); */
815:
816: gi = Stoes_vec(bases[i]);
817: gj = Stoes_vec(bases[j]);
818:
819: ssp = Sspolynomial(gi,gj);
820: si = ssp[0,0];
821: sj = ssp[0,1];
822: syzHead = si*es^i;
823: /* This will be the head term, I think. But, double check. */
824: Println([si*es^i,sj*es^j]);
825:
826: Print("[gi, gj] = "); Println([gi,gj]);
827: sm1(" [(Homogenize)] system_variable message ");
828: Print("Reduce the element "); Println(si*gi+sj*gj);
829: Print("by "); Println(bases);
830:
831: tmp = Sreduction(si*gi+sj*gj, bases);
832:
833: Print("result is "); Println(tmp);
834:
1.3 takayama 835: /* This is essential part for V-minimal resolution. */
836: /* vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); */
837: vdeg = SvDegree(si*gi,tower,level-1,ww);
1.1 takayama 838: vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww);
839: Print("vdegree of the original = "); Println(vdeg);
840: Print("vdegree of the remainder = "); Println(vdeg_reduced);
841:
842: t_syz = tmp[2];
843: si = si*tmp[1]+t_syz[i];
844: sj = sj*tmp[1]+t_syz[j];
845: t_syz[i] = si;
846: t_syz[j] = sj;
1.14 takayama 847:
848: SsetTower(StowerOf(tower,level));
1.1 takayama 849: pos = SwhereInTower(syzHead,tower[level]);
1.14 takayama 850:
851: SsetTower(StowerOf(tower,level-1));
1.1 takayama 852: pos2 = SwhereInTower(tmp[0],tower[level-1]);
853: ans = [tmp[0],t_syz,pos,pos2,vdeg,vdeg_reduced];
854: /* pos is the place to put syzygy at level. */
855: /* pos2 is the place to put a new GB at level-1. */
856: Println(ans);
857: return(ans);
858: }
859:
860: def Sreduction(f,myset) {
861: local n, indexTable, set2, i, j, tmp, t_syz;
862: n = Length(myset);
863: indexTable = NewArray(n);
864: set2 = [ ];
865: j = 0;
866: for (i=0; i<n; i++) {
867: if (IsNull(myset[i])) {
868: indexTable[i] = -1;
869: /* }else if (myset[i] == Poly("0")) {
870: indexTable[i] = -1; */
871: }else{
872: set2 = Append(set2,Stoes_vec(myset[i]));
873: indexTable[i] = j;
874: j++;
875: }
876: }
877: sm1(" f toes set2 (gradedPolySet) dc reduction /tmp set ");
878: t_syz = NewArray(n);
879: for (i=0; i<n; i++) {
880: if (indexTable[i] != -1) {
881: t_syz[i] = tmp[2, indexTable[i]];
882: }else{
883: t_syz[i] = Poly("0");
884: }
885: }
886: return([tmp[0],tmp[1],t_syz]);
887: }
888:
889:
890: def Sfrom_es(f,size) {
891: local c,ans, i, d, myes, myee, j,n,r,ans2;
892: if (Length(Arglist) < 2) size = -1;
893: if (IsArray(f)) return(f);
894: r = RingOf(f);
895: myes = PolyR("es",r);
896: myee = PolyR("e_",r);
897: if (Degree(f,myee) > 0 && size == -1) {
898: if (size == -1) {
899: sm1(f," (array) dc /ans set");
900: return(ans);
901: }
902: }
903:
904: /*
905: Coefficients(x^2-1,x):
906: [ [ 2 , 0 ] , [ 1 , -1 ] ]
907: */
908: if (Degree(f,myee) > 0) {
909: c = Coefficients(f,myee);
910: }else{
911: c = Coefficients(f,myes);
912: }
913: if (size < 0) {
914: size = c[0,0]+1;
915: }
916: ans = NewArray(size);
917: for (i=0; i<size; i++) {ans[i] = 0;}
918: n = Length(c[0]);
919: for (j=0; j<n; j++) {
920: d = c[0,j];
921: ans[d] = c[1,j];
922: }
923: return(ans);
924: }
925:
926: def Sbases_to_vec(bases,size) {
927: local n, giveSize, newbases,i;
928: /* bases = [1+es*x, [1,2,3*x]] */
929: if (Length(Arglist) > 1) {
930: giveSize = true;
931: }else{
932: giveSize = false;
933: }
934: n = Length(bases);
935: newbases = NewArray(n);
936: for (i=0; i<n; i++) {
937: if (giveSize) {
938: newbases[i] = Sfrom_es(bases[i], size);
939: }else{
940: newbases[i] = Sfrom_es(bases[i]);
941: }
942: }
943: return(newbases);
944: }
945:
1.14 takayama 946: HelpAdd(["Sminimal",
1.18 takayama 947: ["It constructs the V-minimal free resolution by LaScala's algorithm",
1.15 takayama 948: "option: \"homogenized\" (no automatic homogenization ",
1.19 takayama 949: " : \"Sordinary\" (no (u,v)-minimal resolution)",
950: "Options should be given as an array.",
1.14 takayama 951: "Example: Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
952: " v=[[2*x*Dx + 3*y*Dy+6, 0],",
953: " [3*x^2*Dy + 2*y*Dx, 0],",
954: " [0, x^2+y^2],",
955: " [0, x*y]];",
956: " a=Sminimal(v);",
957: " Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
958: " b = ReParse(a[0]); sm1_pmat(b); ",
959: " IsExact_h(b,[x,y]):",
960: "Note: a[0] is the V-minimal resolution. a[3] is the Schreyer resolution."]]);
961:
1.15 takayama 962: def Sminimal(g,opt) {
1.1 takayama 963: local r, freeRes, redundantTable, reducer, maxLevel,
964: minRes, seq, maxSeq, level, betti, q, bases, dr,
1.14 takayama 965: betti_levelplus, newbases, i, j,qq, tminRes;
1.16 takayama 966: if (Length(Arglist) < 2) {
967: opt = null;
968: }
1.19 takayama 969: /* Sordinary is set in SlaScala(g,opt) --> SresolutionFrameWithTower */
970:
1.16 takayama 971: ScheckIfSchreyer("Sminimal:0");
1.15 takayama 972: r = SlaScala(g,opt);
1.1 takayama 973: /* Should I turn off the tower?? */
1.16 takayama 974: ScheckIfSchreyer("Sminimal:1");
1.1 takayama 975: freeRes = r[0];
976: redundantTable = r[1];
977: reducer = r[2];
978: minRes = SnewArrayOfFormat(freeRes);
979: seq = 0;
980: maxSeq = SgetMaxSeq(redundantTable);
981: maxLevel = Length(freeRes);
982: for (level = 0; level < maxLevel; level++) {
983: minRes[level] = freeRes[level];
984: }
985: seq=maxSeq+1;
986: while (seq > 1) {
987: seq--;
988: for (level = 0; level < maxLevel; level++) {
989: betti = Length(freeRes[level]);
990: for (q = 0; q<betti; q++) {
991: if (redundantTable[level,q] == seq) {
992: Print("[seq,level,q]="); Println([seq,level,q]);
993: if (level < maxLevel-1) {
994: bases = freeRes[level+1];
995: dr = reducer[level,q];
996: dr[q] = -1;
997: newbases = SnewArrayOfFormat(bases);
998: betti_levelplus = Length(bases);
999: /*
1000: bases[i,j] ---> bases[i,j]+bases[i,q]*dr[j]
1001: */
1002: for (i=0; i<betti_levelplus; i++) {
1003: newbases[i] = bases[i] + bases[i,q]*dr;
1004: }
1005: Println(["level, q =", level,q]);
1006: Println("bases="); sm1_pmat(bases);
1007: Println("dr="); sm1_pmat(dr);
1008: Println("newbases="); sm1_pmat(newbases);
1009: minRes[level+1] = newbases;
1010: freeRes = minRes;
1011: #ifdef DEBUG
1012: for (qq=0; qq<betti; qq++) {
1013: if ((redundantTable[level,qq] >= seq) &&
1014: (redundantTable[level,qq] <= maxSeq)) {
1015: for (i=0; i<betti_levelplus; i++) {
1016: if (!IsZero(newbases[i,qq])) {
1017: Println(["[i,qq]=",[i,qq]," is not zero in newbases."]);
1018: Print("redundantTable ="); sm1_pmat(redundantTable[level]);
1019: Error("Stop in Sminimal for debugging.");
1020: }
1021: }
1022: }
1023: }
1024: #endif
1025: }
1026: }
1027: }
1028: }
1029: }
1.14 takayama 1030: tminRes = Stetris(minRes,redundantTable);
1031: return([SpruneZeroRow(tminRes), tminRes,
1.17 takayama 1032: [ minRes, redundantTable, reducer,r[3],r[4]],r[0],r[5]]);
1.1 takayama 1033: /* r[4] is the redundantTable_ordinary */
1.3 takayama 1034: /* r[0] is the freeResolution */
1.17 takayama 1035: /* r[5] is the skelton */
1.1 takayama 1036: }
1037:
1038:
1039: def IsZero(f) {
1040: if (IsPolynomial(f)) {
1041: return( f == Poly("0"));
1042: }else if (IsInteger(f)) {
1043: return( f == 0);
1044: }else if (IsSm1Integer(f)) {
1045: return( f == true );
1046: }else if (IsDouble(f)) {
1047: return( f == 0.0 );
1048: }else if (IsRational(f)) {
1049: return(IsZero(Denominator(f)));
1050: }else{
1051: Error("IsZero: cannot deal with this data type.");
1052: }
1053: }
1054: def SgetMaxSeq(redundantTable) {
1055: local level,i,n,ans, levelMax,bases;
1056: levelMax = Length( redundantTable );
1057: ans = 0;
1058: for (level = 0; level < levelMax; level++) {
1059: bases = redundantTable[level];
1060: n = Length(bases);
1061: for (i=0; i<n; i++) {
1062: if (IsInteger( bases[i] )) {
1063: if (bases[i] > ans) {
1064: ans = bases[i];
1065: }
1066: }
1067: }
1068: }
1069: return(ans);
1070: }
1071:
1072: def Stetris(freeRes,redundantTable) {
1073: local level, i, j, resLength, minRes,
1074: bases, newbases, newbases2;
1075: minRes = SnewArrayOfFormat(freeRes);
1076: resLength = Length( freeRes );
1077: for (level=0; level<resLength; level++) {
1078: bases = freeRes[level];
1079: newbases = SnewArrayOfFormat(bases);
1080: betti = Length(bases); j = 0;
1081: /* Delete rows */
1082: for (i=0; i<betti; i++) {
1083: if (redundantTable[level,i] < 1) {
1084: newbases[j] = bases[i];
1085: j++;
1086: }
1087: }
1088: bases = SfirstN(newbases,j);
1089: if (level > 0) {
1090: /* Delete columns */
1091: newbases = Transpose(bases);
1092: betti = Length(newbases); j = 0;
1093: newbases2 = SnewArrayOfFormat(newbases);
1094: for (i=0; i<betti; i++) {
1095: if (redundantTable[level-1,i] < 1) {
1096: newbases2[j] = newbases[i];
1097: j++;
1098: }
1099: }
1100: newbases = Transpose(SfirstN(newbases2,j));
1101: }else{
1102: newbases = bases;
1103: }
1104: Println(["level=", level]);
1105: sm1_pmat(bases);
1106: sm1_pmat(newbases);
1107:
1108: minRes[level] = newbases;
1109: }
1110: return(minRes);
1111: }
1112:
1113: def SfirstN(bases,k) {
1114: local ans,i;
1115: ans = NewArray(k);
1116: for (i=0; i<k; i++) {
1117: ans[i] = bases[i];
1118: }
1119: return(ans);
1120: }
1121:
1122:
1123: /* usage: tt is tower. ww is weight.
1124: a = SresolutionFrameWithTower(v);
1125: tt = a[1];
1126: ww = [x,1,y,1,Dx,1,Dy,1];
1127: SvDegree(x*es,tt,1,ww):
1128:
1129: In(17)=tt:
1130: [[2*x*Dx , e_*x^2 , e_*x*y , 3*x^2*Dy , e_*y^3 , 9*x*y*Dy^2 , 27*y^2*Dy^3 ] ,
1131: [es*y , 3*es^3*y*Dy , 3*es^5*y*Dy , 3*x*Dy , es^2*y^2 , 9*y*Dy^2 ] ,
1132: [3*es^3*y*Dy ] ]
1133: In(18)=SvDegree(x*es,tt,1,ww):
1134: 3
1135: In(19)=SvDegree(x*es^3,tt,1,ww):
1136: 4
1137: In(20)=SvDegree(x,tt,2,ww):
1138: 4
1139:
1140: */
1141: def SvDegree(f,tower,level,w) {
1142: local i,ans;
1143: if (IsZero(f)) return(null);
1.3 takayama 1144: f = Init(f);
1.1 takayama 1145: if (level <= 0) {
1146: return(Sord_w(f,w));
1147: }
1148: i = Degree(f,es);
1149: ans = Sord_w(f,w) +
1150: SvDegree(tower[level-1,i],tower,level-1,w);
1151: return(ans);
1152: }
1153:
1.2 takayama 1154: def Sannfs(f,v) {
1155: local f2;
1156: f2 = ToString(f);
1157: if (IsArray(v)) {
1158: v = Map(v,"ToString");
1159: }
1160: sm1(" [f2 v] annfs /FunctionValue set ");
1161: }
1162:
1163: /* Sannfs2("x^3-y^2"); */
1164: def Sannfs2(f) {
1165: local p,pp;
1166: p = Sannfs(f,"x,y");
1.6 takayama 1167: sm1(" p 0 get { [(x) (y) (Dx) (Dy)] laplace0 } map /p set ");
1168: Sweyl("x,y",[["x",-1,"y",-1,"Dx",1,"Dy",1]]);
1169: pp = Map(p,"Spoly");
1.18 takayama 1170: return(Sminimal(pp));
1.6 takayama 1171: }
1172:
1.10 takayama 1173: HelpAdd(["Sannfs2",
1174: ["Sannfs2(f) constructs the V-minimal free resolution for the weight (-1,1)",
1175: "of the Laplace transform of the annihilating ideal of the polynomial f in x,y.",
1.18 takayama 1176: "See also Sminimal, Sannfs3.",
1.10 takayama 1177: "Example: a=Sannfs2(\"x^3-y^2\");",
1178: " b=a[0]; sm1_pmat(b);",
1179: " b[1]*b[0]:",
1180: "Example: a=Sannfs2(\"x*y*(x-y)*(x+y)\");",
1181: " b=a[0]; sm1_pmat(b);",
1182: " b[1]*b[0]:"
1183: ]]);
1.18 takayama 1184: /* Some samples.
1185: The betti numbers of most examples are 2,1. (0-th and 1-th).
1186: a=Sannfs2("x*y*(x+y-1)"); ==> The betti numbers are 3, 2.
1187: a=Sannfs2("x^3-y^2-x");
1188: a=Sannfs2("x*y*(x-y)");
1189: */
1.10 takayama 1190:
1.11 takayama 1191:
1.3 takayama 1192: def Sannfs3(f) {
1193: local p,pp;
1194: p = Sannfs(f,"x,y,z");
1.6 takayama 1195: sm1(" p 0 get { [(x) (y) (z) (Dx) (Dy) (Dz)] laplace0 } map /p set ");
1.3 takayama 1196: Sweyl("x,y,z",[["x",-1,"y",-1,"z",-1,"Dx",1,"Dy",1,"Dz",1]]);
1.6 takayama 1197: pp = Map(p,"Spoly");
1.18 takayama 1198: return(Sminimal(pp));
1.3 takayama 1199: }
1200:
1.10 takayama 1201: HelpAdd(["Sannfs3",
1202: ["Sannfs3(f) constructs the V-minimal free resolution for the weight (-1,1)",
1203: "of the Laplace transform of the annihilating ideal of the polynomial f in x,y,z.",
1.18 takayama 1204: "See also Sminimal, Sannfs2.",
1.10 takayama 1205: "Example: a=Sannfs3(\"x^3-y^2*z^2\");",
1206: " b=a[0]; sm1_pmat(b);",
1207: " b[1]*b[0]: b[2]*b[1]:"]]);
1208:
1.2 takayama 1209:
1.6 takayama 1210:
1211: /* Sannfs2("x*y*(x-y)*(x+y)"); is a test problem */
1.10 takayama 1212: /* x y (x+y-1)(x-2), x^3-y^2, x^3 - y^2 z^2,
1213: x y z (x+y+z-1) seems to be interesting, because the first syzygy
1214: contains 1.
1215: */
1216:
1217: def CopyArray(m) {
1218: local ans,i,n;
1219: if (IsArray(m)) {
1220: n = Length(m);
1221: ans = NewArray(n);
1222: for (i=0; i<n; i++) {
1223: ans[i] = CopyArray(m[i]);
1224: }
1225: return(ans);
1226: }else{
1227: return(m);
1228: }
1229: }
1230: HelpAdd(["CopyArray",
1231: ["It duplicates the argument array recursively.",
1232: "Example: m=[1,[2,3]];",
1233: " a=CopyArray(m); a[1] = \"Hello\";",
1234: " Println(m); Println(a);"]]);
1235:
1236: def IsZeroVector(m) {
1237: local n,i;
1238: n = Length(m);
1239: for (i=0; i<n; i++) {
1240: if (!IsZero(m[i])) {
1241: return(false);
1242: }
1243: }
1244: return(true);
1245: }
1246:
1247: def SpruneZeroRow(res) {
1248: local minRes, n,i,j,m, base,base2,newbase,newbase2, newMinRes;
1249:
1250: minRes = CopyArray(res);
1251: n = Length(minRes);
1252: for (i=0; i<n; i++) {
1253: base = minRes[i];
1254: m = Length(base);
1255: if (i != n-1) {
1256: base2 = minRes[i+1];
1257: base2 = Transpose(base2);
1258: }
1259: newbase = [ ];
1260: newbase2 = [ ];
1261: for (j=0; j<m; j++) {
1262: if (!IsZeroVector(base[j])) {
1263: newbase = Append(newbase,base[j]);
1264: if (i != n-1) {
1265: newbase2 = Append(newbase2,base2[j]);
1266: }
1267: }
1268: }
1269: minRes[i] = newbase;
1270: if (i != n-1) {
1271: if (newbase2 == [ ]) {
1272: minRes[i+1] = [ ];
1273: }else{
1274: minRes[i+1] = Transpose(newbase2);
1275: }
1276: }
1277: }
1278:
1279: newMinRes = [ ];
1280: n = Length(minRes);
1281: i = 0;
1282: while (i < n ) {
1283: base = minRes[i];
1284: if (base == [ ]) {
1285: i = n; /* break; */
1286: }else{
1287: newMinRes = Append(newMinRes,base);
1288: }
1289: i++;
1290: }
1291: return(newMinRes);
1292: }
1293:
1294: def testAnnfs2(f) {
1295: local a,i,n;
1296: a = Sannfs2(f);
1297: b=a[0];
1298: n = Length(b);
1299: Println("------ V-minimal free resolution -----");
1300: sm1_pmat(b);
1301: Println("----- Is it complex? ---------------");
1302: for (i=0; i<n-1; i++) {
1303: Println(b[i+1]*b[i]);
1304: }
1305: return(a);
1306: }
1307: def testAnnfs3(f) {
1308: local a,i,n;
1309: a = Sannfs3(f);
1310: b=a[0];
1311: n = Length(b);
1312: Println("------ V-minimal free resolution -----");
1313: sm1_pmat(b);
1314: Println("----- Is it complex? ---------------");
1315: for (i=0; i<n-1; i++) {
1316: Println(b[i+1]*b[i]);
1317: }
1.11 takayama 1318: return(a);
1319: }
1320:
1321: def ToString_array(p) {
1322: local ans;
1323: if (IsArray(p)) {
1324: ans = Map(p,"ToString_array");
1325: }else{
1326: ans = ToString(p);
1327: }
1328: return(ans);
1329: }
1330:
1331: /* sm1_res_div([[x],[y]],[[x^2],[x*y],[y^2]],[x,y]): */
1332:
1333: def sm1_res_div(I,J,V) {
1334: I = ToString_array(I);
1335: J = ToString_array(J);
1336: V = ToString_array(V);
1337: sm1(" [[ I J] V ] res*div /FunctionValue set ");
1338: }
1339:
1340: /* It has not yet been working */
1341: def sm1_res_kernel_image(m,n,v) {
1342: m = ToString_array(m);
1343: n = ToString_array(n);
1344: v = ToString_array(v);
1345: sm1(" [m n v] res-kernel-image /FunctionValue set ");
1346: }
1347: def Skernel(m,v) {
1348: m = ToString_array(m);
1349: v = ToString_array(v);
1350: sm1(" [ m v ] syz /FunctionValue set ");
1351: }
1352:
1353:
1354: def sm1_gb(f,v) {
1355: f =ToString_array(f);
1356: v = ToString_array(v);
1357: sm1(" [f v] gb /FunctionValue set ");
1.13 takayama 1358: }
1359:
1.11 takayama 1360:
1.12 takayama 1361: def SisComplex(a) {
1362: local n,i,j,k,b,p,q;
1363: n = Length(a);
1364: for (i=0; i<n-1; i++) {
1365: if (Length(a[i+1]) != 0) {
1366: b = a[i+1]*a[i];
1367: p = Length(b); q = Length(b[0]);
1368: for (j=0; j<p; j++) {
1369: for (k=0; k<q; k++) {
1370: if (!IsZero(b[j,k])) {
1371: Print("Is is not complex at ");
1372: Println([i,j,k]);
1373: return(false);
1374: }
1375: }
1376: }
1377: }
1378: }
1379: return(true);
1.14 takayama 1380: }
1381:
1382: def IsExact_h(c,v) {
1383: local a;
1384: v = ToString_array(v);
1385: a = [c,v];
1386: sm1(a," isExact_h /FunctionValue set ");
1387: }
1388: HelpAdd(["IsExact_h",
1389: ["IsExact_h(complex,var): bool",
1390: "It checks the given complex is exact or not in D<h> (homogenized Weyl algebra)",
1391: "cf. ReParse"
1392: ]]);
1393:
1.21 ! takayama 1394: def IsSameIdeal_h(ii,jj,v) {
! 1395: local a;
! 1396: v = ToString_array(v);
! 1397: a = [ii,jj,v];
! 1398: sm1(a," isSameIdeal_h /FunctionValue set ");
! 1399: }
! 1400: HelpAdd(["IsSameIdeal_h",
! 1401: ["IsSameIdeal_h(ii,jj,var): bool",
! 1402: "It checks the given ideals are the same or not in D<h> (homogenized Weyl algebra)",
! 1403: "cf. ReParse"
! 1404: ]]);
! 1405:
1.14 takayama 1406: def ReParse(a) {
1407: local c;
1408: if (IsArray(a)) {
1409: c = Map(a,"ReParse");
1410: }else{
1411: sm1(a," toString . /c set");
1412: }
1413: return(c);
1414: }
1415: HelpAdd(["ReParse",
1416: ["Reparse(obj): obj",
1417: "It parses the given object in the current ring.",
1418: "Outputs from SlaScala, Sschreyer may cause a trouble in other functions,",
1419: "because it uses the Schreyer order.",
1420: "In this case, ReParse the outputs from these functions.",
1421: "cf. IsExaxt_h"
1422: ]]);
1.16 takayama 1423:
1424: def ScheckIfSchreyer(s) {
1425: local ss;
1426: sm1(" (report) (grade) switch_function /ss set ");
1427: if (ss != "module1v") {
1428: Print("ScheckIfSchreyer: from "); Println(s);
1429: Error("grade is not module1v");
1430: }
1431: /*
1432: sm1(" (report) (mmLarger) switch_function /ss set ");
1433: if (ss != "tower") {
1434: Print("ScheckIfSchreyer: from "); Println(s);
1435: Error("mmLarger is not tower");
1436: }
1437: */
1438: sm1(" [(Schreyer)] system_variable (universalNumber) dc /ss set ");
1439: if (ss != 1) {
1440: Print("ScheckIfSchreyer: from "); Println(s);
1441: Error("Schreyer order is not set.");
1442: }
1443: /* More check will be necessary. */
1444: return(true);
1.21 ! takayama 1445: }
! 1446:
! 1447: def SgetShift(mat,w,m) {
! 1448: local omat;
! 1449: sm1(" mat { w m ord_w<m> {(universalNumber) dc}map } map /omat set");
! 1450: return(Map(omat,"Max"));
! 1451: }
! 1452: HelpAdd(["SgetShift",
! 1453: ["SgetShift(mat,w,m) returns the shift vector of mat with respect to w with the shift m.",
! 1454: "Note that the order of the ring and the weight w must be the same.",
! 1455: "Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ",
! 1456: " SgetShift([[x*Dx+1,Dx^2+x^5],[Poly(\"0\"),x],[x,x]],[\"x\",-1,\"Dx\",1],[2,0]):"]]);
! 1457:
! 1458: def SgetShifts(resmat,w) {
! 1459: local i,n,ans,m0;
! 1460: n = Length(resmat);
! 1461: ans = NewArray(n);
! 1462: m0 = NewArray(Length(resmat[0,0]));
! 1463: ans[0] = m0;
! 1464: for (i=0; i<n-1; i++) {
! 1465: ans[i+1] = SgetShift(resmat[i],w,m0);
! 1466: m0 = ans[i+1];
! 1467: }
! 1468: return(ans);
! 1469: }
! 1470: HelpAdd(["SgetShifts",
! 1471: ["SgetShifts(resmat,w) returns the shift vectors of the resolution resmat",
! 1472: " with respect to w with the shift m.",
! 1473: "Note that the order of the ring and the weight w must be the same.",
! 1474: "Zero row is not allowed.",
! 1475: "Example: a=Sannfs2(\"x^3-y^2\");",
! 1476: " b=a[0]; w = [\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1];",
! 1477: " Sweyl(\"x,y\",[w]); b = Reparse(b);",
! 1478: " SgetShifts(b,w):"]]);
! 1479:
! 1480: def Sinit_w(resmat,w) {
! 1481: local shifts,ans,n,i,m,mat,j;
! 1482: shifts = SgetShifts(resmat,w);
! 1483: n = Length(resmat);
! 1484: ans = NewArray(n);
! 1485: for (i=0; i<n; i++) {
! 1486: m = shifts[i];
! 1487: mat = ScopyArray(resmat[i]);
! 1488: for (j=0; j<Length(mat); j++) {
! 1489: mat[j] = Init_w_m(mat[j],w,m);
! 1490: }
! 1491: ans[i] = mat;
! 1492: }
! 1493: return(ans);
! 1494: }
! 1495: HelpAdd(["Sinit_w",
! 1496: ["Sinit_w(resmat,w) returns the initial of the complex resmat with respect to the weight w.",
! 1497: "Example: a=Sannfs2(\"x^3-y^2\");",
! 1498: " b=a[0]; w = [\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1];",
! 1499: " Sweyl(\"x,y\",[w]); b = Reparse(b);",
! 1500: " c=Sinit_w(b,w); c:"
! 1501: ]]);
! 1502:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>