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