Annotation of OpenXM/src/kan96xx/Kan/kanExport1.c, Revision 1.22
1.22 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.21 2005/07/03 11:08:53 ohara Exp $ */
1.1 maekawa 2: #include <stdio.h>
1.22 ! takayama 3: #include <string.h>
1.1 maekawa 4: #include "datatype.h"
5: #include "stackm.h"
6: #include "extern.h"
7: #include "extern2.h"
8: #include "lookup.h"
9: #include "matrix.h"
10: #include "gradedset.h"
11: #include "kclass.h"
12:
13: static int Message = 1;
14: extern int KanGBmessage;
15:
1.18 takayama 16: struct object DegreeShifto = OINIT;
1.5 takayama 17: int DegreeShifto_size = 0;
18: int *DegreeShifto_vec = NULL;
1.18 takayama 19: struct object DegreeShiftD = OINIT;
1.9 takayama 20: int DegreeShiftD_size = 0;
21: int *DegreeShiftD_vec = NULL;
1.5 takayama 22:
1.21 ohara 23: static struct object paddingVector(struct object ob, int table[], int m);
24: static struct object unitVector(int pos, int size,struct ring *r);
25:
1.1 maekawa 26: /** :kan, :ring */
27: struct object Kreduction(f,set)
1.2 takayama 28: struct object f;
29: struct object set;
1.1 maekawa 30: {
31: POLY r;
32: struct gradedPolySet *grG;
33: struct syz0 syz;
1.18 takayama 34: struct object rob = OINIT;
1.1 maekawa 35: int flag;
36: extern int ReduceLowerTerms;
37:
38: if (f.tag != Spoly) errorKan1("%s\n","Kreduction(): the first argument must be a polynomial.");
39:
40: if (ectag(set) == CLASSNAME_GradedPolySet) {
41: grG = KopGradedPolySet(set);
42: flag = 1;
43: }else{
44: if (set.tag != Sarray) errorKan1("%s\n","Kreduction(): the second argument must be a set of polynomials.");
45: grG = arrayToGradedPolySet(set);
46: flag = 0;
47: }
48: if (ReduceLowerTerms) {
49: r = (*reductionCdr)(f.lc.poly,grG,1,&syz);
50: }else{
51: r = (*reduction)(f.lc.poly,grG,1,&syz);
52: }
1.6 takayama 53: /* outputGradedPolySet(grG,0); */
1.1 maekawa 54: if (flag) {
55: rob = newObjectArray(3);
56: putoa(rob,0,KpoPOLY(r));
57: putoa(rob,1,KpoPOLY(syz.cf));
58: putoa(rob,2,syzPolyToArray(countGradedPolySet(grG),syz.syz,grG));
59: }else {
60: rob = newObjectArray(4);
61: putoa(rob,0,KpoPOLY(r));
62: putoa(rob,1,KpoPOLY(syz.cf));
63: putoa(rob,2,syzPolyToArray(getoaSize(set),syz.syz,grG));
64: putoa(rob,3,gradedPolySetToArray(grG,1));
65: }
66: return(rob);
67: }
68:
69: struct object Kgroebner(ob)
1.2 takayama 70: struct object ob;
1.1 maekawa 71: {
72: int needSyz = 0;
73: int needBack = 0;
74: int needInput = 0;
75: int countDown = 0;
76: int cdflag = 0;
1.18 takayama 77: struct object ob1 = OINIT;
78: struct object ob2 = OINIT;
79: struct object ob2c = OINIT;
1.1 maekawa 80: int i;
81: struct gradedPolySet *grG;
82: struct pair *grP;
83: struct arrayOfPOLY *a;
1.18 takayama 84: struct object rob = OINIT;
1.1 maekawa 85: struct gradedPolySet *grBases;
86: struct matrixOfPOLY *mp;
87: struct matrixOfPOLY *backwardMat;
1.18 takayama 88: struct object ob1New = OINIT;
1.1 maekawa 89: extern char *F_groebner;
90: extern int CheckHomogenization;
91: extern int StopDegree;
92: int sdflag = 0;
93: int forceReduction = 0;
1.17 takayama 94: int reduceOnly = 0;
1.20 takayama 95: int gbCheck = 0; /* see @s/2005/06/16-note.pdf */
1.1 maekawa 96:
97: int ob1Size, ob2Size, noZeroEntry;
98: int *ob1ToOb2;
99: int *ob1ZeroPos;
100: int method;
101: int j,k;
1.18 takayama 102: struct object rob2 = OINIT;
103: struct object rob3 = OINIT;
104: struct object rob4 = OINIT;
1.1 maekawa 105: struct ring *myring;
106: POLY f;
1.18 takayama 107: struct object orgB = OINIT;
108: struct object newB = OINIT;
109: struct object orgC = OINIT;
110: struct object newC = OINIT;
1.21 ohara 111: struct object paddingVector(struct object ob, int table[], int m);
112: struct object unitVector(int pos, int size,struct ring *r);
1.1 maekawa 113: extern struct ring *CurrentRingp;
114:
115: StopDegree = 0x7fff;
116:
117: if (ob.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array.");
118: switch(getoaSize(ob)) {
119: case 1:
120: needBack = 0; needSyz = 0; needInput = 0;
121: ob1 = getoa(ob,0);
122: break;
123: case 2:
124: ob1 = getoa(ob,0);
125: ob2 = getoa(ob,1);
126: if (ob2.tag != Sarray) {
127: errorKan1("%s\n","Kgroebner(): The options must be given by an array.");
128: }
1.20 takayama 129: /* Note: If you add a new option, change /configureGroebnerOption, too */
1.1 maekawa 130: for (i=0; i<getoaSize(ob2); i++) {
131: ob2c = getoa(ob2,i);
132: if (ob2c.tag == Sdollar) {
1.2 takayama 133: if (strcmp(ob2c.lc.str,"needBack")==0) {
134: needBack = 1;
135: }else if (strcmp(ob2c.lc.str,"needSyz")==0) {
136: if (!needBack) {
137: /* warningKan("Kgroebner(): needBack is automatically set."); */
138: }
139: needSyz = needBack = 1;
140: }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {
141: forceReduction = 1;
1.17 takayama 142: }else if (strcmp(ob2c.lc.str,"reduceOnly")==0) {
143: reduceOnly = 1;
1.19 takayama 144: }else if (strcmp(ob2c.lc.str,"gbCheck")==0) {
145: gbCheck = 1;
1.2 takayama 146: }else if (strcmp(ob2c.lc.str,"countDown")==0) {
147: countDown = 1; cdflag = 1;
148: if (needSyz) {
149: warningKan("Kgroebner(): needSyz is automatically turned off.");
150: needSyz = 0;
151: }
152: }else if (strcmp(ob2c.lc.str,"StopDegree")==0) {
153: StopDegree = 0; sdflag = 1;
154: if (needSyz) {
155: warningKan("Kgroebner(): needSyz is automatically turned off.");
156: needSyz = 0;
157: }
158: }else {
159: warningKan("Unknown keyword for options.");
160: }
1.1 maekawa 161: }else if (ob2c.tag == Sinteger) {
1.2 takayama 162: if (cdflag) {
163: cdflag = 0;
164: countDown = KopInteger(ob2c);
165: }else if (sdflag) {
166: sdflag = 0;
167: StopDegree = KopInteger(ob2c);
168: }
1.1 maekawa 169: }
170: }
171: break;
172: default:
173: errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");
174: }
1.2 takayama 175:
1.1 maekawa 176: if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");
177: ob1New = newObjectArray(getoaSize(ob1));
178: for (i=0; i< getoaSize(ob1); i++) {
179: if (getoa(ob1,i).tag == Spoly) {
180: putoa(ob1New,i,getoa(ob1,i));
181: }else if (getoa(ob1,i).tag == Sarray) {
182: /* If the generater is given as an array, flatten it. */
183: putoa(ob1New,i,KpoPOLY( arrayToPOLY(getoa(ob1,i))));
184: }else{
185: errorKan1("%s\n","Kgroebner(): The elements must be polynomials or array of polynomials.");
186: }
187: /* getoa(ob1,i) is poly, now check the homogenization. */
188: if (CheckHomogenization) {
189: if ((strcmp(F_groebner,"standard")==0) &&
1.2 takayama 190: !isHomogenized(KopPOLY(getoa(ob1New,i)))) {
191: fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));
192: errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");
1.1 maekawa 193: }
194: }
195: }
196: ob1 = ob1New;
197:
198: /* To handle the input with zero entries. For debug, debug/gr.sm1*/
199: ob1Size = getoaSize(ob1);
200: ob2Size = 0; myring = CurrentRingp;
201: for (i=0; i<ob1Size; i++) {
202: if (KopPOLY(getoa(ob1,i)) != POLYNULL) ob2Size++;
203: }
204: if (ob2Size == ob1Size) noZeroEntry = 1;
205: else noZeroEntry = 0;
206: if (ob1Size == 0) {
207: if (needBack && needSyz) {
208: rob = newObjectArray(3);
209: putoa(rob,0,newObjectArray(0));
210: putoa(rob,1,newObjectArray(0));
211: putoa(rob,2,newObjectArray(0));
212: }else if (needBack) {
213: rob = newObjectArray(2);
214: putoa(rob,0,newObjectArray(0));
215: putoa(rob,1,newObjectArray(0));
216: }else {
217: rob = newObjectArray(1);
218: putoa(rob,0,newObjectArray(0));
219: }
220: return(rob);
221: }
222: /* Assume ob1size > 0 */
223: if (ob2Size == 0) {
224: rob2 = newObjectArray(1); putoa(rob2,0,KpoPOLY(POLYNULL));
225: if (needBack && needSyz) {
226: rob = newObjectArray(3);
227: putoa(rob,0,rob2);
228: rob3 = newObjectArray(1);
229: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
230: putoa(rob,1,rob3);
231: rob4 = newObjectArray(ob1Size);
232: for (i=0; i<ob1Size; i++) {
1.2 takayama 233: putoa(rob4,i,unitVector(i,ob1Size,myring));
1.1 maekawa 234: }
235: putoa(rob,2,rob4);
236: }else if (needBack) {
237: rob = newObjectArray(2);
238: putoa(rob,0,rob2);
239: rob3 = newObjectArray(1);
240: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
241: putoa(rob,1,rob3);
242: }else {
243: rob = newObjectArray(1);
244: putoa(rob,0,rob2);
245: }
246: return(rob);
247: }
248: /* Assume ob1Size , ob2Size > 0 */
249: ob2 = newObjectArray(ob2Size);
1.11 takayama 250: ob1ToOb2 = (int *)sGC_malloc(sizeof(int)*ob1Size);
251: ob1ZeroPos = (int *)sGC_malloc(sizeof(int)*(ob1Size-ob2Size+1));
1.1 maekawa 252: if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");
253: j = 0; k = 0;
254: for (i=0; i<ob1Size; i++) {
255: f = KopPOLY(getoa(ob1,i));
256: if (f != POLYNULL) {
257: myring = f->m->ringp;
258: putoa(ob2,j,KpoPOLY(f));
259: ob1ToOb2[i] = j; j++;
260: }else{
261: ob1ToOb2[i] = -1;
262: ob1ZeroPos[k] = i; k++;
263: }
264: }
265:
266: a = arrayToArrayOfPOLY(ob2);
1.19 takayama 267: grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction,reduceOnly,gbCheck);
1.1 maekawa 268:
269: if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {
270: warningKan("The options needBack and needSyz are ignored.");
271: needBack = needSyz = 0;
272: }
273:
274: /*return(gradedPolySetToGradedArray(grG,0));*/
275: if (needBack && needSyz) {
276: rob = newObjectArray(3);
277: if (Message && KanGBmessage) {
278: printf("Computing the backward transformation ");
279: fflush(stdout);
280: }
281: getBackwardTransformation(grG); /* mark and syz is modified. */
282: if (KanGBmessage) printf("Done.\n");
283:
284: /* Computing the syzygies. */
285: if (Message && KanGBmessage) {
286: printf("Computing the syzygies ");
287: fflush(stdout);
288: }
289: mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);
1.10 takayama 290: if (mp == NULL) errorKan1("%s\n","Internal error in getSyzygy(). BUG of sm1.");
1.1 maekawa 291: if (KanGBmessage) printf("Done.\n");
292:
293: putoa(rob,0,gradedPolySetToArray(grG,0));
294: putoa(rob,1,matrixOfPOLYToArray(backwardMat));
295: putoa(rob,2,matrixOfPOLYToArray(mp));
296: }else if (needBack) {
297: rob = newObjectArray(2);
298: if (Message && KanGBmessage) {
299: printf("Computing the backward transformation.....");
300: fflush(stdout);
301: }
302: getBackwardTransformation(grG); /* mark and syz is modified. */
303: if (KanGBmessage) printf("Done.\n");
304: putoa(rob,0,gradedPolySetToArray(grG,0));
305: putoa(rob,1,getBackwardArray(grG));
306: }else {
307: rob = newObjectArray(1);
308: putoa(rob,0,gradedPolySetToArray(grG,0));
309: }
310:
311: /* To handle zero entries in the input. */
1.20 takayama 312: rob=KsetAttribute(rob,KpoString("gb"),KpoInteger(grG->gb));
313: putoa(rob,0,KsetAttribute(getoa(rob,0),KpoString("gb"),KpoInteger(grG->gb)));
1.1 maekawa 314: if (noZeroEntry) {
315: return(rob);
316: }
317: method = getoaSize(rob);
318: switch(method) {
319: case 1:
320: return(rob);
321: break;
322: case 2:
323: orgB = getoa(rob,1); /* backward transformation. */
324: newB = newObjectArray(getoaSize(orgB));
325: for (i=0; i<getoaSize(orgB); i++) {
326: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
327: }
328: rob2 = newObjectArray(2);
329: putoa(rob2,0,getoa(rob,0));
330: putoa(rob2,1,newB);
1.19 takayama 331: rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));
1.1 maekawa 332: return(rob2);
333: break;
334: case 3:
335: orgB = getoa(rob,1); /* backward transformation. */
336: newB = newObjectArray(getoaSize(orgB));
337: for (i=0; i<getoaSize(orgB); i++) {
338: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
339: }
340: orgC = getoa(rob,2);
341: newC = newObjectArray(getoaSize(orgC)+ob1Size-ob2Size);
342: for (i=0; i<getoaSize(orgC); i++) {
343: putoa(newC, i, paddingVector(getoa(orgC,i),ob1ToOb2,ob1Size));
344: }
345: for (i = getoaSize(orgC), j = 0; i<getoaSize(orgC)+ob1Size-ob2Size; i++,j++) {
346: putoa(newC,i,unitVector(ob1ZeroPos[j],ob1Size,myring));
347: }
348: rob2 = newObjectArray(3);
349: putoa(rob2,0,getoa(rob,0));
350: putoa(rob2,1,newB);
351: putoa(rob2,2,newC);
1.19 takayama 352: rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));
1.1 maekawa 353: return(rob2);
354: break;
355: default:
356: errorKan1("%s","Kgroebner: unknown method.");
357: }
358: }
359:
360: static struct object paddingVector(struct object ob, int table[], int m)
361: {
1.18 takayama 362: struct object rob = OINIT;
1.1 maekawa 363: int i;
364: rob = newObjectArray(m);
365: for (i=0; i<m; i++) {
366: if (table[i] != -1) {
367: putoa(rob,i,getoa(ob,table[i]));
368: }else{
369: putoa(rob,i,KpoPOLY(POLYNULL));
370: }
371: }
372: return(rob);
373: }
374:
375: static struct object unitVector(int pos, int size,struct ring *r)
376: {
1.18 takayama 377: struct object rob = OINIT;
1.1 maekawa 378: int i;
379: POLY one;
380: rob = newObjectArray(size);
381: for (i=0; i<size; i++) {
382: putoa(rob,i,KpoPOLY(POLYNULL));
383: }
384: if ((0 <= pos) && (pos < size)) {
385: putoa(rob,pos, KpoPOLY(cxx(1,0,0,r)));
386: }
387: return(rob);
388: }
389:
390:
391:
392: /* :misc */
393:
394: #define INITGRADE 3
395: #define INITSIZE 0
396:
397: struct gradedPolySet *arrayToGradedPolySet(ob)
1.2 takayama 398: struct object ob;
1.1 maekawa 399: {
400: int n,i,grd,ind;
401: POLY f;
402: struct gradedPolySet *grG;
403: int serial;
404: extern int Sugar;
405:
406: if (ob.tag != Sarray) errorKan1("%s\n","arrayToGradedPolySet(): the argument must be array.");
407: n = getoaSize(ob);
408: for (i=0; i<n; i++) {
409: if (getoa(ob,i).tag != Spoly)
410: errorKan1("%s\n","arrayToGradedPolySet(): the elements must be polynomials.");
411: }
412: grG = newGradedPolySet(INITGRADE);
413:
414: for (i=0; i<grG->lim; i++) {
415: grG->polys[i] = newPolySet(INITSIZE);
416: }
417: for (i=0; i<n; i++) {
418: f = KopPOLY(getoa(ob,i));
419: grd = -1; whereInG(grG,f,&grd,&ind,Sugar);
420: serial = i;
421: grG = putPolyInG(grG,f,grd,ind,(struct syz0 *)NULL,1,serial);
422: }
423: return(grG);
424: }
425:
426:
427: struct object polySetToArray(ps,keepRedundant)
1.2 takayama 428: struct polySet *ps;
429: int keepRedundant;
1.1 maekawa 430: {
431: int n,i,j;
1.18 takayama 432: struct object ob = OINIT;
1.1 maekawa 433: if (ps == (struct polySet *)NULL) return(newObjectArray(0));
434: n = 0;
435: if (keepRedundant) {
436: n = ps->size;
437: }else{
438: for (i=0; i<ps->size; i++) {
439: if (ps->del[i] == 0) ++n;
440: }
441: }
442: ob = newObjectArray(n);
443: j = 0;
444: for (i=0; i<ps->size; i++) {
445: if (keepRedundant || (ps->del[i] == 0)) {
446: putoa(ob,j,KpoPOLY(ps->g[i]));
447: j++;
448: }
449: }
450: return(ob);
451: }
452:
453:
454: struct object gradedPolySetToGradedArray(gps,keepRedundant)
1.2 takayama 455: struct gradedPolySet *gps;
456: int keepRedundant;
1.1 maekawa 457: {
1.18 takayama 458: struct object ob = OINIT;
459: struct object vec = OINIT;
1.1 maekawa 460: int i;
461: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
462: ob = newObjectArray(gps->maxGrade +1);
463: vec = newObjectArray(gps->maxGrade);
464: for (i=0; i<gps->maxGrade; i++) {
465: putoa(vec,i,KpoInteger(i));
466: putoa(ob,i+1,polySetToArray(gps->polys[i],keepRedundant));
467: }
468: putoa(ob,0,vec);
469: return(ob);
470: }
471:
472:
473: struct object gradedPolySetToArray(gps,keepRedundant)
1.2 takayama 474: struct gradedPolySet *gps;
475: int keepRedundant;
1.1 maekawa 476: {
1.18 takayama 477: struct object ob = OINIT;
478: struct object vec = OINIT;
1.1 maekawa 479: struct polySet *ps;
480: int k;
481: int i,j;
482: int size;
483: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
484: size = 0;
485: for (i=0; i<gps->maxGrade; i++) {
486: ps = gps->polys[i];
487: if (keepRedundant) {
488: size += ps->size;
489: }else{
490: for (j=0; j<ps->size; j++) {
1.2 takayama 491: if (ps->del[j] == 0) ++size;
1.1 maekawa 492: }
493: }
494: }
495:
496: ob = newObjectArray(size);
497: k = 0;
498: for (i=0; i<gps->maxGrade; i++) {
499: ps = gps->polys[i];
500: for (j=0; j<ps->size; j++) {
501: if (keepRedundant || (ps->del[j] == 0)) {
1.2 takayama 502: putoa(ob,k,KpoPOLY(ps->g[j]));
503: k++;
1.1 maekawa 504: }
505: }
506: }
507: return(ob);
508: }
509:
510:
511: /* serial == -1 : It's not in the marix input. */
512: struct object syzPolyToArray(size,f,grG)
1.2 takayama 513: int size;
514: POLY f;
515: struct gradedPolySet *grG;
1.1 maekawa 516: {
1.18 takayama 517: struct object ob = OINIT;
1.1 maekawa 518: int i,g0,i0,serial;
519:
520: ob = newObjectArray(size);
521: for (i=0; i<size; i++) {
522: putoa(ob,i,KpoPOLY(ZERO));
523: }
524:
525: while (f != POLYNULL) {
526: g0 = srGrade(f);
1.6 takayama 527: i0 = srIndex(f);
1.1 maekawa 528: serial = grG->polys[g0]->serial[i0];
529: if (serial < 0) {
530: errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
531: }
532: if (KopPOLY(getoa(ob,serial)) != ZERO) {
533: errorKan1("%s\n","syzPolyToArray(): syzygy polynomial is broken.");
534: }
535: putoa(ob,serial,KpoPOLY(f->coeffp->val.f));
536: f = f->next;
537: }
538: return(ob);
539: }
540:
541: struct object getBackwardArray(grG)
1.2 takayama 542: struct gradedPolySet *grG;
1.1 maekawa 543: {
544: /* use serial, del. cf. getBackwardTransformation(). */
545: int inputSize,outputSize;
546: int i,j,k;
1.18 takayama 547: struct object ob = OINIT;
1.1 maekawa 548: struct polySet *ps;
549:
550: inputSize = 0; outputSize = 0;
551: for (i=0; i<grG->maxGrade; i++) {
552: ps = grG->polys[i];
553: for (j=0; j<ps->size; j++) {
554: if (ps->serial[j] >= 0) ++inputSize;
555: if (ps->del[j] == 0) ++outputSize;
556: }
557: }
558:
559: ob = newObjectArray(outputSize);
560: k = 0;
561: for (i=0; i<grG->maxGrade; i++) {
562: ps = grG->polys[i];
563: for (j=0; j<ps->size; j++) {
564: if (ps->del[j] == 0) {
1.2 takayama 565: putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));
566: k++;
1.1 maekawa 567: }
568: }
569: }
570: return(ob);
571: }
572:
573:
574: POLY arrayToPOLY(ob)
1.2 takayama 575: struct object ob;
1.1 maekawa 576: {
577: int size,i;
1.18 takayama 578: struct object f = OINIT;
1.1 maekawa 579: POLY r;
580: static int nn,mm,ll,cc,n,m,l,c;
581: static struct ring *cr = (struct ring *)NULL;
582: POLY ff,ee;
583: MONOMIAL tf;
584:
585: if (ob.tag != Sarray) errorKan1("%s\n","arrayToPOLY(): The argument must be an array.");
586: size = getoaSize(ob);
587: r = ZERO;
588: for (i=0; i<size; i++) {
589: f = getoa(ob,i);
590: if (f.tag != Spoly) errorKan1("%s\n","arrayToPOLY(): The elements must be polynomials.");
591: ff = KopPOLY(f);
592: if (ff != ZERO) {
593: tf = ff->m;
594: if (tf->ringp != cr) {
1.2 takayama 595: n = tf->ringp->n;
596: m = tf->ringp->m;
597: l = tf->ringp->l;
598: c = tf->ringp->c;
599: nn = tf->ringp->nn;
600: mm = tf->ringp->mm;
601: ll = tf->ringp->ll;
602: cc = tf->ringp->cc;
603: cr = tf->ringp;
1.1 maekawa 604: }
605: if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);
606: else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);
607: else if (l-ll >0) ee = cxx(1,l-1,i,tf->ringp);
608: else if (c-cc >0) ee = cxx(1,c-1,i,tf->ringp);
609: else ee = ZERO;
610: r = ppAddv(r,ppMult(ee,ff));
611: }
612: }
613: return(r);
614: }
615:
616: struct object POLYToArray(ff)
1.2 takayama 617: POLY ff;
1.1 maekawa 618: {
619:
620: static int nn,mm,ll,cc,n,m,l,c;
621: static struct ring *cr = (struct ring *)NULL;
622: POLY ee;
623: MONOMIAL tf;
624: int k,i,matn,size;
625: struct matrixOfPOLY *mat;
626: POLY ex,sizep;
1.18 takayama 627: struct object ob = OINIT;
1.1 maekawa 628:
629: if (ff != ZERO) {
630: tf = ff->m;
631: if (tf->ringp != cr) {
632: n = tf->ringp->n;
633: m = tf->ringp->m;
634: l = tf->ringp->l;
635: c = tf->ringp->c;
636: nn = tf->ringp->nn;
637: mm = tf->ringp->mm;
638: ll = tf->ringp->ll;
639: cc = tf->ringp->cc;
640: cr = tf->ringp;
641: }
642: if (n-nn >0) ee = cxx(1,n-1,1,tf->ringp);
643: else if (m-mm >0) ee = cxx(1,m-1,1,tf->ringp);
644: else if (l-ll >0) ee = cxx(1,l-1,1,tf->ringp);
645: else if (c-cc >0) ee = cxx(1,c-1,1,tf->ringp);
646: else ee = ZERO;
647: }else{
648: ob = newObjectArray(1);
649: getoa(ob,0) = KpoPOLY(ZERO);
650: return(ob);
651: }
652: mat = parts(ff,ee);
653: matn = mat->n;
654: sizep = getMatrixOfPOLY(mat,0,0);
655: if (sizep == ZERO) size = 1;
656: else size = coeffToInt(sizep->coeffp)+1;
657: ob = newObjectArray(size);
658: for (i=0; i<size; i++) getoa(ob,i) = KpoPOLY(ZERO);
659: for (i=0; i<matn; i++) {
660: ex = getMatrixOfPOLY(mat,0,i);
661: if (ex == ZERO) k = 0;
662: else {
663: k = coeffToInt(ex->coeffp);
664: }
665: getoa(ob,k) = KpoPOLY(getMatrixOfPOLY(mat,1,i));
666: }
667: return(ob);
668: }
669:
670: static int isThereh(f)
1.2 takayama 671: POLY f;
1.1 maekawa 672: {
673: POLY t;
674: if (f == 0) return(0);
675: t = f;
676: while (t != POLYNULL) {
677: if (t->m->e[0].D) return(1);
678: t = t->next;
679: }
680: return(0);
681: }
682:
683: struct object homogenizeObject(ob,gradep)
1.2 takayama 684: struct object ob;
685: int *gradep;
1.1 maekawa 686: {
1.18 takayama 687: struct object rob = OINIT;
688: struct object ob1 = OINIT;
1.1 maekawa 689: int maxg;
690: int gr,flag,i,d,size;
691: struct ring *rp;
692: POLY f;
693: extern struct ring *CurrentRingp;
694: extern int Homogenize_vec;
695:
696: if (!Homogenize_vec) return(homogenizeObject_vec(ob,gradep));
697:
698: switch(ob.tag) {
699: case Spoly:
700: if (isThereh(KopPOLY(ob))) {
701: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
702: errorKan1("%s\n","homogenizeObject(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
703: }
704: f = homogenize( KopPOLY(ob) );
705: *gradep = (*grade)(f);
706: return(KpoPOLY(f));
707: break;
708: case Sarray:
709: size = getoaSize(ob);
710: if (size == 0) {
711: errorKan1("%s\n","homogenizeObject() is called for the empty array.");
712: }
713: rob = newObjectArray(size);
714: flag = 0;
715: ob1 = getoa(ob,0);
1.5 takayama 716: if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 717: ob1 = homogenizeObject(ob1,&gr);
718: maxg = gr;
719: getoa(rob,0) = ob1;
720: for (i=1; i<size; i++) {
721: ob1 = getoa(ob,i);
722: ob1 = homogenizeObject(ob1,&gr);
723: if (gr > maxg) {
1.2 takayama 724: maxg = gr;
1.1 maekawa 725: }
726: getoa(rob,i) = ob1;
727: }
728: maxg = maxg+size-1;
729: if (1) {
730: rp = oRingp(rob);
731: if (rp == (struct ring *)NULL) rp = CurrentRingp;
732: for (i=0; i<size; i++) {
1.2 takayama 733: gr = oGrade(getoa(rob,i));
734: /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/
735: if (maxg > gr) {
736: f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */
737: getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));
738: }
1.1 maekawa 739: }
740: }
741: *gradep = maxg;
742: return(rob);
743: break;
744: default:
745: errorKan1("%s\n","homogenizeObject(): Invalid argument data type.");
746: break;
747: }
748: }
749:
750: struct object homogenizeObject_vec(ob,gradep)
1.2 takayama 751: struct object ob;
752: int *gradep;
1.1 maekawa 753: {
1.18 takayama 754: struct object rob = OINIT;
755: struct object ob1 = OINIT;
1.1 maekawa 756: int maxg;
757: int gr,i,size;
758: POLY f;
759: extern struct ring *CurrentRingp;
760:
761: switch(ob.tag) {
762: case Spoly:
763: if (isThereh(KopPOLY(ob))) {
764: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
765: errorKan1("%s\n","homogenizeObject_vec(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
766: }
767: if (containVectorVariable(KopPOLY(ob))) {
768: errorKan1("%s\n","homogenizedObject_vec(): The given polynomial contains a variable to express a vector component.");
769: }
770: f = homogenize( KopPOLY(ob) );
771: *gradep = (*grade)(f);
772: return(KpoPOLY(f));
773: break;
774: case Sarray:
775: size = getoaSize(ob);
776: if (size == 0) {
777: errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
778: }
1.5 takayama 779: if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 780: rob = newObjectArray(size);
781: for (i=0; i<size; i++) {
782: ob1 = getoa(ob,i);
783: ob1 = homogenizeObject_vec(ob1,&gr);
784: if (i==0) maxg = gr;
785: else {
1.2 takayama 786: maxg = (maxg > gr? maxg: gr);
1.1 maekawa 787: }
788: putoa(rob,i,ob1);
789: }
790: *gradep = maxg;
791: return(rob);
792: break;
793: default:
794: errorKan1("%s\n","homogenizeObject_vec(): Invalid argument data type.");
795: break;
796: }
797: }
798:
1.9 takayama 799: void KresetDegreeShift() {
800: DegreeShifto = NullObject;
801: DegreeShifto_vec = (int *)NULL;
802: DegreeShifto_size = 0;
803: DegreeShiftD = NullObject;
804: DegreeShiftD_vec = (int *)NULL;
805: DegreeShiftD_size = 0;
806: }
807:
1.3 takayama 808: struct object homogenizeObject_go(struct object ob,int *gradep) {
809: int size,i,dssize,j;
1.18 takayama 810: struct object ob0 = OINIT;
811: struct object ob1 = OINIT;
812: struct object ob2 = OINIT;
813: struct object rob = OINIT;
814: struct object tob = OINIT;
815: struct object ob1t = OINIT;
1.3 takayama 816: int *ds;
817: POLY f;
1.9 takayama 818: int onlyS;
819:
820: onlyS = 0; /* default value */
1.3 takayama 821: rob = NullObject;
1.9 takayama 822: /*printf("[%d,%d]\n",DegreeShiftD_size,DegreeShifto_size);*/
823: if (DegreeShifto_size == 0) DegreeShifto = NullObject;
824: if (DegreeShiftD_size == 0) DegreeShiftD = NullObject;
825: /*
826: DegreeShiftD : Degree shift vector for (0,1)-h-homogenization,
827: which is {\vec n} in G-O paper.
828: It is used in dGrade1() redm.c
829: DegreeShifto : Degree shift vector for (u,v)-s-homogenization
830: which is used only in ecart division and (u,v) is
831: usually (-1,1).
832: This shift vector is written {\vec v} in G-O paper.
833: It may differ from the degree shift for the ring,
834: which is used to get (minimal) Schreyer resolution.
835: This shift vector is denoted by {\vec m} in G-O paper.
836: It is often used as an argument for uvGrade1 and
837: goHomogenize*
838: */
1.3 takayama 839: if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
840:
841: size = getoaSize(ob);
842: if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
843: ob0 = getoa(ob,0);
844: if (ob0.tag != Sdollar) {
845: errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
846: }
847: if (strcmp(KopString(ob0),"degreeShift") == 0) {
1.5 takayama 848: if (size < 2)
1.9 takayama 849: errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize.\nshift-vector=(0,1)-shift vector or [(0,1)-shift vector, (u,v)-shift vector].");
1.5 takayama 850: ob1 = getoa(ob,1);
851: if (ob1.tag != Sarray) {
1.9 takayama 852: if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"value")==0)) {
853: /* Reporting the value. It is done below. */
854: }else if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"reset")==0)) {
855: KresetDegreeShift();
856: }
857: rob = newObjectArray(2);
858: putoa(rob,0,DegreeShiftD);
859: putoa(rob,1,DegreeShifto);
860: return rob;
861: }
862:
863: if (getoaSize(ob1) == 2) {
864: /* [(degreeShift) [ [1 2] [3 4] ] ...] homogenize */
865: /* (0,1)-h (u,v)-s */
866: DegreeShiftD = getoa(ob1,0);
867: dssize = getoaSize(DegreeShiftD);
868: ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
869: if (ds == NULL) errorKan1("%s\n","no more memory.");
870: for (i=0; i<dssize; i++) {
871: ds[i] = objToInteger(getoa(DegreeShiftD,i));
872: }
873: DegreeShiftD_size = dssize;
874: DegreeShiftD_vec = ds;
875:
876: DegreeShifto = getoa(ob1,1);
877: dssize = getoaSize(DegreeShifto);
878: ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
879: if (ds == NULL) errorKan1("%s\n","no more memory.");
880: for (i=0; i<dssize; i++) {
881: ds[i] = objToInteger(getoa(DegreeShifto,i));
1.3 takayama 882: }
1.9 takayama 883: DegreeShifto_size = dssize;
884: DegreeShifto_vec = ds;
885: }else if (getoaSize(ob1) == 1) {
886: /* Set only for (0,1)-h */
887: DegreeShiftD = getoa(ob1,0);
888: dssize = getoaSize(DegreeShiftD);
889: ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
890: if (ds == NULL) errorKan1("%s\n","no more memory.");
891: for (i=0; i<dssize; i++) {
892: ds[i] = objToInteger(getoa(DegreeShiftD,i));
893: }
894: DegreeShiftD_size = dssize;
895: DegreeShiftD_vec = ds;
1.3 takayama 896: }
1.9 takayama 897:
898: ds = DegreeShifto_vec;
899: dssize = DegreeShifto_size;
900:
1.5 takayama 901: if (size == 2) {
1.9 takayama 902: rob = newObjectArray(2);
903: putoa(rob,0,DegreeShiftD);
904: putoa(rob,1,DegreeShifto);
905: return rob;
1.5 takayama 906: }else{
907: ob2 = getoa(ob,2);
908: if (ob2.tag == Spoly) {
1.9 takayama 909: f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,onlyS);
1.5 takayama 910: rob = KpoPOLY(f);
911: }else if (ob2.tag == SuniversalNumber) {
912: rob = ob2;
913: }else if (ob2.tag == Sarray) {
1.9 takayama 914: int mm;
915: mm = getoaSize(ob2);
916: f = objArrayToPOLY(ob2);
917: f = goHomogenize11(f,ds,dssize,-1,onlyS);
918: rob = POLYtoObjArray(f,mm);
1.5 takayama 919: }else{
920: errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
921: }
922: }
1.3 takayama 923: }else{
1.5 takayama 924: errorKan1("%s\n","homogenizeObject_go(): unknown key word.");
1.3 takayama 925: }
1.5 takayama 926: return( rob );
1.3 takayama 927: }
928:
929:
1.1 maekawa 930: struct ring *oRingp(ob)
1.2 takayama 931: struct object ob;
1.1 maekawa 932: {
933: struct ring *rp,*rptmp;
934: int i,size;
935: POLY f;
936: switch(ob.tag) {
937: case Spoly:
938: f = KopPOLY(ob);
939: if (f == ZERO) return((struct ring *)NULL);
940: return( f->m->ringp);
941: break;
942: case Sarray:
943: size = getoaSize(ob);
944: rp = (struct ring *)NULL;
945: for (i=0; i<size; i++) {
946: rptmp = oRingp(getoa(ob,i));
947: if (rptmp != (struct ring *)NULL) rp = rptmp;
948: return(rp);
949: }
950: break;
951: default:
952: errorKan1("%s\n","oRingp(): Invalid argument data type.");
953: break;
954: }
955: }
956:
957: int oGrade(ob)
1.2 takayama 958: struct object ob;
1.1 maekawa 959: {
960: int i,size;
961: POLY f;
962: int maxg,tmpg;
963: switch(ob.tag) {
964: case Spoly:
965: f = KopPOLY(ob);
966: return( (*grade)(f) );
967: break;
968: case Sarray:
969: size = getoaSize(ob);
970: if (size == 0) return(0);
971: maxg = oGrade(getoa(ob,0));
972: for (i=1; i<size; i++) {
973: tmpg = oGrade(getoa(ob,i));
974: if (tmpg > maxg) maxg = tmpg;
975: }
976: return(maxg);
977: break;
978: default:
979: errorKan1("%s\n","oGrade(): Invalid data type for the argument.");
980: break;
981: }
982: }
983:
984:
985: struct object oPrincipalPart(ob)
1.2 takayama 986: struct object ob;
1.1 maekawa 987: {
988: POLY f;
1.18 takayama 989: struct object rob = OINIT;
1.1 maekawa 990:
991: switch(ob.tag) {
992: case Spoly:
993: f = KopPOLY(ob);
994: return( KpoPOLY(POLYToPrincipalPart(f)));
995: break;
996: default:
997: errorKan1("%s\n","oPrincipalPart(): Invalid data type for the argument.");
998: break;
999: }
1000: }
1001: struct object oInitW(ob,oWeight)
1.2 takayama 1002: struct object ob;
1003: struct object oWeight;
1.1 maekawa 1004: {
1005: POLY f;
1.18 takayama 1006: struct object rob = OINIT;
1.1 maekawa 1007: int w[2*N0];
1008: int n,i;
1.18 takayama 1009: struct object ow = OINIT;
1.7 takayama 1010: int shiftvec;
1.18 takayama 1011: struct object oShift = OINIT;
1.7 takayama 1012: int *s;
1013: int ssize,m;
1.1 maekawa 1014:
1.7 takayama 1015: shiftvec = 0;
1016: s = NULL;
1017:
1.1 maekawa 1018: if (oWeight.tag != Sarray) {
1019: errorKan1("%s\n","oInitW(): the second argument must be array.");
1020: }
1.15 takayama 1021: oWeight = Kto_int32(oWeight);
1.1 maekawa 1022: n = getoaSize(oWeight);
1.8 takayama 1023: if (n == 0) {
1024: m = getoaSize(ob);
1025: f = objArrayToPOLY(ob);
1026: f = head(f);
1027: return POLYtoObjArray(f,m);
1028: }
1.7 takayama 1029: if (getoa(oWeight,0).tag == Sarray) {
1030: if (n != 2) errorKan1("%s\n","oInitW(): the size of the second argument should be 2.");
1031: shiftvec = 1;
1032: oShift = getoa(oWeight,1);
1033: oWeight = getoa(oWeight,0);
1034: if (oWeight.tag != Sarray) {
1035: errorKan1("%s\n","oInitW(): the weight vector must be array.");
1036: }
1037: n = getoaSize(oWeight);
1038: if (oShift.tag != Sarray) {
1039: errorKan1("%s\n","oInitW(): the shift vector must be array.");
1040: }
1041: }
1042: /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
1.1 maekawa 1043: if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
1044: for (i=0; i<n; i++) {
1045: ow = getoa(oWeight,i);
1.7 takayama 1046: if (ow.tag == SuniversalNumber) {
1047: ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
1048: }
1.1 maekawa 1049: if (ow.tag != Sinteger) {
1050: errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
1051: }
1052: w[i] = KopInteger(ow);
1053: }
1.7 takayama 1054: if (shiftvec) {
1055: ssize = getoaSize(oShift);
1056: s = (int *)sGC_malloc(sizeof(int)*(ssize+1));
1057: if (s == NULL) errorKan1("%s\n","oInitW() no more memory.");
1058: for (i=0; i<ssize; i++) {
1059: ow = getoa(oShift,i);
1060: if (ow.tag == SuniversalNumber) {
1061: ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
1062: }
1063: if (ow.tag != Sinteger) {
1064: errorKan1("%s\n","oInitW(): the entries of shift vector must be integers.");
1065: }
1066: s[i] = KopInteger(ow);
1067: }
1068: }
1069:
1.1 maekawa 1070: switch(ob.tag) {
1071: case Spoly:
1072: f = KopPOLY(ob);
1.7 takayama 1073: if (shiftvec) {
1074: return( KpoPOLY(POLYToInitWS(f,w,s)));
1075: }else{
1076: return( KpoPOLY(POLYToInitW(f,w)));
1077: }
1.1 maekawa 1078: break;
1.7 takayama 1079: case Sarray:
1080: m = getoaSize(ob);
1081: f = objArrayToPOLY(ob);
1082: /* printf("1.%s\n",POLYToString(f,'*',1)); */
1083: if (shiftvec) {
1084: f = POLYToInitWS(f,w,s);
1085: }else{
1086: f = POLYToInitW(f,w);
1087: }
1088: /* printf("2.%s\n",POLYToString(f,'*',1)); */
1089:
1090: return POLYtoObjArray(f,m);
1.1 maekawa 1091: default:
1.7 takayama 1092: errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");
1.1 maekawa 1093: break;
1094: }
1095: }
1.7 takayama 1096:
1097: POLY objArrayToPOLY(struct object ob) {
1098: int m;
1099: POLY f;
1100: POLY t;
1101: int i,n;
1102: struct ring *ringp;
1103: if (ob.tag != Sarray) errorKan1("%s\n", "objArrayToPOLY() the argument must be an array.");
1104: m = getoaSize(ob);
1105: ringp = NULL;
1106: f = POLYNULL;
1107: for (i=0; i<m; i++) {
1108: if (getoa(ob,i).tag != Spoly) errorKan1("%s\n","objArrayToPOLY() elements must be a polynomial.");
1109: t = KopPOLY(getoa(ob,i));
1110: if (t ISZERO) {
1111: }else{
1112: if (ringp == NULL) {
1113: ringp = t->m->ringp;
1114: n = ringp->n;
1.8 takayama 1115: if (n - ringp->nn <= 0) errorKan1("%s\n","Graduation variable in D is not given.");
1.7 takayama 1116: }
1117: t = (*mpMult)(cxx(1,n-1,i,ringp),t);
1118: f = ppAddv(f,t);
1119: }
1120: }
1121: return f;
1122: }
1123:
1124: struct object POLYtoObjArray(POLY f,int size) {
1.18 takayama 1125: struct object rob = OINIT;
1.7 takayama 1126: POLY *pa;
1127: int d,n,i;
1128: POLY t;
1129: if (size < 0) errorKan1("%s\n","POLYtoObjArray() invalid size.");
1130: rob = newObjectArray(size);
1131: pa = (POLY *) sGC_malloc(sizeof(POLY)*(size+1));
1132: if (pa == NULL) errorKan1("%s\n","POLYtoObjArray() no more memory.");
1133: for (i=0; i<size; i++) {
1134: pa[i] = POLYNULL;
1135: putoa(rob,i,KpoPOLY(pa[i]));
1136: }
1137: if (f == POLYNULL) {
1138: return rob;
1139: }
1140: n = f->m->ringp->n;
1141: while (f != POLYNULL) {
1142: d = f->m->e[n-1].x;
1143: if (d >= size) errorKan1("%s\n","POLYtoObjArray() size is too small.");
1.8 takayama 1144: t = newCell(coeffCopy(f->coeffp),monomialCopy(f->m));
1.7 takayama 1145: i = t->m->e[n-1].x;
1146: t->m->e[n-1].x = 0;
1147: pa[i] = ppAddv(pa[i],t); /* slow to add from the top. */
1148: f = f->next;
1149: }
1150: for (i=0; i<size; i++) {
1151: putoa(rob,i,KpoPOLY(pa[i]));
1152: }
1153: return rob;
1154: }
1155:
1.8 takayama 1156: struct object KordWsAll(ob,oWeight)
1157: struct object ob;
1158: struct object oWeight;
1159: {
1160: POLY f;
1.18 takayama 1161: struct object rob = OINIT;
1.8 takayama 1162: int w[2*N0];
1163: int n,i;
1.18 takayama 1164: struct object ow = OINIT;
1.8 takayama 1165: int shiftvec;
1.18 takayama 1166: struct object oShift = OINIT;
1.8 takayama 1167: int *s;
1168: int ssize,m;
1169:
1170: shiftvec = 0;
1171: s = NULL;
1172:
1173: if (oWeight.tag != Sarray) {
1174: errorKan1("%s\n","ordWsAll(): the second argument must be array.");
1175: }
1.15 takayama 1176: oWeight = Kto_int32(oWeight);
1.8 takayama 1177: n = getoaSize(oWeight);
1178: if (n == 0) {
1179: m = getoaSize(ob);
1180: f = objArrayToPOLY(ob);
1181: f = head(f);
1182: return POLYtoObjArray(f,m);
1183: }
1184: if (getoa(oWeight,0).tag == Sarray) {
1185: if (n != 2) errorKan1("%s\n","ordWsAll(): the size of the second argument should be 2.");
1186: shiftvec = 1;
1187: oShift = getoa(oWeight,1);
1188: oWeight = getoa(oWeight,0);
1189: if (oWeight.tag != Sarray) {
1190: errorKan1("%s\n","ordWsAll(): the weight vector must be array.");
1191: }
1192: n = getoaSize(oWeight);
1193: if (oShift.tag != Sarray) {
1194: errorKan1("%s\n","ordWsAll(): the shift vector must be array.");
1195: }
1196: }
1197: /* oWeight = Ksm1WeightExpressionToVec(oWeight); */
1198: if (n >= 2*N0) errorKan1("%s\n","ordWsAll(): the size of the second argument is invalid.");
1199: for (i=0; i<n; i++) {
1200: ow = getoa(oWeight,i);
1201: if (ow.tag == SuniversalNumber) {
1202: ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
1203: }
1204: if (ow.tag != Sinteger) {
1205: errorKan1("%s\n","ordWsAll(): the entries of the second argument must be integers.");
1206: }
1207: w[i] = KopInteger(ow);
1208: }
1209: if (shiftvec) {
1210: ssize = getoaSize(oShift);
1211: s = (int *)sGC_malloc(sizeof(int)*(ssize+1));
1212: if (s == NULL) errorKan1("%s\n","ordWsAll() no more memory.");
1213: for (i=0; i<ssize; i++) {
1214: ow = getoa(oShift,i);
1215: if (ow.tag == SuniversalNumber) {
1216: ow = KpoInteger(coeffToInt(ow.lc.universalNumber));
1217: }
1218: if (ow.tag != Sinteger) {
1219: errorKan1("%s\n","ordWsAll(): the entries of shift vector must be integers.");
1220: }
1221: s[i] = KopInteger(ow);
1222: }
1223: }
1224:
1225: switch(ob.tag) {
1226: case Spoly:
1227: f = KopPOLY(ob);
1228: if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
1229: if (shiftvec) {
1230: return( KpoInteger(ordWsAll(f,w,s)));
1231: }else{
1232: return( KpoInteger(ordWsAll(f,w,(int *) NULL)));
1233: }
1234: break;
1235: case Sarray:
1236: m = getoaSize(ob);
1237: f = objArrayToPOLY(ob);
1238: if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");
1239: if (shiftvec) {
1240: return KpoInteger(ordWsAll(f,w,s));
1241: }else{
1242: return KpoInteger(ordWsAll(f,w,(int *)NULL));
1243: }
1244: default:
1245: errorKan1("%s\n","ordWsAll(): Argument must be polynomial or a vector of polynomials");
1246: break;
1247: }
1248: }
1.1 maekawa 1249:
1250: int KpolyLength(POLY f) {
1251: int size;
1252: if (f == POLYNULL) return(1);
1253: size = 0;
1254: while (f != POLYNULL) {
1255: f = f->next;
1256: size++;
1257: }
1258: return(size);
1259: }
1260:
1261: int validOutputOrder(int ord[],int n) {
1262: int i,j,flag;
1263: for (i=0; i<n; i++) {
1264: flag = 0;
1265: for (j=0; j<n; j++) {
1266: if (ord[j] == i) flag = 1;
1267: }
1268: if (flag == 0) return(0); /* invalid */
1269: }
1270: return(1);
1271: }
1272:
1273: struct object KsetOutputOrder(struct object ob, struct ring *rp)
1274: {
1275: int n,i;
1.18 takayama 1276: struct object ox = OINIT;
1277: struct object otmp = OINIT;
1.1 maekawa 1278: int *xxx;
1279: int *ddd;
1280: if (ob.tag != Sarray) {
1281: errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...]");
1282: }
1283: n = rp->n;
1284: ox = ob;
1285: if (getoaSize(ox) != 2*n) {
1286: errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...] and the length of [x y z ...] must be equal to the number of x and D variables.");
1287: }
1288: xxx = (int *)sGC_malloc(sizeof(int)*n*2);
1289: if (xxx == NULL ) {
1290: errorKan1("%s\n","KsetOutputOrder(): no more memory.");
1291: }
1292: for (i=0; i<2*n; i++) {
1293: otmp = getoa(ox,i);
1294: if(otmp.tag != Sinteger) {
1295: errorKan1("%s\n","KsetOutputOrder(): elements must be integers.");
1296: }
1297: xxx[i] = KopInteger(otmp);
1298: }
1299: if (!validOutputOrder(xxx,2*n)) {
1300: errorKan1("%s\n","KsetOutputOrder(): Invalid output order for variables.");
1301: }
1302: rp->outputOrder = xxx;
1303: return(ob);
1304: }
1305:
1306: struct object KschreyerSkelton(struct object g)
1307: {
1.18 takayama 1308: struct object rob = OINIT;
1309: struct object ij = OINIT;
1310: struct object ab = OINIT;
1311: struct object tt = OINIT;
1.1 maekawa 1312: struct arrayOfPOLY *ap;
1313: struct arrayOfMonomialSyz ans;
1314: int k;
1315: rob.tag = Snull;
1316: if (g.tag != Sarray) {
1317: errorKan1("%s\n","KschreyerSkelton(): argument must be an array of polynomials.");
1318: }
1319:
1320: ap = arrayToArrayOfPOLY(g);
1321: ans = schreyerSkelton(*ap);
1322:
1323: rob = newObjectArray(ans.size);
1324: for (k=0; k<ans.size; k++) {
1325: ij = newObjectArray(2);
1326: putoa(ij,0, KpoInteger(ans.p[k]->i));
1327: putoa(ij,1, KpoInteger(ans.p[k]->j));
1328: ab = newObjectArray(2);
1329: putoa(ab,0, KpoPOLY(ans.p[k]->a));
1330: putoa(ab,1, KpoPOLY(ans.p[k]->b));
1331: tt = newObjectArray(2);
1332: putoa(tt,0, ij);
1333: putoa(tt,1, ab);
1334: putoa(rob,k,tt);
1335: }
1336: return(rob);
1337: }
1338:
1339: struct object KisOrdered(struct object of)
1340: {
1341: if (of.tag != Spoly) {
1342: errorKan1("%s\n","KisOrdered(): argument must be a polynomial.");
1343: }
1344: if (isOrdered(KopPOLY(of))) {
1345: return(KpoInteger(1));
1346: }else{
1347: return(KpoInteger(0));
1348: }
1349: }
1350:
1351: struct object KvectorToSchreyer_es(struct object obarray)
1352: {
1353: int m,i;
1354: int nn;
1355: POLY f;
1356: POLY g;
1.18 takayama 1357: struct object ob = OINIT;
1.1 maekawa 1358: struct ring *rp;
1359: if (obarray.tag != Sarray) {
1360: errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
1361: }
1362: m = getoaSize(obarray);
1363: f = POLYNULL;
1364: for (i=0; i<m; i++) {
1365: ob = getoa(obarray,i);
1366: if (ob.tag != Spoly) {
1367: errorKan1("%s\n","KvectorToSchreyer_es(): each element of the array must be a polynomial.");
1368: }
1369: g = KopPOLY(ob);
1370: if (g != POLYNULL) {
1371: rp = g->m->ringp;
1372: nn = rp->nn;
1373: /* g = es^i g */
1374: g = mpMult_poly(cxx(1,nn,i,rp), g);
1375: if (!isOrdered(g)) {
1.2 takayama 1376: errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");
1.1 maekawa 1377: }
1378: f = ppAdd(f,g);
1379: }
1380: }
1381: return(KpoPOLY(f));
1.3 takayama 1382: }
1383:
1384: int objToInteger(struct object ob) {
1385: if (ob.tag == Sinteger) {
1.5 takayama 1386: return KopInteger(ob);
1.3 takayama 1387: }else if (ob.tag == SuniversalNumber) {
1.5 takayama 1388: return(coeffToInt(KopUniversalNumber(ob)));
1.3 takayama 1389: }else {
1.5 takayama 1390: errorKan1("%s\n","objToInteger(): invalid argument.");
1.3 takayama 1391: }
1.12 takayama 1392: }
1393:
1394: struct object KgetExponents(struct object obPoly,struct object otype) {
1395: int type,asize,i;
1396: POLY f;
1397: POLY ff;
1398: MONOMIAL tf;
1.18 takayama 1399: struct object rob = OINIT;
1400: struct object tob = OINIT;
1.12 takayama 1401: static int nn,mm,ll,cc,n,m,l,c;
1402: static struct ring *cr = (struct ring *)NULL;
1403: extern struct ring *CurrentRingp;
1404: int size,hsize,fsize,p,r;
1405:
1406: if (otype.tag == Sinteger) {
1407: type = KopInteger(otype);
1408: }else if (otype.tag == SuniversalNumber) {
1409: type = coeffToInt(KopUniversalNumber(otype));
1410: }else {
1411: errorKan1("%s\n","KgetExponents(): invalid translation type.");
1412: }
1413:
1414: if (obPoly.tag == Spoly) {
1415: f = KopPOLY(obPoly);
1416: }else if (obPoly.tag == Sarray) {
1417: asize = getoaSize(obPoly);
1418: rob = newObjectArray(asize);
1419: for (i=0; i<asize; i++) {
1420: tob = KgetExponents(getoa(obPoly,i),otype);
1421: putoa(rob,i,tob);
1422: }
1.13 takayama 1423: return rob;
1.12 takayama 1424: }else{
1425: errorKan1("%s\n","KgetExponents(): argument must be a polynomial.");
1426: }
1427:
1428: /* type == 0 x,y,Dx,Dy (no commutative, no vector)
1.16 takayama 1429: type == 1 x,y,Dx,Dy,h,H (commutative & no vector)
1.12 takayama 1430: type == 2 x,y,Dx,Dy,h (commutative & no vector)
1431: */
1432: if (f ISZERO) {
1433: cr = CurrentRingp;
1434: }else{
1435: tf = f->m;
1436: }
1437: if (tf->ringp != cr) {
1438: n = tf->ringp->n;
1439: m = tf->ringp->m;
1440: l = tf->ringp->l;
1441: c = tf->ringp->c;
1442: nn = tf->ringp->nn;
1443: mm = tf->ringp->mm;
1444: ll = tf->ringp->ll;
1445: cc = tf->ringp->cc;
1446: cr = tf->ringp;
1447: }
1448: if (type == 0) {
1449: size = 0;
1450: for (i=c; i<ll; i++) size += 2;
1451: for (i=l; i<mm; i++) size += 2;
1452: for (i=m; i<nn; i++) size += 2;
1453: }else if (type == 1) {
1454: size = 0;
1455: for (i=0; i<cc; i++) size += 2;
1456: for (i=c; i<ll; i++) size += 2;
1457: for (i=l; i<mm; i++) size += 2;
1458: for (i=m; i<nn; i++) size += 2;
1459: }else if (type == 2) {
1460: size = 0;
1461: for (i=0; i<cc; i++) size += 1;
1462: for (i=c; i<ll; i++) size += 2;
1463: for (i=l; i<mm; i++) size += 2;
1464: for (i=m; i<nn; i++) size += 2;
1465: }else{
1466: errorKan1("%s\n","KgetExponent, unknown type.");
1467: }
1.16 takayama 1468: if (type == 1 || type == 2) {
1469: hsize = (size-cc)/2;
1470: }else{
1471: hsize = size/2;
1472: }
1.12 takayama 1473: if (f ISZERO) {
1474: tob = newObjectArray(size);
1475: for (i=0; i<size; i++) {
1476: putoa(tob,i,KpoInteger(0));
1477: }
1478: rob = newObjectArray(1);
1479: putoa(rob,0,tob);
1480: return rob;
1481: }
1482: fsize = 0;
1483: ff = f;
1484: while (ff != POLYNULL) {
1485: fsize++;
1486: ff = ff->next;
1487: }
1488: rob = newObjectArray(fsize);
1489:
1490: ff = f;
1491: p = 0;
1492: while (ff != POLYNULL) {
1493: r = 0;
1494: tob = newObjectArray(size);
1495: tf = ff->m;
1496: for (i=ll-1; i>=c; i--) {
1497: putoa(tob,r,KpoInteger(tf->e[i].x));
1498: putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
1499: r++;
1500: }
1501: for (i=mm-1; i>=l; i--) {
1502: putoa(tob,r,KpoInteger(tf->e[i].x));
1503: putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
1504: r++;
1505: }
1506: for (i=nn-1; i>=m; i--) {
1507: putoa(tob,r,KpoInteger(tf->e[i].x));
1508: putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
1509: r++;
1510: }
1511: if (type == 1) {
1512: for (i=cc-1; i>=0; i--) {
1.16 takayama 1513: putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
1514: r++;
1.12 takayama 1515: putoa(tob,hsize+r,KpoInteger(tf->e[i].x));
1516: r++;
1517: }
1518: }else if (type == 2) {
1519: for (i=cc-1; i>=0; i--) {
1520: putoa(tob,hsize+r,KpoInteger(tf->e[i].D));
1521: r++;
1522: }
1523: }
1524:
1525: putoa(rob,p,tob);
1526: p++;
1527: ff = ff->next;
1528: }
1529: return rob;
1.1 maekawa 1530: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to kanExport1.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan