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