Annotation of OpenXM/src/k097/lib/minimal/minimal.k, Revision 1.19
1.19 ! takayama 1: /* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.18 2000/07/30 02:26:25 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:
361: /* Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]); */
362: def Sord_w(f,w) {
363: local neww,i,n;
364: n = Length(w);
365: neww = NewArray(n);
366: for (i=0; i<n; i=i+2) {
367: neww[i] = ToString(w[i]);
368: }
369: for (i=1; i<n; i=i+2) {
370: neww[i] = IntegerToSm1Integer(w[i]);
371: }
372: sm1(" f neww ord_w (universalNumber) dc /FunctionValue set ");
373: }
374:
375:
376: /* This is not satisfactory. */
377: def SinitOfArray(f) {
378: local p,pos,top;
379: if (IsArray(f)) {
380: sm1(f," toes init /p set ");
381: sm1(p," (es). degree (universalNumber) dc /pos set ");
382: return([Init(f[pos]),pos]);
383: } else {
384: return(Init(f));
385: }
386: }
387:
388: def test_SinitOfArray() {
389: local f, frame,p,tower,i,j,k;
390: Sweyl("x,y,z");
391: 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,
392: -y^2*z^2 + x*z^3 + y*z^3, -z^4];
393: p=SresolutionFrameWithTower(f);
394: sm1_pmat(p);
395: sm1_pmat(SgenerateTable(p[1]));
396: return(p);
397: frame = p[0];
398: sm1_pmat(p[1]);
399: sm1_pmat(frame);
400: sm1_pmat(Map(frame[0],"SinitOfArray"));
401: sm1_pmat(Map(frame[1],"SinitOfArray"));
402: return(p);
403: }
404:
405: /* f is assumed to be a monomial with toes. */
406: def Sdegree(f,tower,level) {
1.6 takayama 407: local i,ww, wd;
408: /* extern WeightOfSweyl; */
409: ww = WeightOfSweyl;
1.5 takayama 410: f = Init(f);
1.1 takayama 411: if (level <= 1) return(StotalDegree(f));
412: i = Degree(f,es);
1.6 takayama 413: return(StotalDegree(f)+Sdegree(tower[level-2,i],tower,level-1));
414:
1.1 takayama 415: }
416:
417: def SgenerateTable(tower) {
418: local height, n,i,j, ans, ans_at_each_floor;
1.16 takayama 419:
420: /*
421: Print("SgenerateTable: tower=");Println(tower);
422: sm1(" print_switch_status "); */
1.1 takayama 423: height = Length(tower);
424: ans = NewArray(height);
425: for (i=0; i<height; i++) {
426: n = Length(tower[i]);
427: ans_at_each_floor=NewArray(n);
428: for (j=0; j<n; j++) {
1.6 takayama 429: ans_at_each_floor[j] = Sdegree(tower[i,j],tower,i+1)-(i+1)
430: + OFFSET;
1.1 takayama 431: /* Println([i,j,ans_at_each_floor[j]]); */
432: }
433: ans[i] = ans_at_each_floor;
434: }
435: return(ans);
436: }
437: Sweyl("x,y,z");
438: v=[[2*x*Dx + 3*y*Dy+6, 0],
439: [3*x^2*Dy + 2*y*Dx, 0],
440: [0, x^2+y^2],
441: [0, x*y]];
442: /* SresolutionFrameWithTower(v); */
443:
444: def SnewArrayOfFormat(p) {
445: if (IsArray(p)) {
446: return(Map(p,"SnewArrayOfFormat"));
447: }else{
448: return(null);
449: }
450: }
1.4 takayama 451: def ScopyArray(a) {
452: local n, i,ans;
453: n = Length(a);
454: ans = NewArray(n);
455: for (i=0; i<n; i++) {
456: ans[i] = a[i];
457: }
458: return(ans);
459: }
1.1 takayama 460: def SminOfStrategy(a) {
461: local n,i,ans,tt;
462: ans = 100000; /* very big number */
463: if (IsArray(a)) {
464: n = Length(a);
465: for (i=0; i<n; i++) {
466: if (IsArray(a[i])) {
467: tt = SminOfStrategy(a[i]);
468: if (tt < ans) ans = tt;
469: }else{
470: if (a[i] < ans) ans = a[i];
471: }
472: }
473: }else{
474: if (a < ans) ans = a;
475: }
476: return(ans);
477: }
478: def SmaxOfStrategy(a) {
479: local n,i,ans,tt;
480: ans = -100000; /* very small number */
481: if (IsArray(a)) {
482: n = Length(a);
483: for (i=0; i<n; i++) {
484: if (IsArray(a[i])) {
485: tt = SmaxOfStrategy(a[i]);
486: if (tt > ans) ans = tt;
487: }else{
488: if (a[i] > ans) ans = a[i];
489: }
490: }
491: }else{
492: if (a > ans) ans = a;
493: }
494: return(ans);
495: }
496:
497:
1.15 takayama 498: def SlaScala(g,opt) {
1.1 takayama 499: local rf, tower, reductionTable, skel, redundantTable, bases,
500: strategy, maxOfStrategy, height, level, n, i,
501: freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww,
1.4 takayama 502: redundantTable_ordinary, redundant_seq_ordinary,
503: reductionTable_tmp;
1.1 takayama 504: /* extern WeightOfSweyl; */
505: ww = WeightOfSweyl;
1.6 takayama 506: Print("WeightOfSweyl="); Println(WeightOfSweyl);
1.15 takayama 507: rf = SresolutionFrameWithTower(g,opt);
1.14 takayama 508: Print("rf="); sm1_pmat(rf);
1.1 takayama 509: redundant_seq = 1; redundant_seq_ordinary = 1;
510: tower = rf[1];
1.16 takayama 511:
512: Println("Generating reduction table which gives an order of reduction.");
513: Print("WeghtOfSweyl="); Println(WeightOfSweyl);
514: Print("tower"); Println(tower);
1.1 takayama 515: reductionTable = SgenerateTable(tower);
1.16 takayama 516: Print("reductionTable="); sm1_pmat(reductionTable);
517:
1.1 takayama 518: skel = rf[2];
519: redundantTable = SnewArrayOfFormat(rf[1]);
520: redundantTable_ordinary = SnewArrayOfFormat(rf[1]);
521: reducer = SnewArrayOfFormat(rf[1]);
522: freeRes = SnewArrayOfFormat(rf[1]);
523: bettiTable = SsetBettiTable(rf[1],g);
524:
525: strategy = SminOfStrategy( reductionTable );
526: maxOfStrategy = SmaxOfStrategy( reductionTable );
527: height = Length(reductionTable);
528: while (strategy <= maxOfStrategy) {
529: for (level = 0; level < height; level++) {
530: n = Length(reductionTable[level]);
1.4 takayama 531: reductionTable_tmp = ScopyArray(reductionTable[level]);
532: while (SthereIs(reductionTable_tmp,strategy)) {
533: i = SnextI(reductionTable_tmp,strategy,redundantTable,
534: skel,level,freeRes);
535: Println([level,i]);
536: reductionTable_tmp[i] = -200000;
1.1 takayama 537: if (reductionTable[level,i] == strategy) {
1.16 takayama 538: Print("Processing [level,i]= "); Print([level,i]);
1.1 takayama 539: Print(" Strategy = "); Println(strategy);
540: if (level == 0) {
541: if (IsNull(redundantTable[level,i])) {
542: bases = freeRes[level];
543: /* Println(["At floor : GB=",i,bases,tower[0,i]]); */
544: pos = SwhereInGB(tower[0,i],rf[3,0]);
545: bases[i] = rf[3,0,pos];
546: redundantTable[level,i] = 0;
547: redundantTable_ordinary[level,i] = 0;
548: freeRes[level] = bases;
549: /* Println(["GB=",i,bases,tower[0,i]]); */
550: }
551: }else{ /* level >= 1 */
552: if (IsNull(redundantTable[level,i])) {
553: bases = freeRes[level];
554: f = SpairAndReduction(skel,level,i,freeRes,tower,ww);
555: if (f[0] != Poly("0")) {
556: place = f[3];
557: /* (level-1, place) is the place for f[0],
558: which is a newly obtained GB. */
1.19 ! takayama 559: if (Sordinary) {
1.1 takayama 560: redundantTable[level-1,place] = redundant_seq;
561: redundant_seq++;
1.19 ! takayama 562: }else{
1.1 takayama 563: if (f[4] > f[5]) {
564: /* Zero in the gr-module */
565: Print("v-degree of [org,remainder] = ");
566: Println([f[4],f[5]]);
567: Print("[level,i] = "); Println([level,i]);
568: redundantTable[level-1,place] = 0;
569: }else{
570: redundantTable[level-1,place] = redundant_seq;
571: redundant_seq++;
572: }
1.19 ! takayama 573: }
1.1 takayama 574: redundantTable_ordinary[level-1,place]
575: =redundant_seq_ordinary;
576: redundant_seq_ordinary++;
577: bases[i] = SunitOfFormat(place,f[1])-f[1]; /* syzygy */
578: redundantTable[level,i] = 0;
579: redundantTable_ordinary[level,i] = 0;
580: /* i must be equal to f[2], I think. Double check. */
581: freeRes[level] = bases;
582: bases = freeRes[level-1];
583: bases[place] = f[0];
584: freeRes[level-1] = bases;
585: reducer[level-1,place] = f[1];
586: }else{
587: redundantTable[level,i] = 0;
588: bases = freeRes[level];
589: bases[i] = f[1]; /* Put the syzygy. */
590: freeRes[level] = bases;
591: }
592: }
593: } /* end of level >= 1 */
594: }
595: }
596: }
597: strategy++;
598: }
599: n = Length(freeRes);
600: freeResV = SnewArrayOfFormat(freeRes);
601: for (i=0; i<n; i++) {
602: bases = freeRes[i];
603: bases = Sbases_to_vec(bases,bettiTable[i]);
604: freeResV[i] = bases;
605: }
1.17 takayama 606: return([freeResV, redundantTable,reducer,bettiTable,redundantTable_ordinary,rf]);
1.1 takayama 607: }
1.4 takayama 608:
609: def SthereIs(reductionTable_tmp,strategy) {
610: local n,i;
611: n = Length(reductionTable_tmp);
612: for (i=0; i<n; i++) {
613: if (reductionTable_tmp[i] == strategy) {
614: return(true);
615: }
616: }
617: return(false);
618: }
619:
620: def SnextI(reductionTable_tmp,strategy,redundantTable,
621: skel,level,freeRes)
622: {
623: local ii,n,p,myindex,i,j,bases;
624: n = Length(reductionTable_tmp);
625: if (level == 0) {
626: for (ii=0; ii<n; ii++) {
627: if (reductionTable_tmp[ii] == strategy) {
628: return(ii);
629: }
630: }
631: }else{
632: for (ii=0; ii<n; ii++) {
633: if (reductionTable_tmp[ii] == strategy) {
634: p = skel[level,ii];
635: myindex = p[0];
636: i = myindex[0]; j = myindex[1];
637: bases = freeRes[level-1];
638: if (IsNull(bases[i]) || IsNull(bases[j])) {
639:
640: }else{
641: return(ii);
642: }
643: }
644: }
645: }
1.5 takayama 646: Print("reductionTable_tmp=");
1.4 takayama 647: Println(reductionTable_tmp);
1.5 takayama 648: Println("See also reductionTable, strategy, level,i");
1.4 takayama 649: Error("SnextI: bases[i] or bases[j] is null for all combinations.");
650: }
651:
652:
1.1 takayama 653:
654: def SsetBettiTable(freeRes,g) {
655: local level,i, n,bases,ans;
656: ans = NewArray(Length(freeRes)+1);
657: n = Length(freeRes);
658: if (IsArray(g[0])) {
659: ans[0] = Length(g[0]);
660: }else{
661: ans[0] = 1;
662: }
663: for (level=0; level<n; level++) {
664: bases = freeRes[level];
665: if (IsArray(bases)) {
666: ans[level+1] = Length(bases);
667: }else{
668: ans[level+1] = 1;
669: }
670: }
671: return(ans);
672: }
673:
674: def SwhereInGB(f,tower) {
675: local i,n,p,q;
676: n = Length(tower);
677: for (i=0; i<n; i++) {
678: p = MonomialPart(tower[i]);
679: q = MonomialPart(f);
680: if (p == q) return(i);
681: }
682: Println([f,tower]);
683: Error("whereInGB : [f,myset]: f could not be found in the myset.");
684: }
685: def SunitOfFormat(pos,forms) {
686: local ans,i,n;
687: n = Length(forms);
688: ans = NewArray(n);
689: for (i=0; i<n; i++) {
690: if (i != pos) {
691: ans[i] = Poly("0");
692: }else{
693: ans[i] = Poly("1");
694: }
695: }
696: return(ans);
697: }
698:
699:
700: def StowerOf(tower,level) {
701: local ans,i;
702: ans = [ ];
703: if (level == 0) return([[]]);
704: for (i=0; i<level; i++) {
705: ans = Append(ans,tower[i]);
706: }
707: return(Reverse(ans));
708: }
709:
710: def Sspolynomial(f,g) {
711: if (IsArray(f)) {
712: f = Stoes_vec(f);
713: }
714: if (IsArray(g)) {
715: g = Stoes_vec(g);
716: }
717: sm1("f g spol /FunctionValue set");
718: }
719:
720:
1.14 takayama 721: /* WARNING:
722: When you use SwhereInTower, you have to change gbList
723: as below. Ofcourse, you should restrore the gbList
724: SsetTower(StowerOf(tower,level));
725: pos = SwhereInTower(syzHead,tower[level]);
726: */
1.1 takayama 727: def SwhereInTower(f,tower) {
728: local i,n,p,q;
729: if (f == Poly("0")) return(-1);
730: n = Length(tower);
731: for (i=0; i<n; i++) {
732: p = MonomialPart(tower[i]);
733: q = MonomialPart(f);
734: if (p == q) return(i);
735: }
736: Println([f,tower]);
737: Error("[f,tower]: f could not be found in the tower.");
738: }
739:
740: def Stag(f) {
741: sm1(f," tag (universalNumber) dc /FunctionValue set");
742: }
743:
744: def SpairAndReduction(skel,level,ii,freeRes,tower,ww) {
745: local i, j, myindex, p, bases, tower2, gi, gj,
746: si, sj, tmp, t_syz, pos, ans, ssp, syzHead,pos2,
747: vdeg,vdeg_reduced;
748: Println("SpairAndReduction:");
749:
750: if (level < 1) Error("level should be >= 1 in SpairAndReduction.");
751: p = skel[level,ii];
752: myindex = p[0];
753: i = myindex[0]; j = myindex[1];
754: bases = freeRes[level-1];
755: Println(["p and bases ",p,bases]);
756: if (IsNull(bases[i]) || IsNull(bases[j])) {
757: Println([level,i,j,bases[i],bases[j]]);
758: Error("level, i, j : bases[i], bases[j] must not be NULL.");
759: }
760:
761: tower2 = StowerOf(tower,level-1);
762: SsetTower(tower2);
1.14 takayama 763: Println(["level=",level]);
764: Println(["tower2=",tower2]);
1.1 takayama 765: /** sm1(" show_ring "); */
766:
767: gi = Stoes_vec(bases[i]);
768: gj = Stoes_vec(bases[j]);
769:
770: ssp = Sspolynomial(gi,gj);
771: si = ssp[0,0];
772: sj = ssp[0,1];
773: syzHead = si*es^i;
774: /* This will be the head term, I think. But, double check. */
775: Println([si*es^i,sj*es^j]);
776:
777: Print("[gi, gj] = "); Println([gi,gj]);
778: sm1(" [(Homogenize)] system_variable message ");
779: Print("Reduce the element "); Println(si*gi+sj*gj);
780: Print("by "); Println(bases);
781:
782: tmp = Sreduction(si*gi+sj*gj, bases);
783:
784: Print("result is "); Println(tmp);
785:
1.3 takayama 786: /* This is essential part for V-minimal resolution. */
787: /* vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); */
788: vdeg = SvDegree(si*gi,tower,level-1,ww);
1.1 takayama 789: vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww);
790: Print("vdegree of the original = "); Println(vdeg);
791: Print("vdegree of the remainder = "); Println(vdeg_reduced);
792:
793: t_syz = tmp[2];
794: si = si*tmp[1]+t_syz[i];
795: sj = sj*tmp[1]+t_syz[j];
796: t_syz[i] = si;
797: t_syz[j] = sj;
1.14 takayama 798:
799: SsetTower(StowerOf(tower,level));
1.1 takayama 800: pos = SwhereInTower(syzHead,tower[level]);
1.14 takayama 801:
802: SsetTower(StowerOf(tower,level-1));
1.1 takayama 803: pos2 = SwhereInTower(tmp[0],tower[level-1]);
804: ans = [tmp[0],t_syz,pos,pos2,vdeg,vdeg_reduced];
805: /* pos is the place to put syzygy at level. */
806: /* pos2 is the place to put a new GB at level-1. */
807: Println(ans);
808: return(ans);
809: }
810:
811: def Sreduction(f,myset) {
812: local n, indexTable, set2, i, j, tmp, t_syz;
813: n = Length(myset);
814: indexTable = NewArray(n);
815: set2 = [ ];
816: j = 0;
817: for (i=0; i<n; i++) {
818: if (IsNull(myset[i])) {
819: indexTable[i] = -1;
820: /* }else if (myset[i] == Poly("0")) {
821: indexTable[i] = -1; */
822: }else{
823: set2 = Append(set2,Stoes_vec(myset[i]));
824: indexTable[i] = j;
825: j++;
826: }
827: }
828: sm1(" f toes set2 (gradedPolySet) dc reduction /tmp set ");
829: t_syz = NewArray(n);
830: for (i=0; i<n; i++) {
831: if (indexTable[i] != -1) {
832: t_syz[i] = tmp[2, indexTable[i]];
833: }else{
834: t_syz[i] = Poly("0");
835: }
836: }
837: return([tmp[0],tmp[1],t_syz]);
838: }
839:
840:
841: def Sfrom_es(f,size) {
842: local c,ans, i, d, myes, myee, j,n,r,ans2;
843: if (Length(Arglist) < 2) size = -1;
844: if (IsArray(f)) return(f);
845: r = RingOf(f);
846: myes = PolyR("es",r);
847: myee = PolyR("e_",r);
848: if (Degree(f,myee) > 0 && size == -1) {
849: if (size == -1) {
850: sm1(f," (array) dc /ans set");
851: return(ans);
852: }
853: }
854:
855: /*
856: Coefficients(x^2-1,x):
857: [ [ 2 , 0 ] , [ 1 , -1 ] ]
858: */
859: if (Degree(f,myee) > 0) {
860: c = Coefficients(f,myee);
861: }else{
862: c = Coefficients(f,myes);
863: }
864: if (size < 0) {
865: size = c[0,0]+1;
866: }
867: ans = NewArray(size);
868: for (i=0; i<size; i++) {ans[i] = 0;}
869: n = Length(c[0]);
870: for (j=0; j<n; j++) {
871: d = c[0,j];
872: ans[d] = c[1,j];
873: }
874: return(ans);
875: }
876:
877: def Sbases_to_vec(bases,size) {
878: local n, giveSize, newbases,i;
879: /* bases = [1+es*x, [1,2,3*x]] */
880: if (Length(Arglist) > 1) {
881: giveSize = true;
882: }else{
883: giveSize = false;
884: }
885: n = Length(bases);
886: newbases = NewArray(n);
887: for (i=0; i<n; i++) {
888: if (giveSize) {
889: newbases[i] = Sfrom_es(bases[i], size);
890: }else{
891: newbases[i] = Sfrom_es(bases[i]);
892: }
893: }
894: return(newbases);
895: }
896:
1.14 takayama 897: HelpAdd(["Sminimal",
1.18 takayama 898: ["It constructs the V-minimal free resolution by LaScala's algorithm",
1.15 takayama 899: "option: \"homogenized\" (no automatic homogenization ",
1.19 ! takayama 900: " : \"Sordinary\" (no (u,v)-minimal resolution)",
! 901: "Options should be given as an array.",
1.14 takayama 902: "Example: Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
903: " v=[[2*x*Dx + 3*y*Dy+6, 0],",
904: " [3*x^2*Dy + 2*y*Dx, 0],",
905: " [0, x^2+y^2],",
906: " [0, x*y]];",
907: " a=Sminimal(v);",
908: " Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
909: " b = ReParse(a[0]); sm1_pmat(b); ",
910: " IsExact_h(b,[x,y]):",
911: "Note: a[0] is the V-minimal resolution. a[3] is the Schreyer resolution."]]);
912:
1.15 takayama 913: def Sminimal(g,opt) {
1.1 takayama 914: local r, freeRes, redundantTable, reducer, maxLevel,
915: minRes, seq, maxSeq, level, betti, q, bases, dr,
1.14 takayama 916: betti_levelplus, newbases, i, j,qq, tminRes;
1.16 takayama 917: if (Length(Arglist) < 2) {
918: opt = null;
919: }
1.19 ! takayama 920: /* Sordinary is set in SlaScala(g,opt) --> SresolutionFrameWithTower */
! 921:
1.16 takayama 922: ScheckIfSchreyer("Sminimal:0");
1.15 takayama 923: r = SlaScala(g,opt);
1.1 takayama 924: /* Should I turn off the tower?? */
1.16 takayama 925: ScheckIfSchreyer("Sminimal:1");
1.1 takayama 926: freeRes = r[0];
927: redundantTable = r[1];
928: reducer = r[2];
929: minRes = SnewArrayOfFormat(freeRes);
930: seq = 0;
931: maxSeq = SgetMaxSeq(redundantTable);
932: maxLevel = Length(freeRes);
933: for (level = 0; level < maxLevel; level++) {
934: minRes[level] = freeRes[level];
935: }
936: seq=maxSeq+1;
937: while (seq > 1) {
938: seq--;
939: for (level = 0; level < maxLevel; level++) {
940: betti = Length(freeRes[level]);
941: for (q = 0; q<betti; q++) {
942: if (redundantTable[level,q] == seq) {
943: Print("[seq,level,q]="); Println([seq,level,q]);
944: if (level < maxLevel-1) {
945: bases = freeRes[level+1];
946: dr = reducer[level,q];
947: dr[q] = -1;
948: newbases = SnewArrayOfFormat(bases);
949: betti_levelplus = Length(bases);
950: /*
951: bases[i,j] ---> bases[i,j]+bases[i,q]*dr[j]
952: */
953: for (i=0; i<betti_levelplus; i++) {
954: newbases[i] = bases[i] + bases[i,q]*dr;
955: }
956: Println(["level, q =", level,q]);
957: Println("bases="); sm1_pmat(bases);
958: Println("dr="); sm1_pmat(dr);
959: Println("newbases="); sm1_pmat(newbases);
960: minRes[level+1] = newbases;
961: freeRes = minRes;
962: #ifdef DEBUG
963: for (qq=0; qq<betti; qq++) {
964: if ((redundantTable[level,qq] >= seq) &&
965: (redundantTable[level,qq] <= maxSeq)) {
966: for (i=0; i<betti_levelplus; i++) {
967: if (!IsZero(newbases[i,qq])) {
968: Println(["[i,qq]=",[i,qq]," is not zero in newbases."]);
969: Print("redundantTable ="); sm1_pmat(redundantTable[level]);
970: Error("Stop in Sminimal for debugging.");
971: }
972: }
973: }
974: }
975: #endif
976: }
977: }
978: }
979: }
980: }
1.14 takayama 981: tminRes = Stetris(minRes,redundantTable);
982: return([SpruneZeroRow(tminRes), tminRes,
1.17 takayama 983: [ minRes, redundantTable, reducer,r[3],r[4]],r[0],r[5]]);
1.1 takayama 984: /* r[4] is the redundantTable_ordinary */
1.3 takayama 985: /* r[0] is the freeResolution */
1.17 takayama 986: /* r[5] is the skelton */
1.1 takayama 987: }
988:
989:
990: def IsZero(f) {
991: if (IsPolynomial(f)) {
992: return( f == Poly("0"));
993: }else if (IsInteger(f)) {
994: return( f == 0);
995: }else if (IsSm1Integer(f)) {
996: return( f == true );
997: }else if (IsDouble(f)) {
998: return( f == 0.0 );
999: }else if (IsRational(f)) {
1000: return(IsZero(Denominator(f)));
1001: }else{
1002: Error("IsZero: cannot deal with this data type.");
1003: }
1004: }
1005: def SgetMaxSeq(redundantTable) {
1006: local level,i,n,ans, levelMax,bases;
1007: levelMax = Length( redundantTable );
1008: ans = 0;
1009: for (level = 0; level < levelMax; level++) {
1010: bases = redundantTable[level];
1011: n = Length(bases);
1012: for (i=0; i<n; i++) {
1013: if (IsInteger( bases[i] )) {
1014: if (bases[i] > ans) {
1015: ans = bases[i];
1016: }
1017: }
1018: }
1019: }
1020: return(ans);
1021: }
1022:
1023: def Stetris(freeRes,redundantTable) {
1024: local level, i, j, resLength, minRes,
1025: bases, newbases, newbases2;
1026: minRes = SnewArrayOfFormat(freeRes);
1027: resLength = Length( freeRes );
1028: for (level=0; level<resLength; level++) {
1029: bases = freeRes[level];
1030: newbases = SnewArrayOfFormat(bases);
1031: betti = Length(bases); j = 0;
1032: /* Delete rows */
1033: for (i=0; i<betti; i++) {
1034: if (redundantTable[level,i] < 1) {
1035: newbases[j] = bases[i];
1036: j++;
1037: }
1038: }
1039: bases = SfirstN(newbases,j);
1040: if (level > 0) {
1041: /* Delete columns */
1042: newbases = Transpose(bases);
1043: betti = Length(newbases); j = 0;
1044: newbases2 = SnewArrayOfFormat(newbases);
1045: for (i=0; i<betti; i++) {
1046: if (redundantTable[level-1,i] < 1) {
1047: newbases2[j] = newbases[i];
1048: j++;
1049: }
1050: }
1051: newbases = Transpose(SfirstN(newbases2,j));
1052: }else{
1053: newbases = bases;
1054: }
1055: Println(["level=", level]);
1056: sm1_pmat(bases);
1057: sm1_pmat(newbases);
1058:
1059: minRes[level] = newbases;
1060: }
1061: return(minRes);
1062: }
1063:
1064: def SfirstN(bases,k) {
1065: local ans,i;
1066: ans = NewArray(k);
1067: for (i=0; i<k; i++) {
1068: ans[i] = bases[i];
1069: }
1070: return(ans);
1071: }
1072:
1073:
1074: /* usage: tt is tower. ww is weight.
1075: a = SresolutionFrameWithTower(v);
1076: tt = a[1];
1077: ww = [x,1,y,1,Dx,1,Dy,1];
1078: SvDegree(x*es,tt,1,ww):
1079:
1080: In(17)=tt:
1081: [[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 ] ,
1082: [es*y , 3*es^3*y*Dy , 3*es^5*y*Dy , 3*x*Dy , es^2*y^2 , 9*y*Dy^2 ] ,
1083: [3*es^3*y*Dy ] ]
1084: In(18)=SvDegree(x*es,tt,1,ww):
1085: 3
1086: In(19)=SvDegree(x*es^3,tt,1,ww):
1087: 4
1088: In(20)=SvDegree(x,tt,2,ww):
1089: 4
1090:
1091: */
1092: def SvDegree(f,tower,level,w) {
1093: local i,ans;
1094: if (IsZero(f)) return(null);
1.3 takayama 1095: f = Init(f);
1.1 takayama 1096: if (level <= 0) {
1097: return(Sord_w(f,w));
1098: }
1099: i = Degree(f,es);
1100: ans = Sord_w(f,w) +
1101: SvDegree(tower[level-1,i],tower,level-1,w);
1102: return(ans);
1103: }
1104:
1.2 takayama 1105: def Sannfs(f,v) {
1106: local f2;
1107: f2 = ToString(f);
1108: if (IsArray(v)) {
1109: v = Map(v,"ToString");
1110: }
1111: sm1(" [f2 v] annfs /FunctionValue set ");
1112: }
1113:
1114: /* Sannfs2("x^3-y^2"); */
1115: def Sannfs2(f) {
1116: local p,pp;
1117: p = Sannfs(f,"x,y");
1.6 takayama 1118: sm1(" p 0 get { [(x) (y) (Dx) (Dy)] laplace0 } map /p set ");
1119: Sweyl("x,y",[["x",-1,"y",-1,"Dx",1,"Dy",1]]);
1120: pp = Map(p,"Spoly");
1.18 takayama 1121: return(Sminimal(pp));
1.6 takayama 1122: }
1123:
1.10 takayama 1124: HelpAdd(["Sannfs2",
1125: ["Sannfs2(f) constructs the V-minimal free resolution for the weight (-1,1)",
1126: "of the Laplace transform of the annihilating ideal of the polynomial f in x,y.",
1.18 takayama 1127: "See also Sminimal, Sannfs3.",
1.10 takayama 1128: "Example: a=Sannfs2(\"x^3-y^2\");",
1129: " b=a[0]; sm1_pmat(b);",
1130: " b[1]*b[0]:",
1131: "Example: a=Sannfs2(\"x*y*(x-y)*(x+y)\");",
1132: " b=a[0]; sm1_pmat(b);",
1133: " b[1]*b[0]:"
1134: ]]);
1.18 takayama 1135: /* Some samples.
1136: The betti numbers of most examples are 2,1. (0-th and 1-th).
1137: a=Sannfs2("x*y*(x+y-1)"); ==> The betti numbers are 3, 2.
1138: a=Sannfs2("x^3-y^2-x");
1139: a=Sannfs2("x*y*(x-y)");
1140: */
1.10 takayama 1141:
1.11 takayama 1142:
1.3 takayama 1143: def Sannfs3(f) {
1144: local p,pp;
1145: p = Sannfs(f,"x,y,z");
1.6 takayama 1146: sm1(" p 0 get { [(x) (y) (z) (Dx) (Dy) (Dz)] laplace0 } map /p set ");
1.3 takayama 1147: Sweyl("x,y,z",[["x",-1,"y",-1,"z",-1,"Dx",1,"Dy",1,"Dz",1]]);
1.6 takayama 1148: pp = Map(p,"Spoly");
1.18 takayama 1149: return(Sminimal(pp));
1.3 takayama 1150: }
1151:
1.10 takayama 1152: HelpAdd(["Sannfs3",
1153: ["Sannfs3(f) constructs the V-minimal free resolution for the weight (-1,1)",
1154: "of the Laplace transform of the annihilating ideal of the polynomial f in x,y,z.",
1.18 takayama 1155: "See also Sminimal, Sannfs2.",
1.10 takayama 1156: "Example: a=Sannfs3(\"x^3-y^2*z^2\");",
1157: " b=a[0]; sm1_pmat(b);",
1158: " b[1]*b[0]: b[2]*b[1]:"]]);
1159:
1.2 takayama 1160:
1.6 takayama 1161:
1162: /* Sannfs2("x*y*(x-y)*(x+y)"); is a test problem */
1.10 takayama 1163: /* x y (x+y-1)(x-2), x^3-y^2, x^3 - y^2 z^2,
1164: x y z (x+y+z-1) seems to be interesting, because the first syzygy
1165: contains 1.
1166: */
1167:
1168: def CopyArray(m) {
1169: local ans,i,n;
1170: if (IsArray(m)) {
1171: n = Length(m);
1172: ans = NewArray(n);
1173: for (i=0; i<n; i++) {
1174: ans[i] = CopyArray(m[i]);
1175: }
1176: return(ans);
1177: }else{
1178: return(m);
1179: }
1180: }
1181: HelpAdd(["CopyArray",
1182: ["It duplicates the argument array recursively.",
1183: "Example: m=[1,[2,3]];",
1184: " a=CopyArray(m); a[1] = \"Hello\";",
1185: " Println(m); Println(a);"]]);
1186:
1187: def IsZeroVector(m) {
1188: local n,i;
1189: n = Length(m);
1190: for (i=0; i<n; i++) {
1191: if (!IsZero(m[i])) {
1192: return(false);
1193: }
1194: }
1195: return(true);
1196: }
1197:
1198: def SpruneZeroRow(res) {
1199: local minRes, n,i,j,m, base,base2,newbase,newbase2, newMinRes;
1200:
1201: minRes = CopyArray(res);
1202: n = Length(minRes);
1203: for (i=0; i<n; i++) {
1204: base = minRes[i];
1205: m = Length(base);
1206: if (i != n-1) {
1207: base2 = minRes[i+1];
1208: base2 = Transpose(base2);
1209: }
1210: newbase = [ ];
1211: newbase2 = [ ];
1212: for (j=0; j<m; j++) {
1213: if (!IsZeroVector(base[j])) {
1214: newbase = Append(newbase,base[j]);
1215: if (i != n-1) {
1216: newbase2 = Append(newbase2,base2[j]);
1217: }
1218: }
1219: }
1220: minRes[i] = newbase;
1221: if (i != n-1) {
1222: if (newbase2 == [ ]) {
1223: minRes[i+1] = [ ];
1224: }else{
1225: minRes[i+1] = Transpose(newbase2);
1226: }
1227: }
1228: }
1229:
1230: newMinRes = [ ];
1231: n = Length(minRes);
1232: i = 0;
1233: while (i < n ) {
1234: base = minRes[i];
1235: if (base == [ ]) {
1236: i = n; /* break; */
1237: }else{
1238: newMinRes = Append(newMinRes,base);
1239: }
1240: i++;
1241: }
1242: return(newMinRes);
1243: }
1244:
1245: def testAnnfs2(f) {
1246: local a,i,n;
1247: a = Sannfs2(f);
1248: b=a[0];
1249: n = Length(b);
1250: Println("------ V-minimal free resolution -----");
1251: sm1_pmat(b);
1252: Println("----- Is it complex? ---------------");
1253: for (i=0; i<n-1; i++) {
1254: Println(b[i+1]*b[i]);
1255: }
1256: return(a);
1257: }
1258: def testAnnfs3(f) {
1259: local a,i,n;
1260: a = Sannfs3(f);
1261: b=a[0];
1262: n = Length(b);
1263: Println("------ V-minimal free resolution -----");
1264: sm1_pmat(b);
1265: Println("----- Is it complex? ---------------");
1266: for (i=0; i<n-1; i++) {
1267: Println(b[i+1]*b[i]);
1268: }
1.11 takayama 1269: return(a);
1270: }
1271:
1272: def ToString_array(p) {
1273: local ans;
1274: if (IsArray(p)) {
1275: ans = Map(p,"ToString_array");
1276: }else{
1277: ans = ToString(p);
1278: }
1279: return(ans);
1280: }
1281:
1282: /* sm1_res_div([[x],[y]],[[x^2],[x*y],[y^2]],[x,y]): */
1283:
1284: def sm1_res_div(I,J,V) {
1285: I = ToString_array(I);
1286: J = ToString_array(J);
1287: V = ToString_array(V);
1288: sm1(" [[ I J] V ] res*div /FunctionValue set ");
1289: }
1290:
1291: /* It has not yet been working */
1292: def sm1_res_kernel_image(m,n,v) {
1293: m = ToString_array(m);
1294: n = ToString_array(n);
1295: v = ToString_array(v);
1296: sm1(" [m n v] res-kernel-image /FunctionValue set ");
1297: }
1298: def Skernel(m,v) {
1299: m = ToString_array(m);
1300: v = ToString_array(v);
1301: sm1(" [ m v ] syz /FunctionValue set ");
1302: }
1303:
1304:
1305: def sm1_gb(f,v) {
1306: f =ToString_array(f);
1307: v = ToString_array(v);
1308: sm1(" [f v] gb /FunctionValue set ");
1.13 takayama 1309: }
1310:
1.11 takayama 1311:
1.12 takayama 1312: def SisComplex(a) {
1313: local n,i,j,k,b,p,q;
1314: n = Length(a);
1315: for (i=0; i<n-1; i++) {
1316: if (Length(a[i+1]) != 0) {
1317: b = a[i+1]*a[i];
1318: p = Length(b); q = Length(b[0]);
1319: for (j=0; j<p; j++) {
1320: for (k=0; k<q; k++) {
1321: if (!IsZero(b[j,k])) {
1322: Print("Is is not complex at ");
1323: Println([i,j,k]);
1324: return(false);
1325: }
1326: }
1327: }
1328: }
1329: }
1330: return(true);
1.14 takayama 1331: }
1332:
1333: def IsExact_h(c,v) {
1334: local a;
1335: v = ToString_array(v);
1336: a = [c,v];
1337: sm1(a," isExact_h /FunctionValue set ");
1338: }
1339: HelpAdd(["IsExact_h",
1340: ["IsExact_h(complex,var): bool",
1341: "It checks the given complex is exact or not in D<h> (homogenized Weyl algebra)",
1342: "cf. ReParse"
1343: ]]);
1344:
1345: def ReParse(a) {
1346: local c;
1347: if (IsArray(a)) {
1348: c = Map(a,"ReParse");
1349: }else{
1350: sm1(a," toString . /c set");
1351: }
1352: return(c);
1353: }
1354: HelpAdd(["ReParse",
1355: ["Reparse(obj): obj",
1356: "It parses the given object in the current ring.",
1357: "Outputs from SlaScala, Sschreyer may cause a trouble in other functions,",
1358: "because it uses the Schreyer order.",
1359: "In this case, ReParse the outputs from these functions.",
1360: "cf. IsExaxt_h"
1361: ]]);
1.16 takayama 1362:
1363: def ScheckIfSchreyer(s) {
1364: local ss;
1365: sm1(" (report) (grade) switch_function /ss set ");
1366: if (ss != "module1v") {
1367: Print("ScheckIfSchreyer: from "); Println(s);
1368: Error("grade is not module1v");
1369: }
1370: /*
1371: sm1(" (report) (mmLarger) switch_function /ss set ");
1372: if (ss != "tower") {
1373: Print("ScheckIfSchreyer: from "); Println(s);
1374: Error("mmLarger is not tower");
1375: }
1376: */
1377: sm1(" [(Schreyer)] system_variable (universalNumber) dc /ss set ");
1378: if (ss != 1) {
1379: Print("ScheckIfSchreyer: from "); Println(s);
1380: Error("Schreyer order is not set.");
1381: }
1382: /* More check will be necessary. */
1383: return(true);
1384: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to minimal.k CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / lib / minimal