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