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