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