Annotation of OpenXM/src/kan96xx/Kan/poly4.c, Revision 1.16
1.16 ! ohara 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/poly4.c,v 1.15 2005/06/16 05:07:23 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
1.16 ! ohara 3: #include <string.h>
1.1 maekawa 4: #include "datatype.h"
5: #include "stackm.h"
6: #include "extern.h"
7: #include "extern2.h"
8: #include "matrix.h"
9: static void shell(int v[],int n);
10: static int degreeOfPrincipalPart(POLY f);
11: static int degreeOfInitW(POLY f,int w[]);
1.10 takayama 12: static int degreeOfInitWS(POLY f,int w[],int s[]);
1.13 takayama 13: static int dDegree(POLY f);
14: static POLY dHomogenize(POLY f);
1.1 maekawa 15:
16: static void shell(v,n)
1.3 takayama 17: int v[];
18: int n;
1.1 maekawa 19: {
20: int gap,i,j,temp;
21:
22: for (gap = n/2; gap > 0; gap /= 2) {
23: for (i = gap; i<n; i++) {
24: for (j=i-gap ; j>=0 && v[j]<v[j+gap]; j -= gap) {
1.3 takayama 25: temp = v[j];
26: v[j] = v[j+gap];
27: v[j+gap] = temp;
1.1 maekawa 28: }
29: }
30: }
31: }
32:
33:
34: struct matrixOfPOLY *parts(f,v)
1.3 takayama 35: POLY f;
36: POLY v; /* v must be a single variable, e.g. x */
1.1 maekawa 37: {
38: struct matrixOfPOLY *evPoly;
39: int vi = 0; /* index of v */
40: int vx = 1; /* x --> 1, D--> 0 */
41: int n,evSize,i,k,e;
42: int *ev;
43: struct object *evList;
44: struct object *list;
1.15 takayama 45: struct object ob = OINIT;
1.1 maekawa 46: POLY ans;
47: POLY h;
48: extern struct ring *CurrentRingp;
49: POLY ft;
50:
51:
52: if (f ISZERO || v ISZERO) {
53: evPoly = newMatrixOfPOLY(2,1);
54: getMatrixOfPOLY(evPoly,0,0) = ZERO;
55: getMatrixOfPOLY(evPoly,1,0) = ZERO;
56: return(evPoly);
57: }
58: n = v->m->ringp->n;
59: /* get the index of the variable v */
60: for (i=0; i<n; i++) {
61: if (v->m->e[i].x) {
62: vx = 1; vi = i; break;
63: }else if (v->m->e[i].D) {
64: vx = 0; vi = i; break;
65: }
66: }
67: ft = f;
68: /* get the vector of exponents */
69: evList = NULLLIST;
70: while (ft != POLYNULL) {
71: if (vx) {
72: e = ft->m->e[vi].x;
73: }else{
74: e = ft->m->e[vi].D;
75: }
76: ft = ft->next;
77: ob = KpoInteger(e);
78: if (!memberQ(evList,ob)) {
79: list = newList(&ob);
80: evList = vJoin(evList,list);
81: }
82: }
83: /*printf("evList = "); printObjectList(evList);*/
84: evSize = klength(evList);
85: ev = (int *)sGC_malloc(sizeof(int)*(evSize+1));
86: if (ev == (int *)NULL) errorPoly("No more memory.");
87: for (i=0; i<evSize; i++) {
88: ev[i] = KopInteger(car(evList));
89: evList = cdr(evList);
90: }
91: /* sort ev */
92: shell(ev,evSize);
93:
94: /* get coefficients */
95: evPoly = newMatrixOfPOLY(2,evSize);
96: for (i=0; i<evSize; i++) {
97: ans = ZERO;
98: getMatrixOfPOLY(evPoly,0,i) = cxx(ev[i],0,0,CurrentRingp);
99: ft = f;
100: while (ft != POLYNULL) {
101: if (vx) {
1.3 takayama 102: if (ft->m->e[vi].x == ev[i]) {
103: h = newCell(ft->coeffp,monomialCopy(ft->m));
104: xset0(h,vi); /* touch monomial part, so you need to copy it above. */
105: ans = ppAdd(ans,h);
106: }
1.1 maekawa 107: }else{
1.3 takayama 108: if (ft->m->e[vi].D == ev[i]) {
109: h = newCell(ft->coeffp,monomialCopy(ft->m));
110: dset0(h,vi);
111: ans = ppAdd(ans,h);
112: }
1.1 maekawa 113: }
114: ft = ft->next;
115: }
116: getMatrixOfPOLY(evPoly,1,i) = ans;
117: }
118: return(evPoly);
119: }
1.3 takayama 120:
1.1 maekawa 121: struct object parts2(f,v)
1.3 takayama 122: POLY f;
123: POLY v; /* v must be a single variable, e.g. x */
1.1 maekawa 124: {
125: struct matrixOfPOLY *evPoly;
126: int vi = 0; /* index of v */
127: int vx = 1; /* x --> 1, D--> 0 */
128: int n,evSize,i,k,e;
129: int *ev;
130: struct object *evList;
131: struct object *list;
1.15 takayama 132: struct object ob = OINIT;
1.1 maekawa 133: POLY ans;
134: POLY h;
135: POLY ft;
1.15 takayama 136: struct object ob1 = OINIT;
137: struct object ob2 = OINIT;
138: struct object rob = OINIT;
1.1 maekawa 139:
140:
141: if (f ISZERO || v ISZERO) {
142: evPoly = newMatrixOfPOLY(2,1);
143: getMatrixOfPOLY(evPoly,0,0) = ZERO;
144: getMatrixOfPOLY(evPoly,1,0) = ZERO;
145: rob = newObjectArray(2);
146: ob1 = newObjectArray(1);
147: ob2 = newObjectArray(1);
148: putoa(ob1,0,KpoInteger(0));
149: putoa(ob2,0,KpoPOLY(POLYNULL));
150: putoa(rob,0,ob1); putoa(rob,1,ob2);
151: return(rob);
152: }
153: n = v->m->ringp->n;
154: /* get the index of the variable v */
155: for (i=0; i<n; i++) {
156: if (v->m->e[i].x) {
157: vx = 1; vi = i; break;
158: }else if (v->m->e[i].D) {
159: vx = 0; vi = i; break;
160: }
161: }
162: ft = f;
163: /* get the vector of exponents */
164: evList = NULLLIST;
165: while (ft != POLYNULL) {
166: if (vx) {
167: e = ft->m->e[vi].x;
168: }else{
169: e = ft->m->e[vi].D;
170: }
171: ft = ft->next;
172: ob = KpoInteger(e);
173: if (!memberQ(evList,ob)) {
174: list = newList(&ob);
175: evList = vJoin(evList,list);
176: }
177: }
178: /*printf("evList = "); printObjectList(evList);*/
179: evSize = klength(evList);
180: ev = (int *)sGC_malloc(sizeof(int)*(evSize+1));
181: if (ev == (int *)NULL) errorPoly("No more memory.");
182: for (i=0; i<evSize; i++) {
183: ev[i] = KopInteger(car(evList));
184: evList = cdr(evList);
185: }
186: /* sort ev */
187: shell(ev,evSize);
188:
189: /* get coefficients */
190: evPoly = newMatrixOfPOLY(2,evSize);
191: for (i=0; i<evSize; i++) {
192: ans = ZERO;
193: /* getMatrixOfPOLY(evPoly,0,i) = cxx(ev[i],0,0,CurrentRingp); */
194: getMatrixOfPOLY(evPoly,0,i) = POLYNULL;
195: ft = f;
196: while (ft != POLYNULL) {
197: if (vx) {
1.3 takayama 198: if (ft->m->e[vi].x == ev[i]) {
199: h = newCell(ft->coeffp,monomialCopy(ft->m));
200: xset0(h,vi); /* touch monomial part, so you need to copy it above. */
201: ans = ppAdd(ans,h);
202: }
1.1 maekawa 203: }else{
1.3 takayama 204: if (ft->m->e[vi].D == ev[i]) {
205: h = newCell(ft->coeffp,monomialCopy(ft->m));
206: dset0(h,vi);
207: ans = ppAdd(ans,h);
208: }
1.1 maekawa 209: }
210: ft = ft->next;
211: }
212: getMatrixOfPOLY(evPoly,1,i) = ans;
213: }
214: rob = newObjectArray(2);
215: ob1 = newObjectArray(evSize);
216: ob2 = newObjectArray(evSize);
217: for (i=0; i<evSize; i++) {
218: putoa(ob2,i,KpoPOLY(getMatrixOfPOLY(evPoly,1,i)));
219: putoa(ob1,i,KpoInteger(ev[i]));
220: }
221: putoa(rob,0,ob1); putoa(rob,1,ob2);
222: return(rob);
223: }
1.3 takayama 224:
1.1 maekawa 225: int pDegreeWrtV(f,v)
1.3 takayama 226: POLY f;
227: POLY v;
1.1 maekawa 228: {
229: int vx = 1;
230: int vi = 0;
231: int i,n;
232: int ans;
233: if (f ISZERO || v ISZERO) return(0);
234: n = f->m->ringp->n;
235: for (i=0; i<n; i++) {
236: if (v->m->e[i].x) {
237: vx = 1; vi = i;
238: break;
239: }else if (v->m->e[i].D) {
240: vx = 0; vi = i;
241: break;
242: }
243: }
244: if (vx) {
245: ans = f->m->e[vi].x;
246: }else{
247: ans = f->m->e[vi].D;
248: }
249: f = f->next;
250: while (f != POLYNULL) {
251: if (vx) {
252: if (f->m->e[vi].x > ans) ans = f->m->e[vi].x;
253: }else{
254: if (f->m->e[vi].D > ans) ans = f->m->e[vi].D;
255: }
256: f = f->next;
257: }
258: return(ans);
259: }
260:
261: int containVectorVariable(POLY f)
262: {
263: MONOMIAL tf;
264: static int nn,mm,ll,cc,n,m,l,c;
265: static struct ring *cr = (struct ring *)NULL;
266: int i;
267:
268: if (f ISZERO) return(0);
269: tf = f->m;
270: if (tf->ringp != cr) {
271: n = tf->ringp->n;
272: m = tf->ringp->m;
273: l = tf->ringp->l;
274: c = tf->ringp->c;
275: nn = tf->ringp->nn;
276: mm = tf->ringp->mm;
277: ll = tf->ringp->ll;
278: cc = tf->ringp->cc;
279: cr = tf->ringp;
280: }
281:
282: while (f != POLYNULL) {
283: tf = f->m;
284: for (i=cc; i<c; i++) {
285: if ( tf->e[i].x ) return(1);
286: if ( tf->e[i].D ) return(1);
287: }
288: for (i=ll; i<l; i++) {
289: if (tf->e[i].x) return(1);
290: if (tf->e[i].D) return(1);
291: }
292: for (i=mm; i<m; i++) {
293: if (tf->e[i].x) return(1);
294: if (tf->e[i].D) return(1);
295: }
296: for (i=nn; i<n; i++) {
297: if (tf->e[i].x) return(1);
298: if (tf->e[i].D) return(1);
299: }
300: f = f->next;
301: }
302: return(0);
303:
304: }
305:
306: POLY homogenize(f)
1.3 takayama 307: POLY f;
308: /* homogenize by using (*grade)(f) */
1.1 maekawa 309: {
310: POLY t;
311: int maxg;
312: int flag,d;
1.13 takayama 313: extern int Homogenize;
1.1 maekawa 314:
315: if (f == ZERO) return(f);
1.13 takayama 316: if (Homogenize == 3) { /* double homogenization Dx x = x Dx + h H */
317: return dHomogenize(f);
318: }
1.1 maekawa 319: t = f; maxg = (*grade)(f); flag = 0;
320: while (t != POLYNULL) {
321: d = (*grade)(t);
322: if (d != maxg) flag = 1;
323: if (d > maxg) {
324: maxg = d;
325: }
326: t = t->next;
327: }
328: if (flag == 0) return(f);
329:
330: f = pmCopy(f); /* You can rewrite the monomial parts */
331: t = f;
332: while (t != POLYNULL) {
333: d = (*grade)(t);
334: if (d != maxg) {
335: t->m->e[0].D += maxg-d; /* Multiply h^(maxg-d) */
336: }
337: t = t->next;
338: }
339: return(f);
340: }
341:
342: int isHomogenized(f)
1.3 takayama 343: POLY f;
1.1 maekawa 344: {
345: POLY t;
346: extern int Homogenize_vec;
347: int maxg;
348: if (!Homogenize_vec) return(isHomogenized_vec(f));
349: if (f == ZERO) return(1);
1.4 takayama 350: if (f->m->ringp->weightedHomogenization) {
351: return 1; /* BUG: do not chech in case of one-zero homogenization */
352: }
1.1 maekawa 353: maxg = (*grade)(f);
354: t = f;
355: while (t != POLYNULL) {
356: if (maxg != (*grade)(t)) return(0);
357: t = t->next;
358: }
359: return(1);
360: }
361:
362: int isHomogenized_vec(f)
1.3 takayama 363: POLY f;
1.1 maekawa 364: {
1.3 takayama 365: /* This is not efficient version. *grade should be grade_module1v(). */
1.1 maekawa 366: POLY t;
367: int ggg;
368: if (f == ZERO) return(1);
1.4 takayama 369: if (f->m->ringp->weightedHomogenization) {
370: return 1; /* BUG: do not chech in case of one-zero homogenization */
371: }
1.1 maekawa 372: while (f != POLYNULL) {
373: t = f;
374: ggg = (*grade)(f);
375: while (t != POLYNULL) {
376: if ((*isSameComponent)(f,t)) {
1.3 takayama 377: if (ggg != (*grade)(t)) return(0);
1.1 maekawa 378: }
379: t = t->next;
380: }
381: f = f->next;
382: }
383: return(1);
384: }
385:
1.13 takayama 386: static POLY dHomogenize(f)
387: POLY f;
388: {
389: POLY t;
390: int maxg, maxdg;
391: int flag,d,dd,neg;
392:
393: if (f == ZERO) return(f);
1.14 takayama 394:
395: t = f;
396: maxg = (*grade)(f);
397: while (t != POLYNULL) {
398: dd = (*grade)(t);
399: if (maxg < dd) maxg = dd;
400: t = t->next;
401: }
402: /* fprintf(stderr,"maxg=%d\n",maxg); */
403:
404: t = f;
405: maxdg = dDegree(f);
406: while (t != POLYNULL) {
407: dd = dDegree(t);
408: if (maxdg < dd) maxdg = dd;
409: t = t->next;
410: }
411: /* fprintf(stderr,"maxdg=%d\n",maxdg); */
412:
413: t = f;
414: flag = 0;
1.13 takayama 415: while (t != POLYNULL) {
416: d = (*grade)(t);
417: if (d != maxg) flag = 1;
418: if (d > maxg) {
419: maxg = d;
420: }
421: d = dDegree(f);
422: if (d > maxdg) {
423: maxdg = d;
424: }
425: t = t->next;
426: }
427: if (flag == 0) return(f);
428:
429: t = f; neg = 0;
430: while (t != POLYNULL) {
431: d = (*grade)(t);
432: dd = dDegree(t);
433: if (maxg-d-(maxdg-dd) < neg) {
434: neg = maxg-d-(maxdg-dd);
435: }
436: t = t->next;
437: }
438: neg = -neg;
439:
440: f = pmCopy(f); /* You can rewrite the monomial parts */
441: t = f;
442: while (t != POLYNULL) {
443: d = (*grade)(t);
444: dd = dDegree(t);
445: t->m->e[0].D += maxdg-dd; /* h */
446: t->m->e[0].x += maxg-d-(maxdg-dd)+neg; /* Multiply H */
447: /* example Dx^2+Dx+x */
448: t = t->next;
449: }
450: return(f);
451: }
1.1 maekawa 452:
453: static int degreeOfPrincipalPart(f)
1.3 takayama 454: POLY f;
1.1 maekawa 455: {
456: int n,i,dd;
457: if (f ISZERO) return(0);
458: n = f->m->ringp->n; dd = 0;
459: /* D[0] is homogenization var */
460: for (i=1; i<n; i++) {
1.13 takayama 461: dd += f->m->e[i].D;
462: }
463: return(dd);
464: }
465:
466: static int dDegree(f)
467: POLY f;
468: {
469: int nn,i,dd,m;
470: if (f ISZERO) return(0);
471: nn = f->m->ringp->nn; dd = 0;
472: m = f->m->ringp->m;
473: for (i=m; i<nn; i++) {
1.1 maekawa 474: dd += f->m->e[i].D;
475: }
476: return(dd);
477: }
478:
479: POLY POLYToPrincipalPart(f)
1.3 takayama 480: POLY f;
1.1 maekawa 481: {
482: POLY node;
483: struct listPoly nod;
484: POLY h;
485: POLY g;
486: int maxd = -20000; /* very big negative number */
487: int dd;
488: node = &nod; node->next = POLYNULL; h = node;
489:
490: g = pCopy(f); /* shallow copy */
491: while (!(f ISZERO)) {
492: dd = degreeOfPrincipalPart(f);
493: if (dd > maxd) maxd = dd;
494: f = f->next;
495: }
496: while (!(g ISZERO)) {
497: dd = degreeOfPrincipalPart(g);
498: if (dd == maxd) {
499: h->next = g;
500: h = h->next;
501: }
502: g = g->next;
503: }
504: h->next = POLYNULL;
505: return(node->next);
506: }
507:
508: static int degreeOfInitW(f,w)
1.3 takayama 509: POLY f;
510: int w[];
1.1 maekawa 511: {
512: int n,i,dd;
513: if (f ISZERO) {
514: errorPoly("degreeOfInitW(0,w) ");
515: }
516: n = f->m->ringp->n; dd = 0;
517: for (i=0; i<n; i++) {
518: dd += (f->m->e[i].D)*w[n+i];
519: dd += (f->m->e[i].x)*w[i];
520: }
521: return(dd);
522: }
523:
524: POLY POLYToInitW(f,w)
1.3 takayama 525: POLY f;
526: int w[]; /* weight vector */
1.1 maekawa 527: {
528: POLY h;
529: POLY g;
530: int maxd;
531: int dd;
1.11 takayama 532: h = POLYNULL;
1.1 maekawa 533:
1.11 takayama 534: /*printf("1:%s\n",POLYToString(f,'*',1));*/
1.1 maekawa 535: if (f ISZERO) return(f);
536: maxd = degreeOfInitW(f,w);
1.11 takayama 537: g = f;
1.1 maekawa 538: while (!(f ISZERO)) {
539: dd = degreeOfInitW(f,w);
540: if (dd > maxd) maxd = dd;
541: f = f->next;
542: }
543: while (!(g ISZERO)) {
544: dd = degreeOfInitW(g,w);
545: if (dd == maxd) {
1.11 takayama 546: h = ppAdd(h,newCell(g->coeffp,g->m)); /* it might be slow. */
1.1 maekawa 547: }
548: g = g->next;
549: }
1.11 takayama 550: /*printf("2:%s\n",POLYToString(h,'*',1));*/
551: return(h);
1.10 takayama 552: }
553:
554: static int degreeOfInitWS(f,w,s)
555: POLY f;
556: int w[];
557: int s[];
558: {
559: int n,i,dd;
560: if (f ISZERO) {
561: errorPoly("degreeOfInitWS(0,w) ");
562: }
1.11 takayama 563: if (s == (int *) NULL) return degreeOfInitW(f,w);
1.10 takayama 564: n = f->m->ringp->n; dd = 0;
565: for (i=0; i<n-1; i++) {
566: dd += (f->m->e[i].D)*w[n+i];
567: dd += (f->m->e[i].x)*w[i];
568: }
569: dd += s[(f->m->e[n-1].x)];
570: return(dd);
571: }
572:
573: POLY POLYToInitWS(f,w,s)
574: POLY f;
575: int w[]; /* weight vector */
576: int s[]; /* shift vector */
577: {
578: POLY h;
579: POLY g;
580: int maxd;
581: int dd;
1.11 takayama 582: h = POLYNULL;
1.10 takayama 583:
1.11 takayama 584: /*printf("1s:%s\n",POLYToString(f,'*',1));*/
1.10 takayama 585: if (f ISZERO) return(f);
586: maxd = degreeOfInitWS(f,w,s);
1.11 takayama 587: g = f;
1.10 takayama 588: while (!(f ISZERO)) {
589: dd = degreeOfInitWS(f,w,s);
590: if (dd > maxd) maxd = dd;
591: f = f->next;
592: }
593: while (!(g ISZERO)) {
594: dd = degreeOfInitWS(g,w,s);
595: if (dd == maxd) {
1.11 takayama 596: h = ppAdd(h,newCell(g->coeffp,g->m)); /* it might be slow. */
1.10 takayama 597: }
598: g = g->next;
599: }
1.11 takayama 600: /*printf("2s:%s\n",POLYToString(h,'*',1));*/
601: return(h);
1.10 takayama 602: }
603:
604: int ordWsAll(f,w,s)
605: POLY f;
606: int w[]; /* weight vector */
607: int s[]; /* shift vector */
608: {
609: int maxd;
610: int dd;
611:
612: if (f ISZERO) errorPoly("ordWsAll(0,w,s) ");
613: maxd = degreeOfInitWS(f,w,s);
614: while (!(f ISZERO)) {
615: dd = degreeOfInitWS(f,w,s);
616: if (dd > maxd) maxd = dd;
617: f = f->next;
618: }
619: return maxd;
1.1 maekawa 620: }
621:
622:
623: /*
624: 1.The substitution "ringp->multiplication = ...." is allowed only in
625: KsetUpRing(), so the check in KswitchFunction is not necessary.
626: 2.mmLarger != matrix and AvoidTheSameRing==1, then error
627: 3.If Schreyer = 1, then the system always generates a new ring.
628: 4.The execution of set_order_by_matrix is not allowed when Avoid... == 1.
629: 5.When mmLarger == tower (in tower.sm1, tower-sugar.sm1), we do
630: as follows with our own risk.
631: [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
632: */
633: int isTheSameRing(struct ring *rstack[],int rp, struct ring *newRingp)
634: {
635: struct ring *rrr;
636: int i,j,k;
637: int a=0;
638: for (k=0; k<rp; k++) {
639: rrr = rstack[k];
640: if (rrr->p != newRingp->p) { a=1; goto bbb ; }
641: if (rrr->n != newRingp->n) { a=2; goto bbb ; }
642: if (rrr->nn != newRingp->nn) { a=3; goto bbb ; }
643: if (rrr->m != newRingp->m) { a=4; goto bbb ; }
644: if (rrr->mm != newRingp->mm) { a=5; goto bbb ; }
645: if (rrr->l != newRingp->l) { a=6; goto bbb ; }
646: if (rrr->ll != newRingp->ll) { a=7; goto bbb ; }
647: if (rrr->c != newRingp->c) { a=8; goto bbb ; }
648: if (rrr->cc != newRingp->cc) { a=9; goto bbb ; }
649: for (i=0; i<rrr->n; i++) {
650: if (strcmp(rrr->x[i],newRingp->x[i])!=0) { a=10; goto bbb ; }
651: if (strcmp(rrr->D[i],newRingp->D[i])!=0) { a=11; goto bbb ; }
652: }
653: if (rrr->orderMatrixSize != newRingp->orderMatrixSize) { a=12; goto bbb ; }
654: for (i=0; i<rrr->orderMatrixSize; i++) {
655: for (j=0; j<2*(rrr->n); j++) {
1.3 takayama 656: if (rrr->order[i*2*(rrr->n)+j] != newRingp->order[i*2*(rrr->n)+j])
657: { a=13; goto bbb ; }
1.1 maekawa 658: }
659: }
660: if (rrr->next != newRingp->next) { a=14; goto bbb ; }
661: if (rrr->multiplication != newRingp->multiplication) { a=15; goto bbb ; }
662: /* if (rrr->schreyer != newRingp->schreyer) { a=16; goto bbb ; }*/
663: if (newRingp->schreyer == 1) { a=16; goto bbb; }
1.4 takayama 664: if (rrr->weightedHomogenization != newRingp->weightedHomogenization) { a=16; goto bbb; }
1.7 takayama 665: if (rrr->degreeShiftSize != newRingp->degreeShiftSize) {
666: a = 17; goto bbb;
667: }
668: if (rrr->degreeShiftN != newRingp->degreeShiftN) {
669: a = 17; goto bbb;
670: }
671: for (i=0; i < rrr->degreeShiftSize; i++) {
672: for (j=0; j< rrr->degreeShiftN; j++) {
673: if (rrr->degreeShift[i*(rrr->degreeShiftN)+j] !=
674: newRingp->degreeShift[i*(rrr->degreeShiftN)+j]) {
675: a = 17; goto bbb;
676: }
677: }
678: }
679:
1.1 maekawa 680: /* The following fields are ignored.
681: void *gbListTower;
682: int *outputOrder;
683: char *name;
684: */
685: /* All tests are passed. */
686: return(k);
687: bbb: ;
688: /* for debugging. */
689: /* fprintf(stderr," reason=%d, ",a); */
690: }
691: return(-1);
692: }
1.6 takayama 693:
694: /* s->1 */
695: POLY goDeHomogenizeS(POLY f) {
1.9 takayama 696: POLY lRule[1];
697: POLY rRule[1];
698: struct ring *rp;
699: POLY ans;
700: /* printf("1:[%s]\n",POLYToString(f,'*',1)); */
701: if (f == POLYNULL) return f;
702: rp = f->m->ringp;
703: if (rp->next == NULL) {
704: lRule[0] = cxx(1,0,1,rp);
705: rRule[0] = cxx(1,0,0,rp);
706: ans=replace(f,lRule,rRule,1);
707: }else{
708: struct coeff *cp;
709: POLY t;
710: POLY nc;
711: ans = POLYNULL;
712: while (f != POLYNULL) {
713: cp = f->coeffp;
714: if (cp->tag == POLY_COEFF) {
715: t = goDeHomogenizeS((cp->val).f);
1.11 takayama 716: nc = newCell(polyToCoeff(t,f->m->ringp),monomialCopy(f->m));
1.9 takayama 717: ans = ppAddv(ans,nc);
718: f = f->next;
719: }else{
720: ans = f; break;
721: }
722: }
723: }
724: /* printf("2:[%s]\n",POLYToString(ans,'*',1)); */
725: return ans;
726: }
727:
728: POLY goDeHomogenizeS_buggy(POLY f) {
1.6 takayama 729: POLY node;
730: POLY lastf;
731: struct listPoly nod;
732: POLY h;
733: POLY tf;
734: int gt,first;
735:
1.9 takayama 736: printf("1:[%s]\n",POLYToString(f,'*',1));
1.6 takayama 737: if (f == POLYNULL) return(POLYNULL);
738: node = &nod;
739: node->next = POLYNULL;
740: lastf = POLYNULL;
741: first = 1;
742: while (f != POLYNULL) {
743: tf = newCell(f->coeffp,monomialCopy(f->m));
744: tf->m->e[0].x = 0; /* H, s variable in the G-O paper. */
745: if (first) {
746: node->next = tf;
747: lastf = tf;
748: first = 0;
749: }else{
750: gt = (*mmLarger)(lastf,tf);
751: if (gt == 1) {
752: lastf->next = tf;
753: lastf = tf;
754: }else{
755: h = node->next;
756: h = ppAddv(h,tf);
757: node->next = h;
758: lastf = h;
759: while (lastf->next != POLYNULL) {
760: lastf = lastf->next;
761: }
762: }
763: }
764: f = f->next;
765: }
1.9 takayama 766: printf("2:[%s]\n",POLYToString(node->next,'*',1));
1.6 takayama 767: return (node->next);
768: }
769:
1.5 takayama 770: /* Granger-Oaku's homogenization for the ecart tangent cone.
771: Note: 2003.07.10.
772: ds[] is the degree shift.
773: ei ( element index ). If it is < 0, then e[n-1]->x will be used,
774: else ei is used.
1.6 takayama 775: if onlyS is set to 1, then input is assumed to be (u,v)-h-homogeneous.
1.5 takayama 776: */
1.6 takayama 777: POLY goHomogenize(POLY f,int u[],int v[],int ds[],int dssize,int ei,int onlyS)
1.5 takayama 778: {
779: POLY node;
780: POLY lastf;
781: struct listPoly nod;
782: POLY h;
783: POLY tf;
784: int gt,first,m,mp,t,tp,dsIdx,message;
1.7 takayama 785: struct ring *rp;
1.5 takayama 786:
787: message = 1;
788: if (f == POLYNULL) return(POLYNULL);
1.7 takayama 789: rp = f->m->ringp;
1.12 takayama 790: /*
1.7 takayama 791: if ((rp->degreeShiftSize == 0) && (dssize > 0)) {
792: warningPoly("You are trying to homogenize a polynomial with degree shift. However, the polynomial belongs to the ring without degreeShift option. It may cause a trouble in comparison in free module.\n");
793: }
1.12 takayama 794: */
1.5 takayama 795: node = &nod;
796: node->next = POLYNULL;
797: lastf = POLYNULL;
798: first = 1;
799: while (f != POLYNULL) {
800: if (first) {
801: t = m = dGrade1(f);
802: tp = mp = uvGrade1(f,u,v,ds,dssize,ei);
803: }else{
804: t = dGrade1(f);
805: tp = uvGrade1(f,u,v,ds,dssize,ei);
806: if (t > m) m = t;
807: if (tp < mp) mp = tp;
808: }
809:
810: tf = newCell(f->coeffp,monomialCopy(f->m));
811: /* Automatic dehomogenize. Not += */
812: if (message && ((tf->m->e[0].D != 0) || (tf->m->e[0].x != 0))) {
813: /*go-debug fprintf(stderr,"Automatic dehomogenize and homogenize.\n"); */
814: message = 0;
815: }
1.6 takayama 816: if (!onlyS) {
817: tf->m->e[0].D = -t; /* h */
818: }
1.5 takayama 819: tf->m->e[0].x = tp; /* H, s variable in the G-O paper. */
820: /*go-debug printf("t(h)=%d, tp(uv+ds)=%d\n",t,tp); */
821: if (first) {
822: node->next = tf;
823: lastf = tf;
824: first = 0;
825: }else{
826: gt = (*mmLarger)(lastf,tf);
827: if (gt == 1) {
828: lastf->next = tf;
829: lastf = tf;
830: }else{
831: /*go-debug printf("?\n"); */
832: h = node->next;
833: h = ppAddv(h,tf);
834: node->next = h;
835: lastf = h;
836: while (lastf->next != POLYNULL) {
837: lastf = lastf->next;
838: }
839: }
840: }
841: f = f->next;
842: }
843: h = node->next;
844: /*go-debug printf("m=%d, mp=%d\n",m,mp); */
845: while (h != POLYNULL) {
1.12 takayama 846: /*go-debug printf("Old: h=%d, s=%d\n",h->m->e[0].D,h->m->e[0].x); */
1.6 takayama 847: if (!onlyS) h->m->e[0].D += m; /* h */
1.5 takayama 848: h->m->e[0].x += -mp; /* H, s*/
849: /*go-debug printf("New: h=%d, s=%d\n",h->m->e[0].D,h->m->e[0].x); */
850: h = h->next;
851: }
852: return (node->next);
853: }
854:
855: /* u[] = -1, v[] = 1 */
1.6 takayama 856: POLY goHomogenize11(POLY f,int ds[],int dssize,int ei,int onlyS)
1.5 takayama 857: {
858: int r;
859: int i,t,n,m,nn;
860: MONOMIAL tf;
861: static int *u;
862: static int *v;
863: static struct ring *cr = (struct ring *)NULL;
864:
865: if (f == POLYNULL) return POLYNULL;
866:
867: tf = f->m;
868: if (tf->ringp != cr) {
869: n = tf->ringp->n;
870: m = tf->ringp->m;
871: nn = tf->ringp->nn;
872: cr = tf->ringp;
873: u = (int *)sGC_malloc(sizeof(int)*n);
874: v = (int *)sGC_malloc(sizeof(int)*n);
875: for (i=0; i<n; i++) u[i]=v[i]=0;
876: for (i=m; i<nn; i++) {
877: u[i] = -1; v[i] = 1;
878: }
879: }
1.6 takayama 880: return(goHomogenize(f,u,v,ds,dssize,ei,onlyS));
1.5 takayama 881: }
882:
1.6 takayama 883: POLY goHomogenize_dsIdx(POLY f,int u[],int v[],int dsIdx,int ei,int onlyS)
1.5 takayama 884: {
885: if (f == POLYNULL) return POLYNULL;
886: }
1.6 takayama 887: POLY goHomogenize11_dsIdx(POLY f,int ds[],int dsIdx,int ei,int onlyS)
1.5 takayama 888: {
889: if (f == POLYNULL) return POLYNULL;
1.8 takayama 890: }
891:
892: /* cf. KsetUpRing() in kanExport0.c */
893: struct ring *newRingOverFp(struct ring *rp,int p) {
894: struct ring *newRingp;
895: char *ringName = NULL;
896: char pstr[64];
897: sprintf(pstr,"_%d",p);
898: ringName = (char *)sGC_malloc(128);
899: newRingp = (struct ring *)sGC_malloc(sizeof(struct ring));
900: if (newRingp == NULL) errorPoly("No more memory.\n");
901: strcpy(ringName,rp->name);
902: strcat(ringName,pstr);
903: *newRingp = *rp;
904: newRingp->p = p;
905: newRingp->name = ringName;
906: return newRingp;
907: }
908:
909: /*
910: P = 3001;
911: L = [ ];
912: while (P<10000) {
913: L=cons(P,L);
914: P = pari(nextprime,P+1);
915: }
916: print(L);
917: */
918: #define N799 799
919: static int nextPrime(void) {
920: static int pt = 0;
921: static int tb[N799] =
922: {3001,3011,3019,3023,3037,3041,3049,3061,3067,3079,3083,3089,3109,3119,3121,3137,3163,3167,3169,3181,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257,3259,3271,3299,3301,3307,3313,3319,3323,3329,3331,3343,3347,3359,3361,3371,3373,3389,3391,3407,3413,3433,3449,3457,3461,3463,3467,3469,3491,3499,3511,3517,3527,3529,3533,3539,3541,3547,3557,3559,3571,3581,3583,3593,3607,3613,3617,3623,3631,3637,3643,3659,3671,3673,3677,3691,3697,3701,3709,3719,3727,3733,3739,3761,3767,3769,3779,3793,3797,3803,3821,3823,3833,3847,3851,3853,3863,3877,3881,3889,3907,3911,3917,3919,3923,3929,3931,3943,3947,3967,3989,
923: 4001,4003,4007,4013,4019,4021,4027,4049,4051,4057,4073,4079,4091,4093,4099,4111,4127,4129,4133,4139,4153,4157,4159,4177,4201,4211,4217,4219,4229,4231,4241,4243,4253,4259,4261,4271,4273,4283,4289,4297,4327,4337,4339,4349,4357,4363,4373,4391,4397,4409,4421,4423,4441,4447,4451,4457,4463,4481,4483,4493,4507,4513,4517,4519,4523,4547,4549,4561,4567,4583,4591,4597,4603,4621,4637,4639,4643,4649,4651,4657,4663,4673,4679,4691,4703,4721,4723,4729,4733,4751,4759,4783,4787,4789,4793,4799,4801,4813,4817,4831,4861,4871,4877,4889,4903,4909,4919,4931,4933,4937,4943,4951,4957,4967,4969,4973,4987,4993,4999,
924: 5003,5009,5011,5021,5023,5039,5051,5059,5077,5081,5087,5099,5101,5107,5113,5119,5147,5153,5167,5171,5179,5189,5197,5209,5227,5231,5233,5237,5261,5273,5279,5281,5297,5303,5309,5323,5333,5347,5351,5381,5387,5393,5399,5407,5413,5417,5419,5431,5437,5441,5443,5449,5471,5477,5479,5483,5501,5503,5507,5519,5521,5527,5531,5557,5563,5569,5573,5581,5591,5623,5639,5641,5647,5651,5653,5657,5659,5669,5683,5689,5693,5701,5711,5717,5737,5741,5743,5749,5779,5783,5791,5801,5807,5813,5821,5827,5839,5843,5849,5851,5857,5861,5867,5869,5879,5881,5897,5903,5923,5927,5939,5953,5981,5987,
925: 6007,6011,6029,6037,6043,6047,6053,6067,6073,6079,6089,6091,6101,6113,6121,6131,6133,6143,6151,6163,6173,6197,6199,6203,6211,6217,6221,6229,6247,6257,6263,6269,6271,6277,6287,6299,6301,6311,6317,6323,6329,6337,6343,6353,6359,6361,6367,6373,6379,6389,6397,6421,6427,6449,6451,6469,6473,6481,6491,6521,6529,6547,6551,6553,6563,6569,6571,6577,6581,6599,6607,6619,6637,6653,6659,6661,6673,6679,6689,6691,6701,6703,6709,6719,6733,6737,6761,6763,6779,6781,6791,6793,6803,6823,6827,6829,6833,6841,6857,6863,6869,6871,6883,6899,6907,6911,6917,6947,6949,6959,6961,6967,6971,6977,6983,6991,6997,
926: 7001,7013,7019,7027,7039,7043,7057,7069,7079,7103,7109,7121,7127,7129,7151,7159,7177,7187,7193,7207,7211,7213,7219,7229,7237,7243,7247,7253,7283,7297,7307,7309,7321,7331,7333,7349,7351,7369,7393,7411,7417,7433,7451,7457,7459,7477,7481,7487,7489,7499,7507,7517,7523,7529,7537,7541,7547,7549,7559,7561,7573,7577,7583,7589,7591,7603,7607,7621,7639,7643,7649,7669,7673,7681,7687,7691,7699,7703,7717,7723,7727,7741,7753,7757,7759,7789,7793,7817,7823,7829,7841,7853,7867,7873,7877,7879,7883,7901,7907,7919,7927,7933,7937,7949,7951,7963,7993,
927: 8009,8011,8017,8039,8053,8059,8069,8081,8087,8089,8093,8101,8111,8117,8123,8147,8161,8167,8171,8179,8191,8209,8219,8221,8231,8233,8237,8243,8263,8269,8273,8287,8291,8293,8297,8311,8317,8329,8353,8363,8369,8377,8387,8389,8419,8423,8429,8431,8443,8447,8461,8467,8501,8513,8521,8527,8537,8539,8543,8563,8573,8581,8597,8599,8609,8623,8627,8629,8641,8647,8663,8669,8677,8681,8689,8693,8699,8707,8713,8719,8731,8737,8741,8747,8753,8761,8779,8783,8803,8807,8819,8821,8831,8837,8839,8849,8861,8863,8867,8887,8893,8923,8929,8933,8941,8951,8963,8969,8971,8999,
928: 9001,9007,9011,9013,9029,9041,9043,9049,9059,9067,9091,9103,9109,9127,9133,9137,9151,9157,9161,9173,9181,9187,9199,9203,9209,9221,9227,9239,9241,9257,9277,9281,9283,9293,9311,9319,9323,9337,9341,9343,9349,9371,9377,9391,9397,9403,9413,9419,9421,9431,9433,9437,9439,9461,9463,9467,9473,9479,9491,9497,9511,9521,9533,9539,9547,9551,9587,9601,9613,9619,9623,9629,9631,9643,9649,9661,9677,9679,9689,9697,9719,9721,9733,9739,9743,9749,9767,9769,9781,9787,9791,9803,9811,9817,9829,9833,9839,9851,9857,9859,9871,9883,9887,9901,9907,9923,9929,9931,9941,9949,9967,9973};
929:
930: if (pt <N799) {
931: return tb[pt++];
932: }else{
933: pt = 0;
934: return tb[pt++];
935: }
936: }
937:
938: int getPrime(int p) {
939: int i;
940: if (p <= 2) return nextPrime();
941: for (i=2; i<p; i++) {
942: if (p % i == 0) {
943: return nextPrime();
944: }
945: }
946: return p;
1.5 takayama 947: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>