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