Annotation of OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c, Revision 1.4
1.4 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/Kclass/indeterminate.c,v 1.3 2000/02/28 14:10:30 takayama Exp $ */
1.1 maekawa 2: /* Kclass/indeterminate.c */
3: /* This file handles indeterminate, tree, recursivePolynomial,
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) {
17: struct object rob;
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) {
33: struct object ob;
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:
46:
47: /* ---------------------------------------------------- */
48: /* Data conversion function : see KclassDataConversion*/
49: struct object KpoTree(struct object ob) {
50: struct object rob;
51: struct object ob1,ob2,ob3;
52: struct object *newobp;
53: rob.tag = Sclass;
54: rob.lc.ival = CLASSNAME_tree;
55: newobp = (struct object *) sGC_malloc(sizeof(struct object));
56: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
57: if (ob.tag != Sarray) {
58: errorKan1("%s\n","Kclass/indeterminate.c, only properly formatted list object can be transformed into tree. [name, cdname, arglist].");
59: }
60: if (getoaSize(ob) < 3) {
61: errorKan1("%s\n","Kclass/indeterminate.c, the length must 3 or more than 3. [name, cdname, arglist].");
62: }
63: ob1 = getoa(ob,0); ob2 = getoa(ob,1); ob3 = getoa(ob,2);
64: if (ob1.tag != Sdollar || ob2.tag != Sdollar || ob3.tag != Sarray) {
65: errorKan1("%s\n","Kclass/indeterminate.c, [string name, string cdname, list arglist].");
66: }
67: *newobp = ob;
68: rob.rc.voidp = newobp;
69: return(rob);
70: }
71:
72:
73: /* Printing function : see fprintClass */
74: void fprintTree(FILE *fp,struct object op)
75: {
76: printObject(KopTree(op),0,fp);
77: }
78:
79: int isTreeAdd(struct object ob) {
80: struct object name;
81: if (ob.tag != Sclass) {
82: return(0);
83: }
84: if (ectag(ob) != CLASSNAME_tree) {
85: return(0);
86: }
87: ob = KopTree(ob);
88: if (ob.tag != Sarray) {
89: errorKan1("%s\n","CLASSNAME_tree is broken. Should be array.");
90: }
91: name = getoa(ob,0);
92: if (name.tag != Sdollar) {
93: errorKan1("%s\n","CLASSNAME_tree is broken. Should be string.");
94: }
95: if (strcmp(KopString(name),"add") == 0) {
96: return(1);
97: }else{
98: return(0);
99: }
100: }
101:
102: struct object addTree(struct object ob1, struct object ob2)
103: {
104: struct object rob,aob;
105: struct object ob3,ob4;
106: int i;
107: if (isTreeAdd(ob1) && !isTreeAdd(ob2)) {
108: ob1 = KopTree(ob1);
109: ob3 = getoa(ob1,2);
110: aob = newObjectArray(getoaSize(ob3)+1);
111: for (i=0; i<getoaSize(ob3); i++) {
112: putoa(aob,i,getoa(ob3,i));
113: }
114: putoa(aob,getoaSize(ob3),ob2);
115: }else if (!isTreeAdd(ob1) && isTreeAdd(ob2)) {
116: ob2 = KopTree(ob2);
117: ob3 = getoa(ob2,2);
118: aob = newObjectArray(getoaSize(ob3)+1);
119: putoa(aob,0,ob1);
120: for (i=0; i<getoaSize(ob3); i++) {
121: putoa(aob,1+i,getoa(ob3,i));
122: }
123: }else if (isTreeAdd(ob1) && isTreeAdd(ob2)) {
124: ob1 = KopTree(ob1);
125: ob2 = KopTree(ob2);
126: ob3 = getoa(ob1,2);
127: ob4 = getoa(ob2,2);
128: aob = newObjectArray(getoaSize(ob3)+getoaSize(ob4));
129: for (i=0; i<getoaSize(ob3); i++) {
130: putoa(aob,i,getoa(ob3,i));
131: }
132: for (i=0; i<getoaSize(ob4); i++) {
133: putoa(aob,getoaSize(ob3)+i,getoa(ob4,i));
134: }
135: }else{
136: aob = newObjectArray(2);
137: putoa(aob,0,ob1);
138: putoa(aob,1,ob2);
139: }
140: rob = newObjectArray(3);
141: putoa(rob,0,KpoString("add"));
1.3 takayama 142: putoa(rob,1,KpoString("basic"));
1.1 maekawa 143: putoa(rob,2,aob);
144: return(KpoTree(rob));
145: }
146:
147:
148: /*------------------------------------------*/
149:
150: struct object KpoRecursivePolynomial(struct object ob) {
151: struct object rob;
152: struct object *newobp;
153: rob.tag = Sclass;
154: rob.lc.ival = CLASSNAME_recursivePolynomial;
155: newobp = (struct object *) sGC_malloc(sizeof(struct object));
156: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
157: if (ob.tag != Sarray) {
158: errorKan1("%s\n","Kclass/indeterminate.c, only array object can be transformed into recusivePolynomial.");
159: }
160: *newobp = ob;
161: rob.rc.voidp = newobp;
162: return(rob);
163: }
164:
165: static void printBodyOfRecursivePolynomial(struct object body,
166: struct object vlist, FILE *fp)
167: {
168: int i,j;
169: int k;
170: if (ectag(body) != CLASSNAME_polynomialInOneVariable) {
171: printObject(body,0,fp);
172: return;
173: }
174: body = KopPolynomialInOneVariable(body);
175: if (body.tag != Sarray) {
176: errorKan1("%s\n","Kclass/indeterminate.c, format error for recursive polynomial.");
177: }
178: if (getoaSize(body) == 0) {
179: errorKan1("%s\n","printBodyOfRecursivePolynomial: format error for a recursive polynomial.");
180: }
181: i = KopInteger(getoa(body,0));
182: for (j=1; j<getoaSize(body); j = j+2) {
183: k = KopInteger(getoa(body,j));
184: if (k != 0) {
1.4 ! takayama 185: if (getoa(vlist,i).tag == Sdollar) {
! 186: fprintf(fp,"%s",KopString(getoa(vlist,i)));
! 187: }else if (ectag(getoa(vlist,i)) == CLASSNAME_tree) {
! 188: fprintClass(fp,getoa(vlist,i));
! 189: }else{
! 190: errorKan1("%s\n","printBodyOfRecursivePolynomial: format error.");
! 191: }
1.1 maekawa 192: if (k > 1) {
193: fprintf(fp,"^%d ",k);
194: }else if (k == 1) {
195: }else{
196: fprintf(fp,"^(%d) ",k);
197: }
198: fprintf(fp," * ");
199: }
200: fprintf(fp,"(");
201: printBodyOfRecursivePolynomial(getoa(body,j+1),vlist,fp);
202: fprintf(fp,")");
203: if (j != getoaSize(body)-2) {
204: fprintf(fp," + ");
205: }
206: }
207: return;
208: }
209:
210: void fprintRecursivePolynomial(FILE *fp,struct object op)
211: {
212: /* old code
213: printObject(KopRecursivePolynomial(op),0,fp); return;
214: */
215: struct object ob;
216: struct object vlist;
217: struct object body;
218: ob = KopRecursivePolynomial(op);
219: if (ob.tag != Sarray) {
220: printObject(ob,0,fp); return;
221: }
222: if (!isRecursivePolynomial2(op)) {
223: printObject(KopRecursivePolynomial(op),0,fp); return;
224: }
225: vlist = getoa(ob,0);
226: body = getoa(ob,1);
227: printBodyOfRecursivePolynomial(body,vlist,fp);
228: return;
229: }
230:
231: /*------------------------------------------*/
232:
233: struct object KpoPolynomialInOneVariable(struct object ob) {
234: struct object rob;
235: struct object *newobp;
236: rob.tag = Sclass;
237: rob.lc.ival = CLASSNAME_polynomialInOneVariable;
238: newobp = (struct object *) sGC_malloc(sizeof(struct object));
239: if (newobp == NULL) errorKan1("%s\n","Kclass/indeterminate.c, no more memory.");
240: if (ob.tag != Sarray) {
241: errorKan1("%s\n","Kclass/indeterminate.c, only array object can be transformed into polynomialInOneVariable.");
242: }
243: *newobp = ob;
244: rob.rc.voidp = newobp;
245: return(rob);
246: }
247:
248: void fprintPolynomialInOneVariable(FILE *fp,struct object op)
249: {
250: printObject(KopPolynomialInOneVariable(op),0,fp);
251: }
252:
253: struct object polyToRecursivePoly(struct object p) {
254: struct object rob = NullObject;
255: int vx[N0], vd[N0];
256: int i,j,k,n,count;
257: POLY f;
258: struct object vlist,vlist2;
259: struct object ob1,ob2,ob3,ob4;
260: int vn;
261:
262: if (p.tag != Spoly) return(rob);
263: f = KopPOLY(p);
264: if (f == ZERO) {
265: rob = p; return(rob);
266: }
267: /* construct list of variables. */
268: for (i=0; i<N0; i++) {
269: vx[i] = vd[i] = 0;
270: }
271: n = f->m->ringp->n; count = 0;
272: for (i=0; i<n; i++) {
273: if (pDegreeWrtV(f,cxx(1,i,1,f->m->ringp))) {
274: vx[i] = 1; count++;
275: }
276: if (pDegreeWrtV(f,cdd(1,i,1,f->m->ringp))) {
277: vd[i] = 1; count++;
278: }
279: }
280: vlist = newObjectArray(count); k = 0;
281: vlist2 = newObjectArray(count); k = 0;
282: for (i=0; i<n; i++) {
283: if (vd[i]) {
284: putoa(vlist,k,KpoPOLY(cdd(1,i,1,f->m->ringp)));
285: putoa(vlist2,k,KpoString(POLYToString(cdd(1,i,1,f->m->ringp),'*',0)));
286: k++;
287: }
288: }
289: for (i=0; i<n; i++) {
290: if (vx[i]) {
291: putoa(vlist,k,KpoPOLY(cxx(1,i,1,f->m->ringp)));
292: putoa(vlist2,k,KpoString(POLYToString(cxx(1,i,1,f->m->ringp),'*',0)));
293: k++;
294: }
295: }
296: /* printObject(vlist,1,stdout); */
297: if (getoaSize(vlist) == 0) {
298: vn = -1;
299: }else{
300: vn = 0;
301: }
302: ob1 = polyToRecursivePoly2(p,vlist,vn);
303: rob = newObjectArray(2);
304: putoa(rob,0,vlist2); putoa(rob,1,ob1);
305: /* format of rob
306: [ list of variables, poly or universalNumber or yyy to express
307: a recursive polynomial. ]
308: format of yyy = CLASSNAME_polynomialInOneVariable
309: [Sinteger, Sinteger, coeff obj, Sinteger, coeff obj, .....]
310: name of var, exp, coeff, exp, coeff
311: This format is checked by isRecursivePolynomial2().
312: */
313: rob = KpoRecursivePolynomial(rob);
314: if (isRecursivePolynomial2(rob)) {
315: return(rob);
316: }else{
317: errorKan1("%s\n","polyToRecursivePolynomial could not translate this object.");
318: }
319: }
320:
321: static void objectFormatError_ind0(char *s) {
322: char tmp[1024];
323: sprintf(tmp,"polyToRecursivePoly2: object format error for the variable %s",s);
324: errorKan1("%s\n",tmp);
325: }
326:
327: struct object polyToRecursivePoly2(struct object p,struct object vlist, int vn) {
328: struct object rob = NullObject;
329: POLY f;
330: POLY vv;
331: struct object v;
332: struct object c;
333: struct object e;
334: int i;
335:
336:
337: if (p.tag != Spoly) return(rob);
338: f = KopPOLY(p);
339: if (f == ZERO) {
340: rob = p; return(rob);
341: }
342: if (vn < 0 || vn >= getoaSize(vlist)) {
343: return(coeffToObject(f->coeffp));
344: }
345: v = getoa(vlist,vn);
346: if (v.tag != Spoly) objectFormatError_ind0("v");
347: vv = KopPOLY(v);
348: c = parts2(f,vv);
349: e = getoa(c,0); /* exponents. Array of integer. */
350: if (e.tag != Sarray) objectFormatError_ind0("e");
351: c = getoa(c,1); /* coefficients. Array of POLY. */
352: if (c.tag != Sarray) objectFormatError_ind0("c");
353: rob = newObjectArray(getoaSize(e)*2+1);
354:
355: putoa(rob,0,KpoInteger(vn)); /* put the variable number. */
356: for (i=0; i < getoaSize(e); i++) {
357: putoa(rob,1+i*2, getoa(e,i));
358: putoa(rob,1+i*2+1, polyToRecursivePoly2(getoa(c,i),vlist,vn+1));
359: }
360: /* printObject(rob,0,stderr); */
361: return(KpoPolynomialInOneVariable(rob));
362: }
363:
364: static int isRecursivePolynomial2a(struct object ob2, int n) {
365: char *s = "Format error (isRecursivePolynomial2a) : ";
366: struct object tmp;
367: int i;
368: if (ectag(ob2) == CLASSNAME_polynomialInOneVariable) {
369: ob2 = KopPolynomialInOneVariable(ob2);
370: }else if (ob2.tag == Sarray) {
371: fprintf(stderr,"isRecursivePolynomial2, argument is an array.\n");
372: printObject(ob2,0,stderr);
373: fprintf(stderr,"\n");
374: return(0); /* Array must be an error, but other objects are OK. */
375: }else {
376: return(1);
377: }
378: if (ob2.tag != Sarray) {
379: return(1);
380: /* coeff can be any. */
381: }
382: if (getoaSize(ob2) % 2 == 0) {
383: fprintf(stderr,"%s list body. The size of body must be odd.\n",s); printObject(ob2,1,stderr);
384: return(0);
385: }
386: tmp = getoa(ob2,0);
387: if (tmp.tag != Sinteger) {
388: fprintf(stderr,"%s list body. body[0] must be integer.\n",s); printObject(ob2,1,stderr);
389: return(0);
390: }
391: if (KopInteger(tmp) < 0 || KopInteger(tmp) >= n) {
392: fprintf(stderr,"%s list body. body[0] must be integer between 0 and the size of vlist -1.\n",s); printObject(ob2,1,stderr);
393: return(0);
394: }
395: for (i=1; i<getoaSize(ob2); i = i+2) {
396: tmp = getoa(ob2,i);
397: if (tmp.tag != Sinteger) {
398: fprintf(stderr,"%s [list vlist, list body]. body[%d] must be integer.\n",s,i);
399: printObject(ob2,1,stderr);
400: return(0);
401: }
402: }
403: for (i=2; i<getoaSize(ob2); i = i+2) {
404: tmp = getoa(ob2,i);
405: if (ectag(tmp) == CLASSNAME_polynomialInOneVariable) {
406: if (isRecursivePolynomial2a(tmp,n)) {
407: }else{
408: fprintf(stderr,"isRecursivePolynomial2a: entry is not a polynomial in one variable.\n");
409: printObject(tmp,0,stderr); fprintf(stderr,"\n");
410: return(0);
411: }
412: }
413: }
414: return(1);
415: }
416:
417: int isRecursivePolynomial2(struct object ob) {
418: /* This checks only the top level */
419: char *s = "Format error (isRecursivePolynomial2) : ";
420: struct object ob1, ob2,tmp;
421: int i;
422: int n;
423: if (ob.tag != Sclass) return(0);
424: if (ectag(ob) != CLASSNAME_recursivePolynomial) return(0);
425: ob = KopRecursivePolynomial(ob);
426: if (ob.tag != Sarray) {
427: fprintf(stderr,"%s [vlist, body]\n",s); printObject(ob,1,stderr);
428: return(0);
429: }
430: if (getoaSize(ob) != 2) {
431: fprintf(stderr,"%s [vlist, body]. The length must be 2. \n",s);
432: printObject(ob,1,stderr);
433: return(0);
434: }
435: ob1 = getoa(ob,0);
436: ob2 = getoa(ob,1);
437: if (ob1.tag != Sarray) {
438: fprintf(stderr,"%s [list vlist, body].\n",s); printObject(ob,1,stderr);
439: return(0);
440: }
441: n = getoaSize(ob1);
442: for (i=0; i<n; i++) {
443: tmp = getoa(ob1,i);
1.4 ! takayama 444: if (tmp.tag == Sdollar) {
! 445: }else if (ectag(tmp) == CLASSNAME_tree) {
! 446: }else{
! 447: 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 448: return(0);
449: }
450: }
451: return(isRecursivePolynomial2a(ob2,n));
452: }
453:
454:
455: struct object coeffToObject(struct coeff *cp) {
456: struct object rob = NullObject;
457: switch(cp->tag) {
458: case INTEGER:
459: rob = KpoInteger( coeffToInt(cp) );
460: return(rob);
461: break;
462:
463: case MP_INTEGER:
464: rob.tag = SuniversalNumber;
465: rob.lc.universalNumber = newUniversalNumber2((cp->val).bigp);
466: return(rob);
467: break;
468:
469: case POLY_COEFF:
470: rob = KpoPOLY((cp->val).f);
471: return(rob);
472: break;
473:
474: default:
475: return(rob);
476: }
477: }
478:
479:
480: struct object recursivePolyToPoly(struct object rp) {
481: struct object rob = NullObject;
482: POLY f;
483: errorKan1("%s\n","recursivePolyToPoly() has not yet been implemented. Use ascii parsing or sm1 macros to reconstruct a polynomial.");
484:
485: return(rob);
486: }
487:
488:
1.4 ! takayama 489: struct object KrvtReplace(struct object rp_o,struct object v_o, struct object t_o) {
! 490: /* rp_o : recursive polynomial.
! 491: v_o : variable name (indeterminate).
! 492: t_o : tree.
! 493: */
! 494: struct object rp, vlist, newvlist, newrp;
! 495: int i,m;
! 496: /* Check the data types. */
! 497: if (ectag(rp_o) != CLASSNAME_recursivePolynomial) {
! 498: errorKan1("%s\n","KrvtReplace() type mismatch in the first argument.");
! 499: }
! 500: if (ectag(v_o) != CLASSNAME_indeterminate) {
! 501: errorKan1("%s\n","KrvtReplace() type mismatch in the second argument.");
! 502: }
! 503: if (ectag(t_o) != CLASSNAME_tree) {
! 504: errorKan1("%s\n","KrvtReplace() type mismatch in the third argument.");
! 505: }
! 506:
! 507: rp = KopRecursivePolynomial(rp_o);
! 508: vlist = getoa(rp,0);
! 509: m = getoaSize(vlist);
! 510: newvlist = newObjectArray(m);
! 511: for (i=0; i<m; i++) {
! 512: if (KooEqualQ(getoa(vlist,i),KopIndeterminate(v_o))) {
! 513: /* should be KooEqualQ(getoa(vlist,i),v_o). It's not a bug.
! 514: Internal expression of vlist is an array of string
! 515: (not indetermiante). */
! 516: putoa(newvlist,i,t_o);
! 517: }else{
! 518: putoa(newvlist,i,getoa(vlist,i));
! 519: }
! 520: }
! 521: newrp = newObjectArray(getoaSize(rp));
! 522: m = getoaSize(rp);
! 523: putoa(newrp,0,newvlist);
! 524: for (i=1; i<m; i++) {
! 525: putoa(newrp,i,getoa(rp,i));
! 526: }
! 527: return(KpoRecursivePolynomial(newrp));
! 528: }
1.1 maekawa 529:
530:
1.4 ! takayama 531: struct object KreplaceRecursivePolynomial(struct object of,struct object rule) {
! 532: struct object rob,f;
! 533: int i;
! 534: int n;
! 535: struct object trule;
! 536:
1.1 maekawa 537:
1.4 ! takayama 538: if (rule.tag != Sarray) {
! 539: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be array.");
! 540: }
! 541: n = getoaSize(rule);
! 542:
! 543: if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
! 544: }else{
! 545: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The first argument must be a recursive polynomial.");
! 546: }
! 547: f = of;
1.1 maekawa 548:
1.4 ! takayama 549: for (i=0; i<n; i++) {
! 550: trule = getoa(rule,i);
! 551: if (trule.tag != Sarray) {
! 552: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
! 553: }
! 554: if (getoaSize(trule) != 2) {
! 555: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....].");
! 556: }
! 557:
! 558: if (ectag(getoa(trule,0)) != CLASSNAME_indeterminate) {
! 559: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
! 560: }
! 561: /* Do not check the second argument. */
! 562: /*
! 563: if (getoa(trule,1).tag != Spoly) {
! 564: errorKan1("%s\n"," KreplaceRecursivePolynomial(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
! 565: }
! 566: */
! 567:
! 568: }
! 569:
! 570: rob = f;
! 571: for (i=0; i<n; i++) {
! 572: trule = getoa(rule,i);
! 573: rob = KrvtReplace(rob,getoa(trule,0),getoa(trule,1));
! 574: }
! 575: return(rob);
! 576: }
1.1 maekawa 577:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to indeterminate.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan / Kclass