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