Annotation of OpenXM/src/kan96xx/Kan/kanExport1.c, Revision 1.3
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);
1.3 ! takayama 686: if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 687: ob1 = homogenizeObject(ob1,&gr);
688: maxg = gr;
689: getoa(rob,0) = ob1;
690: for (i=1; i<size; i++) {
691: ob1 = getoa(ob,i);
692: ob1 = homogenizeObject(ob1,&gr);
693: if (gr > maxg) {
1.2 takayama 694: maxg = gr;
1.1 maekawa 695: }
696: getoa(rob,i) = ob1;
697: }
698: maxg = maxg+size-1;
699: if (1) {
700: rp = oRingp(rob);
701: if (rp == (struct ring *)NULL) rp = CurrentRingp;
702: for (i=0; i<size; i++) {
1.2 takayama 703: gr = oGrade(getoa(rob,i));
704: /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/
705: if (maxg > gr) {
706: f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */
707: getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));
708: }
1.1 maekawa 709: }
710: }
711: *gradep = maxg;
712: return(rob);
713: break;
714: default:
715: errorKan1("%s\n","homogenizeObject(): Invalid argument data type.");
716: break;
717: }
718: }
719:
720: struct object homogenizeObject_vec(ob,gradep)
1.2 takayama 721: struct object ob;
722: int *gradep;
1.1 maekawa 723: {
724: struct object rob,ob1;
725: int maxg;
726: int gr,i,size;
727: POLY f;
728: extern struct ring *CurrentRingp;
729:
730: switch(ob.tag) {
731: case Spoly:
732: if (isThereh(KopPOLY(ob))) {
733: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
734: errorKan1("%s\n","homogenizeObject_vec(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
735: }
736: if (containVectorVariable(KopPOLY(ob))) {
737: errorKan1("%s\n","homogenizedObject_vec(): The given polynomial contains a variable to express a vector component.");
738: }
739: f = homogenize( KopPOLY(ob) );
740: *gradep = (*grade)(f);
741: return(KpoPOLY(f));
742: break;
743: case Sarray:
744: size = getoaSize(ob);
745: if (size == 0) {
746: errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
747: }
1.3 ! takayama 748: if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));
1.1 maekawa 749: rob = newObjectArray(size);
750: for (i=0; i<size; i++) {
751: ob1 = getoa(ob,i);
752: ob1 = homogenizeObject_vec(ob1,&gr);
753: if (i==0) maxg = gr;
754: else {
1.2 takayama 755: maxg = (maxg > gr? maxg: gr);
1.1 maekawa 756: }
757: putoa(rob,i,ob1);
758: }
759: *gradep = maxg;
760: return(rob);
761: break;
762: default:
763: errorKan1("%s\n","homogenizeObject_vec(): Invalid argument data type.");
764: break;
765: }
766: }
767:
1.3 ! takayama 768: struct object homogenizeObject_go(struct object ob,int *gradep) {
! 769: int size,i,dssize,j;
! 770: struct object ob0;
! 771: struct object ob1;
! 772: struct object ob2;
! 773: struct object rob;
! 774: struct object tob;
! 775: struct object ob1t;
! 776: int *ds;
! 777: POLY f;
! 778: rob = NullObject;
! 779: if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");
! 780:
! 781: size = getoaSize(ob);
! 782: if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
! 783: ob0 = getoa(ob,0);
! 784: if (ob0.tag != Sdollar) {
! 785: errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");
! 786: }
! 787: if (strcmp(KopString(ob0),"degreeShift") == 0) {
! 788: if (size != 3)
! 789: errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj]");
! 790: ob1 = getoa(ob,1); ob2 = getoa(ob,2);
! 791: dssize = getoaSize(ob1);
! 792: ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));
! 793: for (i=0; i<dssize; i++) {
! 794: ds[i] = objToInteger(getoa(ob1,i));
! 795: }
! 796: if (ob2.tag == Spoly) {
! 797: f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1);
! 798: rob = KpoPOLY(f);
! 799: }else if (ob2.tag == SuniversalNumber) {
! 800: rob = ob2;
! 801: }else if (ob2.tag == Sarray) {
! 802: rob = newObjectArray(getoaSize(ob2));
! 803: for (i=0; i<getoaSize(ob2); i++) {
! 804: tob = newObjectArray(3);
! 805: ob1t = newObjectArray(dssize);
! 806: if (getoa(ob2,i).tag == Spoly) {
! 807: for (j=0; j<dssize; j++) getoa(ob1t,j) = KpoInteger(0);
! 808: for (j=0; j<dssize-i; j++) getoa(ob1t,j) = getoa(ob1,j+i);
! 809: }else{
! 810: ob1t = ob1;
! 811: }
! 812: getoa(tob,0) = ob0; getoa(tob,1) = ob1t; getoa(tob,2) = getoa(ob2,i);
! 813: getoa(rob,i) = homogenizeObject_go(tob,gradep);
! 814: }
! 815: }else{
! 816: errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");
! 817: }
! 818: }else{
! 819: errorKan1("%s\n","homogenizeObject_go(): unknown key word.");
! 820: }
! 821: return( rob );
! 822: }
! 823:
! 824:
1.1 maekawa 825: struct ring *oRingp(ob)
1.2 takayama 826: struct object ob;
1.1 maekawa 827: {
828: struct ring *rp,*rptmp;
829: int i,size;
830: POLY f;
831: switch(ob.tag) {
832: case Spoly:
833: f = KopPOLY(ob);
834: if (f == ZERO) return((struct ring *)NULL);
835: return( f->m->ringp);
836: break;
837: case Sarray:
838: size = getoaSize(ob);
839: rp = (struct ring *)NULL;
840: for (i=0; i<size; i++) {
841: rptmp = oRingp(getoa(ob,i));
842: if (rptmp != (struct ring *)NULL) rp = rptmp;
843: return(rp);
844: }
845: break;
846: default:
847: errorKan1("%s\n","oRingp(): Invalid argument data type.");
848: break;
849: }
850: }
851:
852: int oGrade(ob)
1.2 takayama 853: struct object ob;
1.1 maekawa 854: {
855: int i,size;
856: POLY f;
857: int maxg,tmpg;
858: switch(ob.tag) {
859: case Spoly:
860: f = KopPOLY(ob);
861: return( (*grade)(f) );
862: break;
863: case Sarray:
864: size = getoaSize(ob);
865: if (size == 0) return(0);
866: maxg = oGrade(getoa(ob,0));
867: for (i=1; i<size; i++) {
868: tmpg = oGrade(getoa(ob,i));
869: if (tmpg > maxg) maxg = tmpg;
870: }
871: return(maxg);
872: break;
873: default:
874: errorKan1("%s\n","oGrade(): Invalid data type for the argument.");
875: break;
876: }
877: }
878:
879:
880: struct object oPrincipalPart(ob)
1.2 takayama 881: struct object ob;
1.1 maekawa 882: {
883: POLY f;
884: struct object rob;
885:
886: switch(ob.tag) {
887: case Spoly:
888: f = KopPOLY(ob);
889: return( KpoPOLY(POLYToPrincipalPart(f)));
890: break;
891: default:
892: errorKan1("%s\n","oPrincipalPart(): Invalid data type for the argument.");
893: break;
894: }
895: }
896: struct object oInitW(ob,oWeight)
1.2 takayama 897: struct object ob;
898: struct object oWeight;
1.1 maekawa 899: {
900: POLY f;
901: struct object rob;
902: int w[2*N0];
903: int n,i;
904: struct object ow;
905:
906: if (oWeight.tag != Sarray) {
907: errorKan1("%s\n","oInitW(): the second argument must be array.");
908: }
909: n = getoaSize(oWeight);
910: if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
911: for (i=0; i<n; i++) {
912: ow = getoa(oWeight,i);
913: if (ow.tag != Sinteger) {
914: errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
915: }
916: w[i] = KopInteger(ow);
917: }
918: switch(ob.tag) {
919: case Spoly:
920: f = KopPOLY(ob);
921: return( KpoPOLY(POLYToInitW(f,w)));
922: break;
923: default:
924: errorKan1("%s\n","oInitW(): Argument must be polynomial.");
925: break;
926: }
927: }
928:
929: int KpolyLength(POLY f) {
930: int size;
931: if (f == POLYNULL) return(1);
932: size = 0;
933: while (f != POLYNULL) {
934: f = f->next;
935: size++;
936: }
937: return(size);
938: }
939:
940: int validOutputOrder(int ord[],int n) {
941: int i,j,flag;
942: for (i=0; i<n; i++) {
943: flag = 0;
944: for (j=0; j<n; j++) {
945: if (ord[j] == i) flag = 1;
946: }
947: if (flag == 0) return(0); /* invalid */
948: }
949: return(1);
950: }
951:
952: struct object KsetOutputOrder(struct object ob, struct ring *rp)
953: {
954: int n,i;
955: struct object ox;
956: struct object otmp;
957: int *xxx;
958: int *ddd;
959: if (ob.tag != Sarray) {
960: errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...]");
961: }
962: n = rp->n;
963: ox = ob;
964: if (getoaSize(ox) != 2*n) {
965: 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.");
966: }
967: xxx = (int *)sGC_malloc(sizeof(int)*n*2);
968: if (xxx == NULL ) {
969: errorKan1("%s\n","KsetOutputOrder(): no more memory.");
970: }
971: for (i=0; i<2*n; i++) {
972: otmp = getoa(ox,i);
973: if(otmp.tag != Sinteger) {
974: errorKan1("%s\n","KsetOutputOrder(): elements must be integers.");
975: }
976: xxx[i] = KopInteger(otmp);
977: }
978: if (!validOutputOrder(xxx,2*n)) {
979: errorKan1("%s\n","KsetOutputOrder(): Invalid output order for variables.");
980: }
981: rp->outputOrder = xxx;
982: return(ob);
983: }
984:
985: struct object KschreyerSkelton(struct object g)
986: {
987: struct object rob;
988: struct object ij;
989: struct object ab;
990: struct object tt;
991: struct arrayOfPOLY *ap;
992: struct arrayOfMonomialSyz ans;
993: int k;
994: rob.tag = Snull;
995: if (g.tag != Sarray) {
996: errorKan1("%s\n","KschreyerSkelton(): argument must be an array of polynomials.");
997: }
998:
999: ap = arrayToArrayOfPOLY(g);
1000: ans = schreyerSkelton(*ap);
1001:
1002: rob = newObjectArray(ans.size);
1003: for (k=0; k<ans.size; k++) {
1004: ij = newObjectArray(2);
1005: putoa(ij,0, KpoInteger(ans.p[k]->i));
1006: putoa(ij,1, KpoInteger(ans.p[k]->j));
1007: ab = newObjectArray(2);
1008: putoa(ab,0, KpoPOLY(ans.p[k]->a));
1009: putoa(ab,1, KpoPOLY(ans.p[k]->b));
1010: tt = newObjectArray(2);
1011: putoa(tt,0, ij);
1012: putoa(tt,1, ab);
1013: putoa(rob,k,tt);
1014: }
1015: return(rob);
1016: }
1017:
1018: struct object KisOrdered(struct object of)
1019: {
1020: if (of.tag != Spoly) {
1021: errorKan1("%s\n","KisOrdered(): argument must be a polynomial.");
1022: }
1023: if (isOrdered(KopPOLY(of))) {
1024: return(KpoInteger(1));
1025: }else{
1026: return(KpoInteger(0));
1027: }
1028: }
1029:
1030: struct object KvectorToSchreyer_es(struct object obarray)
1031: {
1032: int m,i;
1033: int nn;
1034: POLY f;
1035: POLY g;
1036: struct object ob;
1037: struct ring *rp;
1038: if (obarray.tag != Sarray) {
1039: errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
1040: }
1041: m = getoaSize(obarray);
1042: f = POLYNULL;
1043: for (i=0; i<m; i++) {
1044: ob = getoa(obarray,i);
1045: if (ob.tag != Spoly) {
1046: errorKan1("%s\n","KvectorToSchreyer_es(): each element of the array must be a polynomial.");
1047: }
1048: g = KopPOLY(ob);
1049: if (g != POLYNULL) {
1050: rp = g->m->ringp;
1051: nn = rp->nn;
1052: /* g = es^i g */
1053: g = mpMult_poly(cxx(1,nn,i,rp), g);
1054: if (!isOrdered(g)) {
1.2 takayama 1055: errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");
1.1 maekawa 1056: }
1057: f = ppAdd(f,g);
1058: }
1059: }
1060: return(KpoPOLY(f));
1.3 ! takayama 1061: }
! 1062:
! 1063: int objToInteger(struct object ob) {
! 1064: if (ob.tag == Sinteger) {
! 1065: return KopInteger(ob);
! 1066: }else if (ob.tag == SuniversalNumber) {
! 1067: return(coeffToInt(KopUniversalNumber(ob)));
! 1068: }else {
! 1069: errorKan1("%s\n","objToInteger(): invalid argument.");
! 1070: }
1.1 maekawa 1071: }
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