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