Annotation of OpenXM/src/kan96xx/Kan/kanExport1.c, Revision 1.5
1.5 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.4 2003/07/13 07:53:17 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
3: #include "datatype.h"
4: #include "stackm.h"
5: #include "extern.h"
6: #include "extern2.h"
7: #include "lookup.h"
8: #include "matrix.h"
9: #include "gradedset.h"
10: #include "kclass.h"
11:
12: static int Message = 1;
13: extern int KanGBmessage;
14:
1.5 ! takayama 15: struct object DegreeShifto;
! 16: int DegreeShifto_size = 0;
! 17: int *DegreeShifto_vec = NULL;
! 18:
1.1 maekawa 19: /** :kan, :ring */
20: struct object Kreduction(f,set)
1.2 takayama 21: struct object f;
22: struct object set;
1.1 maekawa 23: {
24: POLY r;
25: struct gradedPolySet *grG;
26: struct syz0 syz;
27: struct object rob;
28: int flag;
29: extern int ReduceLowerTerms;
30:
31: if (f.tag != Spoly) errorKan1("%s\n","Kreduction(): the first argument must be a polynomial.");
32:
33: if (ectag(set) == CLASSNAME_GradedPolySet) {
34: grG = KopGradedPolySet(set);
35: flag = 1;
36: }else{
37: if (set.tag != Sarray) errorKan1("%s\n","Kreduction(): the second argument must be a set of polynomials.");
38: grG = arrayToGradedPolySet(set);
39: flag = 0;
40: }
41: if (ReduceLowerTerms) {
42: r = (*reductionCdr)(f.lc.poly,grG,1,&syz);
43: }else{
44: r = (*reduction)(f.lc.poly,grG,1,&syz);
45: }
46: if (flag) {
47: rob = newObjectArray(3);
48: putoa(rob,0,KpoPOLY(r));
49: putoa(rob,1,KpoPOLY(syz.cf));
50: putoa(rob,2,syzPolyToArray(countGradedPolySet(grG),syz.syz,grG));
51: }else {
52: rob = newObjectArray(4);
53: putoa(rob,0,KpoPOLY(r));
54: putoa(rob,1,KpoPOLY(syz.cf));
55: putoa(rob,2,syzPolyToArray(getoaSize(set),syz.syz,grG));
56: putoa(rob,3,gradedPolySetToArray(grG,1));
57: }
58: return(rob);
59: }
60:
61: struct object Kgroebner(ob)
1.2 takayama 62: struct object ob;
1.1 maekawa 63: {
64: int needSyz = 0;
65: int needBack = 0;
66: int needInput = 0;
67: int countDown = 0;
68: int cdflag = 0;
69: struct object ob1,ob2,ob2c;
70: int i;
71: struct gradedPolySet *grG;
72: struct pair *grP;
73: struct arrayOfPOLY *a;
74: struct object rob;
75: struct gradedPolySet *grBases;
76: struct matrixOfPOLY *mp;
77: struct matrixOfPOLY *backwardMat;
78: struct object ob1New;
79: extern char *F_groebner;
80: extern int CheckHomogenization;
81: extern int StopDegree;
82: int sdflag = 0;
83: int forceReduction = 0;
84:
85: int ob1Size, ob2Size, noZeroEntry;
86: int *ob1ToOb2;
87: int *ob1ZeroPos;
88: int method;
89: int j,k;
90: struct object rob2;
91: struct object rob3;
92: struct object rob4;
93: struct ring *myring;
94: POLY f;
95: struct object orgB;
96: struct object newB;
97: struct object orgC;
98: struct object newC;
99: static struct object paddingVector(struct object ob, int table[], int m);
100: static struct object unitVector(int pos, int size,struct ring *r);
101: extern struct ring *CurrentRingp;
102:
103: StopDegree = 0x7fff;
104:
105: if (ob.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array.");
106: switch(getoaSize(ob)) {
107: case 1:
108: needBack = 0; needSyz = 0; needInput = 0;
109: ob1 = getoa(ob,0);
110: break;
111: case 2:
112: ob1 = getoa(ob,0);
113: ob2 = getoa(ob,1);
114: if (ob2.tag != Sarray) {
115: errorKan1("%s\n","Kgroebner(): The options must be given by an array.");
116: }
117: for (i=0; i<getoaSize(ob2); i++) {
118: ob2c = getoa(ob2,i);
119: if (ob2c.tag == Sdollar) {
1.2 takayama 120: if (strcmp(ob2c.lc.str,"needBack")==0) {
121: needBack = 1;
122: }else if (strcmp(ob2c.lc.str,"needSyz")==0) {
123: if (!needBack) {
124: /* warningKan("Kgroebner(): needBack is automatically set."); */
125: }
126: needSyz = needBack = 1;
127: }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {
128: forceReduction = 1;
129: }else if (strcmp(ob2c.lc.str,"countDown")==0) {
130: countDown = 1; cdflag = 1;
131: if (needSyz) {
132: warningKan("Kgroebner(): needSyz is automatically turned off.");
133: needSyz = 0;
134: }
135: }else if (strcmp(ob2c.lc.str,"StopDegree")==0) {
136: StopDegree = 0; sdflag = 1;
137: if (needSyz) {
138: warningKan("Kgroebner(): needSyz is automatically turned off.");
139: needSyz = 0;
140: }
141: }else {
142: warningKan("Unknown keyword for options.");
143: }
1.1 maekawa 144: }else if (ob2c.tag == Sinteger) {
1.2 takayama 145: if (cdflag) {
146: cdflag = 0;
147: countDown = KopInteger(ob2c);
148: }else if (sdflag) {
149: sdflag = 0;
150: StopDegree = KopInteger(ob2c);
151: }
1.1 maekawa 152: }
153: }
154: break;
155: default:
156: errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");
157: }
1.2 takayama 158:
1.1 maekawa 159: if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");
160: ob1New = newObjectArray(getoaSize(ob1));
161: for (i=0; i< getoaSize(ob1); i++) {
162: if (getoa(ob1,i).tag == Spoly) {
163: putoa(ob1New,i,getoa(ob1,i));
164: }else if (getoa(ob1,i).tag == Sarray) {
165: /* If the generater is given as an array, flatten it. */
166: putoa(ob1New,i,KpoPOLY( arrayToPOLY(getoa(ob1,i))));
167: }else{
168: errorKan1("%s\n","Kgroebner(): The elements must be polynomials or array of polynomials.");
169: }
170: /* getoa(ob1,i) is poly, now check the homogenization. */
171: if (CheckHomogenization) {
172: if ((strcmp(F_groebner,"standard")==0) &&
1.2 takayama 173: !isHomogenized(KopPOLY(getoa(ob1New,i)))) {
174: fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));
175: errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");
1.1 maekawa 176: }
177: }
178: }
179: ob1 = ob1New;
180:
181: /* To handle the input with zero entries. For debug, debug/gr.sm1*/
182: ob1Size = getoaSize(ob1);
183: ob2Size = 0; myring = CurrentRingp;
184: for (i=0; i<ob1Size; i++) {
185: if (KopPOLY(getoa(ob1,i)) != POLYNULL) ob2Size++;
186: }
187: if (ob2Size == ob1Size) noZeroEntry = 1;
188: else noZeroEntry = 0;
189: if (ob1Size == 0) {
190: if (needBack && needSyz) {
191: rob = newObjectArray(3);
192: putoa(rob,0,newObjectArray(0));
193: putoa(rob,1,newObjectArray(0));
194: putoa(rob,2,newObjectArray(0));
195: }else if (needBack) {
196: rob = newObjectArray(2);
197: putoa(rob,0,newObjectArray(0));
198: putoa(rob,1,newObjectArray(0));
199: }else {
200: rob = newObjectArray(1);
201: putoa(rob,0,newObjectArray(0));
202: }
203: return(rob);
204: }
205: /* Assume ob1size > 0 */
206: if (ob2Size == 0) {
207: rob2 = newObjectArray(1); putoa(rob2,0,KpoPOLY(POLYNULL));
208: if (needBack && needSyz) {
209: rob = newObjectArray(3);
210: putoa(rob,0,rob2);
211: rob3 = newObjectArray(1);
212: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
213: putoa(rob,1,rob3);
214: rob4 = newObjectArray(ob1Size);
215: for (i=0; i<ob1Size; i++) {
1.2 takayama 216: putoa(rob4,i,unitVector(i,ob1Size,myring));
1.1 maekawa 217: }
218: putoa(rob,2,rob4);
219: }else if (needBack) {
220: rob = newObjectArray(2);
221: putoa(rob,0,rob2);
222: rob3 = newObjectArray(1);
223: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
224: putoa(rob,1,rob3);
225: }else {
226: rob = newObjectArray(1);
227: putoa(rob,0,rob2);
228: }
229: return(rob);
230: }
231: /* Assume ob1Size , ob2Size > 0 */
232: ob2 = newObjectArray(ob2Size);
233: ob1ToOb2 = (int *)GC_malloc(sizeof(int)*ob1Size);
234: ob1ZeroPos = (int *)GC_malloc(sizeof(int)*(ob1Size-ob2Size+1));
235: if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");
236: j = 0; k = 0;
237: for (i=0; i<ob1Size; i++) {
238: f = KopPOLY(getoa(ob1,i));
239: if (f != POLYNULL) {
240: myring = f->m->ringp;
241: putoa(ob2,j,KpoPOLY(f));
242: ob1ToOb2[i] = j; j++;
243: }else{
244: ob1ToOb2[i] = -1;
245: ob1ZeroPos[k] = i; k++;
246: }
247: }
248:
249: a = arrayToArrayOfPOLY(ob2);
250: grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction);
251:
252: if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {
253: warningKan("The options needBack and needSyz are ignored.");
254: needBack = needSyz = 0;
255: }
256:
257: /*return(gradedPolySetToGradedArray(grG,0));*/
258: if (needBack && needSyz) {
259: rob = newObjectArray(3);
260: if (Message && KanGBmessage) {
261: printf("Computing the backward transformation ");
262: fflush(stdout);
263: }
264: getBackwardTransformation(grG); /* mark and syz is modified. */
265: if (KanGBmessage) printf("Done.\n");
266:
267: /* Computing the syzygies. */
268: if (Message && KanGBmessage) {
269: printf("Computing the syzygies ");
270: fflush(stdout);
271: }
272: mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);
273: if (KanGBmessage) printf("Done.\n");
274:
275: putoa(rob,0,gradedPolySetToArray(grG,0));
276: putoa(rob,1,matrixOfPOLYToArray(backwardMat));
277: putoa(rob,2,matrixOfPOLYToArray(mp));
278: }else if (needBack) {
279: rob = newObjectArray(2);
280: if (Message && KanGBmessage) {
281: printf("Computing the backward transformation.....");
282: fflush(stdout);
283: }
284: getBackwardTransformation(grG); /* mark and syz is modified. */
285: if (KanGBmessage) printf("Done.\n");
286: putoa(rob,0,gradedPolySetToArray(grG,0));
287: putoa(rob,1,getBackwardArray(grG));
288: }else {
289: rob = newObjectArray(1);
290: putoa(rob,0,gradedPolySetToArray(grG,0));
291: }
292:
293: /* To handle zero entries in the input. */
294: if (noZeroEntry) {
295: return(rob);
296: }
297: method = getoaSize(rob);
298: switch(method) {
299: case 1:
300: return(rob);
301: break;
302: case 2:
303: orgB = getoa(rob,1); /* backward transformation. */
304: newB = newObjectArray(getoaSize(orgB));
305: for (i=0; i<getoaSize(orgB); i++) {
306: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
307: }
308: rob2 = newObjectArray(2);
309: putoa(rob2,0,getoa(rob,0));
310: putoa(rob2,1,newB);
311: return(rob2);
312: break;
313: case 3:
314: orgB = getoa(rob,1); /* backward transformation. */
315: newB = newObjectArray(getoaSize(orgB));
316: for (i=0; i<getoaSize(orgB); i++) {
317: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
318: }
319: orgC = getoa(rob,2);
320: newC = newObjectArray(getoaSize(orgC)+ob1Size-ob2Size);
321: for (i=0; i<getoaSize(orgC); i++) {
322: putoa(newC, i, paddingVector(getoa(orgC,i),ob1ToOb2,ob1Size));
323: }
324: for (i = getoaSize(orgC), j = 0; i<getoaSize(orgC)+ob1Size-ob2Size; i++,j++) {
325: putoa(newC,i,unitVector(ob1ZeroPos[j],ob1Size,myring));
326: }
327: rob2 = newObjectArray(3);
328: putoa(rob2,0,getoa(rob,0));
329: putoa(rob2,1,newB);
330: putoa(rob2,2,newC);
331: return(rob2);
332: break;
333: default:
334: errorKan1("%s","Kgroebner: unknown method.");
335: }
336: }
337:
338: static struct object paddingVector(struct object ob, int table[], int m)
339: {
340: struct object rob;
341: int i;
342: rob = newObjectArray(m);
343: for (i=0; i<m; i++) {
344: if (table[i] != -1) {
345: putoa(rob,i,getoa(ob,table[i]));
346: }else{
347: putoa(rob,i,KpoPOLY(POLYNULL));
348: }
349: }
350: return(rob);
351: }
352:
353: static struct object unitVector(int pos, int size,struct ring *r)
354: {
355: struct object rob;
356: int i;
357: POLY one;
358: rob = newObjectArray(size);
359: for (i=0; i<size; i++) {
360: putoa(rob,i,KpoPOLY(POLYNULL));
361: }
362: if ((0 <= pos) && (pos < size)) {
363: putoa(rob,pos, KpoPOLY(cxx(1,0,0,r)));
364: }
365: return(rob);
366: }
367:
368:
369:
370: /* :misc */
371:
372: #define INITGRADE 3
373: #define INITSIZE 0
374:
375: struct gradedPolySet *arrayToGradedPolySet(ob)
1.2 takayama 376: struct object ob;
1.1 maekawa 377: {
378: int n,i,grd,ind;
379: POLY f;
380: struct gradedPolySet *grG;
381: int serial;
382: extern int Sugar;
383:
384: if (ob.tag != Sarray) errorKan1("%s\n","arrayToGradedPolySet(): the argument must be array.");
385: n = getoaSize(ob);
386: for (i=0; i<n; i++) {
387: if (getoa(ob,i).tag != Spoly)
388: errorKan1("%s\n","arrayToGradedPolySet(): the elements must be polynomials.");
389: }
390: grG = newGradedPolySet(INITGRADE);
391:
392: for (i=0; i<grG->lim; i++) {
393: grG->polys[i] = newPolySet(INITSIZE);
394: }
395: for (i=0; i<n; i++) {
396: f = KopPOLY(getoa(ob,i));
397: grd = -1; whereInG(grG,f,&grd,&ind,Sugar);
398: serial = i;
399: grG = putPolyInG(grG,f,grd,ind,(struct syz0 *)NULL,1,serial);
400: }
401: return(grG);
402: }
403:
404:
405: struct object polySetToArray(ps,keepRedundant)
1.2 takayama 406: struct polySet *ps;
407: int keepRedundant;
1.1 maekawa 408: {
409: int n,i,j;
410: struct object ob;
411: if (ps == (struct polySet *)NULL) return(newObjectArray(0));
412: n = 0;
413: if (keepRedundant) {
414: n = ps->size;
415: }else{
416: for (i=0; i<ps->size; i++) {
417: if (ps->del[i] == 0) ++n;
418: }
419: }
420: ob = newObjectArray(n);
421: j = 0;
422: for (i=0; i<ps->size; i++) {
423: if (keepRedundant || (ps->del[i] == 0)) {
424: putoa(ob,j,KpoPOLY(ps->g[i]));
425: j++;
426: }
427: }
428: return(ob);
429: }
430:
431:
432: struct object gradedPolySetToGradedArray(gps,keepRedundant)
1.2 takayama 433: struct gradedPolySet *gps;
434: int keepRedundant;
1.1 maekawa 435: {
436: struct object ob,vec;
437: int i;
438: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
439: ob = newObjectArray(gps->maxGrade +1);
440: vec = newObjectArray(gps->maxGrade);
441: for (i=0; i<gps->maxGrade; i++) {
442: putoa(vec,i,KpoInteger(i));
443: putoa(ob,i+1,polySetToArray(gps->polys[i],keepRedundant));
444: }
445: putoa(ob,0,vec);
446: return(ob);
447: }
448:
449:
450: struct object gradedPolySetToArray(gps,keepRedundant)
1.2 takayama 451: struct gradedPolySet *gps;
452: int keepRedundant;
1.1 maekawa 453: {
454: struct object ob,vec;
455: struct polySet *ps;
456: int k;
457: int i,j;
458: int size;
459: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
460: size = 0;
461: for (i=0; i<gps->maxGrade; i++) {
462: ps = gps->polys[i];
463: if (keepRedundant) {
464: size += ps->size;
465: }else{
466: for (j=0; j<ps->size; j++) {
1.2 takayama 467: if (ps->del[j] == 0) ++size;
1.1 maekawa 468: }
469: }
470: }
471:
472: ob = newObjectArray(size);
473: k = 0;
474: for (i=0; i<gps->maxGrade; i++) {
475: ps = gps->polys[i];
476: for (j=0; j<ps->size; j++) {
477: if (keepRedundant || (ps->del[j] == 0)) {
1.2 takayama 478: putoa(ob,k,KpoPOLY(ps->g[j]));
479: k++;
1.1 maekawa 480: }
481: }
482: }
483: return(ob);
484: }
485:
486:
487: /* serial == -1 : It's not in the marix input. */
488: struct object syzPolyToArray(size,f,grG)
1.2 takayama 489: int size;
490: POLY f;
491: struct gradedPolySet *grG;
1.1 maekawa 492: {
493: struct object ob;
494: int i,g0,i0,serial;
495:
496: ob = newObjectArray(size);
497: for (i=0; i<size; i++) {
498: putoa(ob,i,KpoPOLY(ZERO));
499: }
500:
501: while (f != POLYNULL) {
502: g0 = srGrade(f);
503: i0 = srIndex(f);
504: serial = grG->polys[g0]->serial[i0];
505: if (serial < 0) {
506: errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
507: }
508: if (KopPOLY(getoa(ob,serial)) != ZERO) {
509: errorKan1("%s\n","syzPolyToArray(): syzygy polynomial is broken.");
510: }
511: putoa(ob,serial,KpoPOLY(f->coeffp->val.f));
512: f = f->next;
513: }
514: return(ob);
515: }
516:
517: struct object getBackwardArray(grG)
1.2 takayama 518: struct gradedPolySet *grG;
1.1 maekawa 519: {
520: /* use serial, del. cf. getBackwardTransformation(). */
521: int inputSize,outputSize;
522: int i,j,k;
523: struct object ob;
524: struct polySet *ps;
525:
526: inputSize = 0; outputSize = 0;
527: for (i=0; i<grG->maxGrade; i++) {
528: ps = grG->polys[i];
529: for (j=0; j<ps->size; j++) {
530: if (ps->serial[j] >= 0) ++inputSize;
531: if (ps->del[j] == 0) ++outputSize;
532: }
533: }
534:
535: ob = newObjectArray(outputSize);
536: k = 0;
537: for (i=0; i<grG->maxGrade; i++) {
538: ps = grG->polys[i];
539: for (j=0; j<ps->size; j++) {
540: if (ps->del[j] == 0) {
1.2 takayama 541: putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));
542: k++;
1.1 maekawa 543: }
544: }
545: }
546: return(ob);
547: }
548:
549:
550: POLY arrayToPOLY(ob)
1.2 takayama 551: struct object ob;
1.1 maekawa 552: {
553: int size,i;
554: struct object f;
555: POLY r;
556: static int nn,mm,ll,cc,n,m,l,c;
557: static struct ring *cr = (struct ring *)NULL;
558: POLY ff,ee;
559: MONOMIAL tf;
560:
561: if (ob.tag != Sarray) errorKan1("%s\n","arrayToPOLY(): The argument must be an array.");
562: size = getoaSize(ob);
563: r = ZERO;
564: for (i=0; i<size; i++) {
565: f = getoa(ob,i);
566: if (f.tag != Spoly) errorKan1("%s\n","arrayToPOLY(): The elements must be polynomials.");
567: ff = KopPOLY(f);
568: if (ff != ZERO) {
569: tf = ff->m;
570: if (tf->ringp != cr) {
1.2 takayama 571: n = tf->ringp->n;
572: m = tf->ringp->m;
573: l = tf->ringp->l;
574: c = tf->ringp->c;
575: nn = tf->ringp->nn;
576: mm = tf->ringp->mm;
577: ll = tf->ringp->ll;
578: cc = tf->ringp->cc;
579: cr = tf->ringp;
1.1 maekawa 580: }
581: if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);
582: else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);
583: else if (l-ll >0) ee = cxx(1,l-1,i,tf->ringp);
584: else if (c-cc >0) ee = cxx(1,c-1,i,tf->ringp);
585: else ee = ZERO;
586: r = ppAddv(r,ppMult(ee,ff));
587: }
588: }
589: return(r);
590: }
591:
592: struct object POLYToArray(ff)
1.2 takayama 593: POLY ff;
1.1 maekawa 594: {
595:
596: static int nn,mm,ll,cc,n,m,l,c;
597: static struct ring *cr = (struct ring *)NULL;
598: POLY ee;
599: MONOMIAL tf;
600: int k,i,matn,size;
601: struct matrixOfPOLY *mat;
602: POLY ex,sizep;
603: struct object ob;
604:
605: if (ff != ZERO) {
606: tf = ff->m;
607: if (tf->ringp != cr) {
608: n = tf->ringp->n;
609: m = tf->ringp->m;
610: l = tf->ringp->l;
611: c = tf->ringp->c;
612: nn = tf->ringp->nn;
613: mm = tf->ringp->mm;
614: ll = tf->ringp->ll;
615: cc = tf->ringp->cc;
616: cr = tf->ringp;
617: }
618: if (n-nn >0) ee = cxx(1,n-1,1,tf->ringp);
619: else if (m-mm >0) ee = cxx(1,m-1,1,tf->ringp);
620: else if (l-ll >0) ee = cxx(1,l-1,1,tf->ringp);
621: else if (c-cc >0) ee = cxx(1,c-1,1,tf->ringp);
622: else ee = ZERO;
623: }else{
624: ob = newObjectArray(1);
625: getoa(ob,0) = KpoPOLY(ZERO);
626: return(ob);
627: }
628: mat = parts(ff,ee);
629: matn = mat->n;
630: sizep = getMatrixOfPOLY(mat,0,0);
631: if (sizep == ZERO) size = 1;
632: else size = coeffToInt(sizep->coeffp)+1;
633: ob = newObjectArray(size);
634: for (i=0; i<size; i++) getoa(ob,i) = KpoPOLY(ZERO);
635: for (i=0; i<matn; i++) {
636: ex = getMatrixOfPOLY(mat,0,i);
637: if (ex == ZERO) k = 0;
638: else {
639: k = coeffToInt(ex->coeffp);
640: }
641: getoa(ob,k) = KpoPOLY(getMatrixOfPOLY(mat,1,i));
642: }
643: return(ob);
644: }
645:
646: static int isThereh(f)
1.2 takayama 647: POLY f;
1.1 maekawa 648: {
649: POLY t;
650: if (f == 0) return(0);
651: t = f;
652: while (t != POLYNULL) {
653: if (t->m->e[0].D) return(1);
654: t = t->next;
655: }
656: return(0);
657: }
658:
659: struct object homogenizeObject(ob,gradep)
1.2 takayama 660: struct object ob;
661: int *gradep;
1.1 maekawa 662: {
663: struct object rob,ob1;
664: int maxg;
665: int gr,flag,i,d,size;
666: struct ring *rp;
667: POLY f;
668: extern struct ring *CurrentRingp;
669: extern int Homogenize_vec;
670:
671: if (!Homogenize_vec) return(homogenizeObject_vec(ob,gradep));
672:
673: switch(ob.tag) {
674: case Spoly:
675: if (isThereh(KopPOLY(ob))) {
676: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
677: errorKan1("%s\n","homogenizeObject(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
678: }
679: f = homogenize( KopPOLY(ob) );
680: *gradep = (*grade)(f);
681: return(KpoPOLY(f));
682: break;
683: case Sarray:
684: size = getoaSize(ob);
685: if (size == 0) {
686: errorKan1("%s\n","homogenizeObject() is called for the empty array.");
687: }
688: rob = newObjectArray(size);
689: flag = 0;
690: ob1 = getoa(ob,0);
1.5 ! takayama 691: if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 692: ob1 = homogenizeObject(ob1,&gr);
693: maxg = gr;
694: getoa(rob,0) = ob1;
695: for (i=1; i<size; i++) {
696: ob1 = getoa(ob,i);
697: ob1 = homogenizeObject(ob1,&gr);
698: if (gr > maxg) {
1.2 takayama 699: maxg = gr;
1.1 maekawa 700: }
701: getoa(rob,i) = ob1;
702: }
703: maxg = maxg+size-1;
704: if (1) {
705: rp = oRingp(rob);
706: if (rp == (struct ring *)NULL) rp = CurrentRingp;
707: for (i=0; i<size; i++) {
1.2 takayama 708: gr = oGrade(getoa(rob,i));
709: /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/
710: if (maxg > gr) {
711: f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */
712: getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));
713: }
1.1 maekawa 714: }
715: }
716: *gradep = maxg;
717: return(rob);
718: break;
719: default:
720: errorKan1("%s\n","homogenizeObject(): Invalid argument data type.");
721: break;
722: }
723: }
724:
725: struct object homogenizeObject_vec(ob,gradep)
1.2 takayama 726: struct object ob;
727: int *gradep;
1.1 maekawa 728: {
729: struct object rob,ob1;
730: int maxg;
731: int gr,i,size;
732: POLY f;
733: extern struct ring *CurrentRingp;
734:
735: switch(ob.tag) {
736: case Spoly:
737: if (isThereh(KopPOLY(ob))) {
738: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
739: errorKan1("%s\n","homogenizeObject_vec(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
740: }
741: if (containVectorVariable(KopPOLY(ob))) {
742: errorKan1("%s\n","homogenizedObject_vec(): The given polynomial contains a variable to express a vector component.");
743: }
744: f = homogenize( KopPOLY(ob) );
745: *gradep = (*grade)(f);
746: return(KpoPOLY(f));
747: break;
748: case Sarray:
749: size = getoaSize(ob);
750: if (size == 0) {
751: errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
752: }
1.5 ! takayama 753: if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 754: rob = newObjectArray(size);
755: for (i=0; i<size; i++) {
756: ob1 = getoa(ob,i);
757: ob1 = homogenizeObject_vec(ob1,&gr);
758: if (i==0) maxg = gr;
759: else {
1.2 takayama 760: maxg = (maxg > gr? maxg: gr);
1.1 maekawa 761: }
762: putoa(rob,i,ob1);
763: }
764: *gradep = maxg;
765: return(rob);
766: break;
767: default:
768: errorKan1("%s\n","homogenizeObject_vec(): Invalid argument data type.");
769: break;
770: }
771: }
772:
1.3 takayama 773: struct object homogenizeObject_go(struct object ob,int *gradep) {
774: int size,i,dssize,j;
775: struct object ob0;
776: struct object ob1;
777: struct object ob2;
778: struct object rob;
779: struct object tob;
780: struct object ob1t;
781: int *ds;
782: POLY f;
783: rob = NullObject;
784: if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
785:
786: size = getoaSize(ob);
787: if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
788: ob0 = getoa(ob,0);
789: if (ob0.tag != Sdollar) {
790: errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
791: }
792: if (strcmp(KopString(ob0),"degreeShift") == 0) {
1.5 ! takayama 793: if (size < 2)
! 794: errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize");
! 795: ob1 = getoa(ob,1);
! 796: if (ob1.tag != Sarray) {
! 797: if (DegreeShifto_size != 0) {
! 798: return DegreeShifto;
! 799: }else{
! 800: rob = NullObject;
! 801: return rob;
1.3 takayama 802: }
803: }
1.5 ! takayama 804: dssize = getoaSize(ob1);
! 805: ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
! 806: for (i=0; i<dssize; i++) {
! 807: ds[i] = objToInteger(getoa(ob1,i));
! 808: }
! 809: if (size == 2) {
! 810: DegreeShifto = ob1;
! 811: DegreeShifto_size = dssize;
! 812: DegreeShifto_vec = ds;
! 813: rob = ob1;
! 814: }else{
! 815: ob2 = getoa(ob,2);
! 816: if (ob2.tag == Spoly) {
! 817: f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,0);
! 818: rob = KpoPOLY(f);
! 819: }else if (ob2.tag == SuniversalNumber) {
! 820: rob = ob2;
! 821: }else if (ob2.tag == Sarray) {
! 822: rob = newObjectArray(getoaSize(ob2));
! 823: for (i=0; i<getoaSize(ob2); i++) {
! 824: tob = newObjectArray(3);
! 825: ob1t = newObjectArray(dssize);
! 826: if (getoa(ob2,i).tag == Spoly) {
! 827: for (j=0; j<dssize; j++) getoa(ob1t,j) = KpoInteger(0);
! 828: for (j=0; j<dssize-i; j++) getoa(ob1t,j) = getoa(ob1,j+i);
! 829: }else{
! 830: ob1t = ob1;
! 831: }
! 832: getoa(tob,0) = ob0; getoa(tob,1) = ob1t; getoa(tob,2) = getoa(ob2,i);
! 833: getoa(rob,i) = homogenizeObject_go(tob,gradep);
! 834: }
! 835: }else{
! 836: errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
! 837: }
! 838: }
1.3 takayama 839: }else{
1.5 ! takayama 840: errorKan1("%s\n","homogenizeObject_go(): unknown key word.");
1.3 takayama 841: }
1.5 ! takayama 842: return( rob );
1.3 takayama 843: }
844:
845:
1.1 maekawa 846: struct ring *oRingp(ob)
1.2 takayama 847: struct object ob;
1.1 maekawa 848: {
849: struct ring *rp,*rptmp;
850: int i,size;
851: POLY f;
852: switch(ob.tag) {
853: case Spoly:
854: f = KopPOLY(ob);
855: if (f == ZERO) return((struct ring *)NULL);
856: return( f->m->ringp);
857: break;
858: case Sarray:
859: size = getoaSize(ob);
860: rp = (struct ring *)NULL;
861: for (i=0; i<size; i++) {
862: rptmp = oRingp(getoa(ob,i));
863: if (rptmp != (struct ring *)NULL) rp = rptmp;
864: return(rp);
865: }
866: break;
867: default:
868: errorKan1("%s\n","oRingp(): Invalid argument data type.");
869: break;
870: }
871: }
872:
873: int oGrade(ob)
1.2 takayama 874: struct object ob;
1.1 maekawa 875: {
876: int i,size;
877: POLY f;
878: int maxg,tmpg;
879: switch(ob.tag) {
880: case Spoly:
881: f = KopPOLY(ob);
882: return( (*grade)(f) );
883: break;
884: case Sarray:
885: size = getoaSize(ob);
886: if (size == 0) return(0);
887: maxg = oGrade(getoa(ob,0));
888: for (i=1; i<size; i++) {
889: tmpg = oGrade(getoa(ob,i));
890: if (tmpg > maxg) maxg = tmpg;
891: }
892: return(maxg);
893: break;
894: default:
895: errorKan1("%s\n","oGrade(): Invalid data type for the argument.");
896: break;
897: }
898: }
899:
900:
901: struct object oPrincipalPart(ob)
1.2 takayama 902: struct object ob;
1.1 maekawa 903: {
904: POLY f;
905: struct object rob;
906:
907: switch(ob.tag) {
908: case Spoly:
909: f = KopPOLY(ob);
910: return( KpoPOLY(POLYToPrincipalPart(f)));
911: break;
912: default:
913: errorKan1("%s\n","oPrincipalPart(): Invalid data type for the argument.");
914: break;
915: }
916: }
917: struct object oInitW(ob,oWeight)
1.2 takayama 918: struct object ob;
919: struct object oWeight;
1.1 maekawa 920: {
921: POLY f;
922: struct object rob;
923: int w[2*N0];
924: int n,i;
925: struct object ow;
926:
927: if (oWeight.tag != Sarray) {
928: errorKan1("%s\n","oInitW(): the second argument must be array.");
929: }
930: n = getoaSize(oWeight);
931: if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
932: for (i=0; i<n; i++) {
933: ow = getoa(oWeight,i);
934: if (ow.tag != Sinteger) {
935: errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
936: }
937: w[i] = KopInteger(ow);
938: }
939: switch(ob.tag) {
940: case Spoly:
941: f = KopPOLY(ob);
942: return( KpoPOLY(POLYToInitW(f,w)));
943: break;
944: default:
945: errorKan1("%s\n","oInitW(): Argument must be polynomial.");
946: break;
947: }
948: }
949:
950: int KpolyLength(POLY f) {
951: int size;
952: if (f == POLYNULL) return(1);
953: size = 0;
954: while (f != POLYNULL) {
955: f = f->next;
956: size++;
957: }
958: return(size);
959: }
960:
961: int validOutputOrder(int ord[],int n) {
962: int i,j,flag;
963: for (i=0; i<n; i++) {
964: flag = 0;
965: for (j=0; j<n; j++) {
966: if (ord[j] == i) flag = 1;
967: }
968: if (flag == 0) return(0); /* invalid */
969: }
970: return(1);
971: }
972:
973: struct object KsetOutputOrder(struct object ob, struct ring *rp)
974: {
975: int n,i;
976: struct object ox;
977: struct object otmp;
978: int *xxx;
979: int *ddd;
980: if (ob.tag != Sarray) {
981: errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...]");
982: }
983: n = rp->n;
984: ox = ob;
985: if (getoaSize(ox) != 2*n) {
986: 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.");
987: }
988: xxx = (int *)sGC_malloc(sizeof(int)*n*2);
989: if (xxx == NULL ) {
990: errorKan1("%s\n","KsetOutputOrder(): no more memory.");
991: }
992: for (i=0; i<2*n; i++) {
993: otmp = getoa(ox,i);
994: if(otmp.tag != Sinteger) {
995: errorKan1("%s\n","KsetOutputOrder(): elements must be integers.");
996: }
997: xxx[i] = KopInteger(otmp);
998: }
999: if (!validOutputOrder(xxx,2*n)) {
1000: errorKan1("%s\n","KsetOutputOrder(): Invalid output order for variables.");
1001: }
1002: rp->outputOrder = xxx;
1003: return(ob);
1004: }
1005:
1006: struct object KschreyerSkelton(struct object g)
1007: {
1008: struct object rob;
1009: struct object ij;
1010: struct object ab;
1011: struct object tt;
1012: struct arrayOfPOLY *ap;
1013: struct arrayOfMonomialSyz ans;
1014: int k;
1015: rob.tag = Snull;
1016: if (g.tag != Sarray) {
1017: errorKan1("%s\n","KschreyerSkelton(): argument must be an array of polynomials.");
1018: }
1019:
1020: ap = arrayToArrayOfPOLY(g);
1021: ans = schreyerSkelton(*ap);
1022:
1023: rob = newObjectArray(ans.size);
1024: for (k=0; k<ans.size; k++) {
1025: ij = newObjectArray(2);
1026: putoa(ij,0, KpoInteger(ans.p[k]->i));
1027: putoa(ij,1, KpoInteger(ans.p[k]->j));
1028: ab = newObjectArray(2);
1029: putoa(ab,0, KpoPOLY(ans.p[k]->a));
1030: putoa(ab,1, KpoPOLY(ans.p[k]->b));
1031: tt = newObjectArray(2);
1032: putoa(tt,0, ij);
1033: putoa(tt,1, ab);
1034: putoa(rob,k,tt);
1035: }
1036: return(rob);
1037: }
1038:
1039: struct object KisOrdered(struct object of)
1040: {
1041: if (of.tag != Spoly) {
1042: errorKan1("%s\n","KisOrdered(): argument must be a polynomial.");
1043: }
1044: if (isOrdered(KopPOLY(of))) {
1045: return(KpoInteger(1));
1046: }else{
1047: return(KpoInteger(0));
1048: }
1049: }
1050:
1051: struct object KvectorToSchreyer_es(struct object obarray)
1052: {
1053: int m,i;
1054: int nn;
1055: POLY f;
1056: POLY g;
1057: struct object ob;
1058: struct ring *rp;
1059: if (obarray.tag != Sarray) {
1060: errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
1061: }
1062: m = getoaSize(obarray);
1063: f = POLYNULL;
1064: for (i=0; i<m; i++) {
1065: ob = getoa(obarray,i);
1066: if (ob.tag != Spoly) {
1067: errorKan1("%s\n","KvectorToSchreyer_es(): each element of the array must be a polynomial.");
1068: }
1069: g = KopPOLY(ob);
1070: if (g != POLYNULL) {
1071: rp = g->m->ringp;
1072: nn = rp->nn;
1073: /* g = es^i g */
1074: g = mpMult_poly(cxx(1,nn,i,rp), g);
1075: if (!isOrdered(g)) {
1.2 takayama 1076: errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");
1.1 maekawa 1077: }
1078: f = ppAdd(f,g);
1079: }
1080: }
1081: return(KpoPOLY(f));
1.3 takayama 1082: }
1083:
1084: int objToInteger(struct object ob) {
1085: if (ob.tag == Sinteger) {
1.5 ! takayama 1086: return KopInteger(ob);
1.3 takayama 1087: }else if (ob.tag == SuniversalNumber) {
1.5 ! takayama 1088: return(coeffToInt(KopUniversalNumber(ob)));
1.3 takayama 1089: }else {
1.5 ! takayama 1090: errorKan1("%s\n","objToInteger(): invalid argument.");
1.3 takayama 1091: }
1.1 maekawa 1092: }
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