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