Annotation of OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c, Revision 1.8
1.8 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c,v 1.7 2003/11/21 02:10:37 takayama Exp $ */
1.1 maekawa 2: /* Kclass/indeterminate.c */
1.7 takayama 3: /* This file handles indeterminate, recursivePolynomial,
1.1 maekawa 4: polynomialInOneVariable
5: */
6: #include <stdio.h>
7: #include "../datatype.h"
8: #include "../stackm.h"
9: #include "../extern.h"
10: #include "../gradedset.h"
11: #include "../extern2.h"
12: #include "../kclass.h"
13:
14:
15: /* Data conversion function : see KclassDataConversion*/
16: struct object KpoIndeterminate(struct object ob) {
1.8 ! takayama 17: struct object rob = OINIT;
1.1 maekawa 18: struct object *newobp;
19: rob.tag = Sclass;
20: rob.lc.ival = CLASSNAME_indeterminate;
21: newobp = (struct object *) sGC_malloc(sizeof(struct object));
22: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
23: if (ob.tag != Sdollar) {
24: errorKan1("%s\n","Kclass/indeterminate.c, only String object can be transformed into indeterminate.");
25: }
26: *newobp = ob;
27: rob.rc.voidp = newobp;
28: return(rob);
29: }
30:
31: /* The second constructor. */
32: struct object KnewIndeterminate(char *s) {
1.8 ! takayama 33: struct object ob = OINIT;
1.1 maekawa 34:
35: ob = KpoString(s); /* We do not clone s */
36: return(KpoIndeterminate(ob));
37: }
38:
39:
40: /* Printing function : see fprintClass */
41: void fprintIndeterminate(FILE *fp,struct object op)
42: {
43: printObject(KopIndeterminate(op),0,fp);
44: }
45:
1.7 takayama 46: /* Functions for trees are moved to tree.c */
1.1 maekawa 47: /* ---------------------------------------------------- */
48:
49: struct object KpoRecursivePolynomial(struct object ob) {
1.8 ! takayama 50: struct object rob = OINIT;
1.1 maekawa 51: struct object *newobp;
52: rob.tag = Sclass;
53: rob.lc.ival = CLASSNAME_recursivePolynomial;
54: newobp = (struct object *) sGC_malloc(sizeof(struct object));
55: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
56: if (ob.tag != Sarray) {
57: errorKan1("%s\n","Kclass/indeterminate.c, only array object can be transformed into recusivePolynomial.");
58: }
59: *newobp = ob;
60: rob.rc.voidp = newobp;
61: return(rob);
62: }
63:
64: static void printBodyOfRecursivePolynomial(struct object body,
1.5 takayama 65: struct object vlist, FILE *fp)
1.1 maekawa 66: {
67: int i,j;
68: int k;
69: if (ectag(body) != CLASSNAME_polynomialInOneVariable) {
70: printObject(body,0,fp);
71: return;
72: }
73: body = KopPolynomialInOneVariable(body);
74: if (body.tag != Sarray) {
75: errorKan1("%s\n","Kclass/indeterminate.c, format error for recursive polynomial.");
76: }
77: if (getoaSize(body) == 0) {
78: errorKan1("%s\n","printBodyOfRecursivePolynomial: format error for a recursive polynomial.");
79: }
80: i = KopInteger(getoa(body,0));
81: for (j=1; j<getoaSize(body); j = j+2) {
82: k = KopInteger(getoa(body,j));
83: if (k != 0) {
1.5 takayama 84: if (getoa(vlist,i).tag == Sdollar) {
85: fprintf(fp,"%s",KopString(getoa(vlist,i)));
86: }else if (ectag(getoa(vlist,i)) == CLASSNAME_tree) {
87: fprintClass(fp,getoa(vlist,i));
88: }else{
89: errorKan1("%s\n","printBodyOfRecursivePolynomial: format error.");
90: }
1.1 maekawa 91: if (k > 1) {
1.5 takayama 92: fprintf(fp,"^%d ",k);
1.1 maekawa 93: }else if (k == 1) {
94: }else{
1.5 takayama 95: fprintf(fp,"^(%d) ",k);
1.1 maekawa 96: }
97: fprintf(fp," * ");
98: }
99: fprintf(fp,"(");
100: printBodyOfRecursivePolynomial(getoa(body,j+1),vlist,fp);
101: fprintf(fp,")");
102: if (j != getoaSize(body)-2) {
103: fprintf(fp," + ");
104: }
105: }
106: return;
107: }
108:
109: void fprintRecursivePolynomial(FILE *fp,struct object op)
110: {
111: /* old code
1.5 takayama 112: printObject(KopRecursivePolynomial(op),0,fp); return;
1.1 maekawa 113: */
1.8 ! takayama 114: struct object ob = OINIT;
! 115: struct object vlist = OINIT;
! 116: struct object body = OINIT;
1.1 maekawa 117: ob = KopRecursivePolynomial(op);
118: if (ob.tag != Sarray) {
119: printObject(ob,0,fp); return;
120: }
121: if (!isRecursivePolynomial2(op)) {
122: printObject(KopRecursivePolynomial(op),0,fp); return;
123: }
124: vlist = getoa(ob,0);
125: body = getoa(ob,1);
126: printBodyOfRecursivePolynomial(body,vlist,fp);
127: return;
128: }
129:
130: /*------------------------------------------*/
131:
132: struct object KpoPolynomialInOneVariable(struct object ob) {
1.8 ! takayama 133: struct object rob = OINIT;
1.1 maekawa 134: struct object *newobp;
135: rob.tag = Sclass;
136: rob.lc.ival = CLASSNAME_polynomialInOneVariable;
137: newobp = (struct object *) sGC_malloc(sizeof(struct object));
138: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
139: if (ob.tag != Sarray) {
140: errorKan1("%s\n","Kclass/indeterminate.c, only array object can be transformed into polynomialInOneVariable.");
141: }
142: *newobp = ob;
143: rob.rc.voidp = newobp;
144: return(rob);
145: }
146:
147: void fprintPolynomialInOneVariable(FILE *fp,struct object op)
148: {
149: printObject(KopPolynomialInOneVariable(op),0,fp);
150: }
151:
152: struct object polyToRecursivePoly(struct object p) {
153: struct object rob = NullObject;
154: int vx[N0], vd[N0];
155: int i,j,k,n,count;
156: POLY f;
1.8 ! takayama 157: struct object vlist = OINIT;
! 158: struct object vlist2 = OINIT;
! 159: struct object ob1 = OINIT;
! 160: struct object ob2 = OINIT;
! 161: struct object ob3 = OINIT;
! 162: struct object ob4 = OINIT;
1.1 maekawa 163: int vn;
164:
165: if (p.tag != Spoly) return(rob);
166: f = KopPOLY(p);
167: if (f == ZERO) {
168: rob = p; return(rob);
169: }
170: /* construct list of variables. */
171: for (i=0; i<N0; i++) {
172: vx[i] = vd[i] = 0;
173: }
174: n = f->m->ringp->n; count = 0;
175: for (i=0; i<n; i++) {
176: if (pDegreeWrtV(f,cxx(1,i,1,f->m->ringp))) {
177: vx[i] = 1; count++;
178: }
179: if (pDegreeWrtV(f,cdd(1,i,1,f->m->ringp))) {
180: vd[i] = 1; count++;
181: }
182: }
183: vlist = newObjectArray(count); k = 0;
184: vlist2 = newObjectArray(count); k = 0;
185: for (i=0; i<n; i++) {
186: if (vd[i]) {
187: putoa(vlist,k,KpoPOLY(cdd(1,i,1,f->m->ringp)));
188: putoa(vlist2,k,KpoString(POLYToString(cdd(1,i,1,f->m->ringp),'*',0)));
189: k++;
190: }
191: }
192: for (i=0; i<n; i++) {
193: if (vx[i]) {
194: putoa(vlist,k,KpoPOLY(cxx(1,i,1,f->m->ringp)));
195: putoa(vlist2,k,KpoString(POLYToString(cxx(1,i,1,f->m->ringp),'*',0)));
196: k++;
197: }
198: }
199: /* printObject(vlist,1,stdout); */
200: if (getoaSize(vlist) == 0) {
201: vn = -1;
202: }else{
203: vn = 0;
204: }
205: ob1 = polyToRecursivePoly2(p,vlist,vn);
206: rob = newObjectArray(2);
207: putoa(rob,0,vlist2); putoa(rob,1,ob1);
208: /* format of rob
209: [ list of variables, poly or universalNumber or yyy to express
1.5 takayama 210: a recursive polynomial. ]
211: format of yyy = CLASSNAME_polynomialInOneVariable
1.1 maekawa 212: [Sinteger, Sinteger, coeff obj, Sinteger, coeff obj, .....]
1.5 takayama 213: name of var, exp, coeff, exp, coeff
214: This format is checked by isRecursivePolynomial2().
1.1 maekawa 215: */
216: rob = KpoRecursivePolynomial(rob);
217: if (isRecursivePolynomial2(rob)) {
218: return(rob);
219: }else{
220: errorKan1("%s\n","polyToRecursivePolynomial could not translate this object.");
221: }
222: }
223:
224: static void objectFormatError_ind0(char *s) {
225: char tmp[1024];
226: sprintf(tmp,"polyToRecursivePoly2: object format error for the variable %s",s);
227: errorKan1("%s\n",tmp);
228: }
229:
230: struct object polyToRecursivePoly2(struct object p,struct object vlist, int vn) {
231: struct object rob = NullObject;
232: POLY f;
233: POLY vv;
1.8 ! takayama 234: struct object v = OINIT;
! 235: struct object c = OINIT;
! 236: struct object e = OINIT;
1.1 maekawa 237: int i;
238:
239:
240: if (p.tag != Spoly) return(rob);
241: f = KopPOLY(p);
242: if (f == ZERO) {
243: rob = p; return(rob);
244: }
245: if (vn < 0 || vn >= getoaSize(vlist)) {
246: return(coeffToObject(f->coeffp));
247: }
248: v = getoa(vlist,vn);
249: if (v.tag != Spoly) objectFormatError_ind0("v");
250: vv = KopPOLY(v);
251: c = parts2(f,vv);
252: e = getoa(c,0); /* exponents. Array of integer. */
253: if (e.tag != Sarray) objectFormatError_ind0("e");
254: c = getoa(c,1); /* coefficients. Array of POLY. */
255: if (c.tag != Sarray) objectFormatError_ind0("c");
256: rob = newObjectArray(getoaSize(e)*2+1);
257:
258: putoa(rob,0,KpoInteger(vn)); /* put the variable number. */
259: for (i=0; i < getoaSize(e); i++) {
260: putoa(rob,1+i*2, getoa(e,i));
261: putoa(rob,1+i*2+1, polyToRecursivePoly2(getoa(c,i),vlist,vn+1));
262: }
263: /* printObject(rob,0,stderr); */
264: return(KpoPolynomialInOneVariable(rob));
265: }
266:
267: static int isRecursivePolynomial2a(struct object ob2, int n) {
268: char *s = "Format error (isRecursivePolynomial2a) : ";
1.8 ! takayama 269: struct object tmp = OINIT;
1.1 maekawa 270: int i;
271: if (ectag(ob2) == CLASSNAME_polynomialInOneVariable) {
272: ob2 = KopPolynomialInOneVariable(ob2);
273: }else if (ob2.tag == Sarray) {
274: fprintf(stderr,"isRecursivePolynomial2, argument is an array.\n");
275: printObject(ob2,0,stderr);
276: fprintf(stderr,"\n");
277: return(0); /* Array must be an error, but other objects are OK. */
278: }else {
279: return(1);
280: }
281: if (ob2.tag != Sarray) {
282: return(1);
283: /* coeff can be any. */
284: }
285: if (getoaSize(ob2) % 2 == 0) {
286: fprintf(stderr,"%s list body. The size of body must be odd.\n",s); printObject(ob2,1,stderr);
287: return(0);
288: }
289: tmp = getoa(ob2,0);
290: if (tmp.tag != Sinteger) {
291: fprintf(stderr,"%s list body. body[0] must be integer.\n",s); printObject(ob2,1,stderr);
292: return(0);
293: }
294: if (KopInteger(tmp) < 0 || KopInteger(tmp) >= n) {
295: fprintf(stderr,"%s list body. body[0] must be integer between 0 and the size of vlist -1.\n",s); printObject(ob2,1,stderr);
296: return(0);
297: }
298: for (i=1; i<getoaSize(ob2); i = i+2) {
299: tmp = getoa(ob2,i);
300: if (tmp.tag != Sinteger) {
301: fprintf(stderr,"%s [list vlist, list body]. body[%d] must be integer.\n",s,i);
302: printObject(ob2,1,stderr);
303: return(0);
304: }
305: }
306: for (i=2; i<getoaSize(ob2); i = i+2) {
307: tmp = getoa(ob2,i);
308: if (ectag(tmp) == CLASSNAME_polynomialInOneVariable) {
309: if (isRecursivePolynomial2a(tmp,n)) {
310: }else{
1.5 takayama 311: fprintf(stderr,"isRecursivePolynomial2a: entry is not a polynomial in one variable.\n");
312: printObject(tmp,0,stderr); fprintf(stderr,"\n");
313: return(0);
1.1 maekawa 314: }
315: }
316: }
317: return(1);
318: }
319:
320: int isRecursivePolynomial2(struct object ob) {
321: /* This checks only the top level */
322: char *s = "Format error (isRecursivePolynomial2) : ";
1.8 ! takayama 323: struct object ob1 = OINIT;
! 324: struct object ob2 = OINIT;
! 325: struct object tmp = OINIT;
1.1 maekawa 326: int i;
327: int n;
328: if (ob.tag != Sclass) return(0);
329: if (ectag(ob) != CLASSNAME_recursivePolynomial) return(0);
330: ob = KopRecursivePolynomial(ob);
331: if (ob.tag != Sarray) {
332: fprintf(stderr,"%s [vlist, body]\n",s); printObject(ob,1,stderr);
333: return(0);
334: }
335: if (getoaSize(ob) != 2) {
336: fprintf(stderr,"%s [vlist, body]. The length must be 2. \n",s);
337: printObject(ob,1,stderr);
338: return(0);
339: }
340: ob1 = getoa(ob,0);
341: ob2 = getoa(ob,1);
342: if (ob1.tag != Sarray) {
343: fprintf(stderr,"%s [list vlist, body].\n",s); printObject(ob,1,stderr);
344: return(0);
345: }
346: n = getoaSize(ob1);
347: for (i=0; i<n; i++) {
348: tmp = getoa(ob1,i);
1.4 takayama 349: if (tmp.tag == Sdollar) {
1.5 takayama 350: }else if (ectag(tmp) == CLASSNAME_tree) {
351: }else{
1.4 takayama 352: fprintf(stderr,"%s [list vlist, body]. Element of the vlist must be a string or a tree.\n",s); printObject(ob,1,stderr);
1.1 maekawa 353: return(0);
354: }
355: }
356: return(isRecursivePolynomial2a(ob2,n));
357: }
358:
359:
360: struct object coeffToObject(struct coeff *cp) {
361: struct object rob = NullObject;
362: switch(cp->tag) {
363: case INTEGER:
364: rob = KpoInteger( coeffToInt(cp) );
365: return(rob);
366: break;
367:
368: case MP_INTEGER:
369: rob.tag = SuniversalNumber;
370: rob.lc.universalNumber = newUniversalNumber2((cp->val).bigp);
371: return(rob);
372: break;
373:
374: case POLY_COEFF:
375: rob = KpoPOLY((cp->val).f);
376: return(rob);
377: break;
378:
379: default:
380: return(rob);
381: }
382: }
383:
384:
385: struct object recursivePolyToPoly(struct object rp) {
386: struct object rob = NullObject;
387: POLY f;
388: errorKan1("%s\n","recursivePolyToPoly() has not yet been implemented. Use ascii parsing or sm1 macros to reconstruct a polynomial.");
389:
390: return(rob);
391: }
392:
393:
1.4 takayama 394: struct object KrvtReplace(struct object rp_o,struct object v_o, struct object t_o) {
395: /* rp_o : recursive polynomial.
1.5 takayama 396: v_o : variable name (indeterminate).
1.4 takayama 397: t_o : tree.
398: */
1.8 ! takayama 399: struct object rp = OINIT;
! 400: struct object vlist = OINIT;
! 401: struct object newvlist = OINIT;
! 402: struct object newrp = OINIT;
1.4 takayama 403: int i,m;
404: /* Check the data types. */
405: if (ectag(rp_o) != CLASSNAME_recursivePolynomial) {
1.5 takayama 406: errorKan1("%s\n","KrvtReplace() type mismatch in the first argument.");
1.4 takayama 407: }
408: if (ectag(v_o) != CLASSNAME_indeterminate) {
1.5 takayama 409: errorKan1("%s\n","KrvtReplace() type mismatch in the second argument.");
1.4 takayama 410: }
411: if (ectag(t_o) != CLASSNAME_tree) {
1.5 takayama 412: errorKan1("%s\n","KrvtReplace() type mismatch in the third argument.");
1.4 takayama 413: }
414:
415: rp = KopRecursivePolynomial(rp_o);
416: vlist = getoa(rp,0);
417: m = getoaSize(vlist);
418: newvlist = newObjectArray(m);
419: for (i=0; i<m; i++) {
1.5 takayama 420: if (KooEqualQ(getoa(vlist,i),KopIndeterminate(v_o))) {
421: /* should be KooEqualQ(getoa(vlist,i),v_o). It's not a bug.
422: Internal expression of vlist is an array of string
423: (not indetermiante). */
424: putoa(newvlist,i,t_o);
425: }else{
426: putoa(newvlist,i,getoa(vlist,i));
427: }
1.4 takayama 428: }
429: newrp = newObjectArray(getoaSize(rp));
430: m = getoaSize(rp);
431: putoa(newrp,0,newvlist);
432: for (i=1; i<m; i++) {
1.5 takayama 433: putoa(newrp,i,getoa(rp,i));
1.4 takayama 434: }
435: return(KpoRecursivePolynomial(newrp));
436: }
1.1 maekawa 437:
438:
1.4 takayama 439: struct object KreplaceRecursivePolynomial(struct object of,struct object rule) {
1.8 ! takayama 440: struct object rob = OINIT;
! 441: struct object f = OINIT;
1.4 takayama 442: int i;
443: int n;
1.8 ! takayama 444: struct object trule = OINIT;
1.4 takayama 445:
1.1 maekawa 446:
1.4 takayama 447: if (rule.tag != Sarray) {
448: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be array.");
449: }
450: n = getoaSize(rule);
451:
452: if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
453: }else{
454: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The first argument must be a recursive polynomial.");
455: }
456: f = of;
1.1 maekawa 457:
1.4 takayama 458: for (i=0; i<n; i++) {
459: trule = getoa(rule,i);
460: if (trule.tag != Sarray) {
461: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
462: }
463: if (getoaSize(trule) != 2) {
464: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
465: }
466:
467: if (ectag(getoa(trule,0)) != CLASSNAME_indeterminate) {
468: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
469: }
1.5 takayama 470: /* Do not check the second argument. */
471: /*
472: if (getoa(trule,1).tag != Spoly) {
1.4 takayama 473: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1.5 takayama 474: }
475: */
1.4 takayama 476:
477: }
478:
479: rob = f;
480: for (i=0; i<n; i++) {
481: trule = getoa(rule,i);
1.5 takayama 482: rob = KrvtReplace(rob,getoa(trule,0),getoa(trule,1));
1.4 takayama 483: }
484: return(rob);
485: }
1.1 maekawa 486:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>