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