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