Annotation of OpenXM/src/kan96xx/Kan/kanExport0.c, Revision 1.17
1.17 ! takayama 1: /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.16 2003/08/20 01:39:17 takayama Exp $ */
1.1 maekawa 2: #include <stdio.h>
3: #include "datatype.h"
4: #include "stackm.h"
5: #include "extern.h"
6: #include "extern2.h"
7: #include "lookup.h"
8: #include "matrix.h"
9: #include "gradedset.h"
10: #include "kclass.h"
11:
12: #define universalToPoly(un,rp) (isZero(un)?ZERO:coeffToPoly(un,rp))
13:
14: static void checkDuplicateName(char *xvars[],char *dvars[],int n);
15:
16: static void yet() { fprintf(stderr,"Not implemented."); }
17:
18: int SerialCurrent = -1; /* Current Serial number of the recieved packet as server. */
19:
20: int ReverseOutputOrder = 1;
21: int WarningNoVectorVariable = 1;
22:
23: /** :arithmetic **/
24: struct object KooAdd(ob1,ob2)
1.7 takayama 25: struct object ob1,ob2;
1.1 maekawa 26: {
27: extern struct ring *CurrentRingp;
28: struct object rob = NullObject;
29: POLY r;
30: int s,i;
31: objectp f1,f2,g1,g2;
32: struct object nn,dd;
33:
34: switch (Lookup[ob1.tag][ob2.tag]) {
35: case SintegerSinteger:
36: return(KpoInteger(ob1.lc.ival + ob2.lc.ival));
37: break;
38: case SpolySpoly:
39: r = ppAdd(ob1.lc.poly,ob2.lc.poly);
40: rob.tag = Spoly; rob.lc.poly = r;
41: return(rob);
42: break;
43: case SarraySarray:
44: s = getoaSize(ob1);
45: if (s != getoaSize(ob2)) {
46: errorKan1("%s\n","Two arrays must have a same size.");
47: }
48: rob = newObjectArray(s);
49: for (i=0; i<s; i++) {
50: putoa(rob,i,KooAdd(getoa(ob1,i),getoa(ob2,i)));
51: }
52: return(rob);
53: break;
54: case SuniversalNumberSuniversalNumber:
55: rob.tag = SuniversalNumber;
56: rob.lc.universalNumber = newUniversalNumber(0);
57: Cadd(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
58: return(rob);
59: break;
60: case SuniversalNumberSpoly:
61: rob.tag = Spoly;
62: r = ob2.lc.poly;
63: if (r ISZERO) {
64: /*warningKan("KooAdd(universalNumber,0 polynomial) cannot determine the ring for the result. Assume the current ring.");
65: rob.lc.poly = universalToPoly(ob1.lc.universalNumber,CurrentRingp);*/
66: rob = ob1;
67: return(rob); /* returns universal number. */
68: }
69: rob.lc.poly = ppAdd(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
70: return(rob);
71: break;
72: case SpolySuniversalNumber:
73: return(KooAdd(ob2,ob1));
74: break;
75: case SuniversalNumberSinteger:
76: rob.tag = SuniversalNumber;
77: rob.lc.universalNumber = newUniversalNumber(0);
78: nn.tag = SuniversalNumber;
79: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
80: Cadd(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
81: return(rob);
82: break;
83: case SintegerSuniversalNumber:
84: rob.tag = SuniversalNumber;
85: rob.lc.universalNumber = newUniversalNumber(0);
86: nn.tag = SuniversalNumber;
87: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
88: Cadd(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
89: return(rob);
90: break;
91:
92: case SrationalFunctionSrationalFunction:
93: f1 = Knumerator(ob1);
94: f2 = Kdenominator(ob1);
95: g1 = Knumerator(ob2);
96: g2 = Kdenominator(ob2);
97: nn = KooAdd(KooMult(*g2,*f1),KooMult(*f2,*g1));
98: dd = KooMult(*f2,*g2);
99: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
100: KisInvalidRational(&rob);
101: return(rob);
102: break;
103: case SpolySrationalFunction: /* f1 + g1/g2 = (g2 f1 + g1)/g2 */
104: case SuniversalNumberSrationalFunction:
105: g1 = Knumerator(ob2);
106: g2 = Kdenominator(ob2);
107: nn = KooAdd(KooMult(*g2,ob1),*g1);
108: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
109: KisInvalidRational(&rob);
110: return(rob);
111: break;
112: case SrationalFunctionSpoly:
113: case SrationalFunctionSuniversalNumber:
114: return(KooAdd(ob2,ob1));
115: break;
116: case SdoubleSdouble:
117: return(KpoDouble( KopDouble(ob1) + KopDouble(ob2) ));
118: break;
119: case SdoubleSinteger:
120: case SdoubleSuniversalNumber:
121: case SdoubleSrationalFunction:
122: return(KpoDouble( KopDouble(ob1) + toDouble0(ob2) ) );
123: break;
124: case SintegerSdouble:
125: case SuniversalNumberSdouble:
126: case SrationalFunctionSdouble:
127: return(KpoDouble( toDouble0(ob1) + KopDouble(ob2) ) );
128: break;
129: case SclassSclass:
130: case SclassSinteger:
131: case SclassSpoly:
132: case SclassSuniversalNumber:
133: case SclassSrationalFunction:
134: case SclassSdouble:
135: case SpolySclass:
136: case SintegerSclass:
137: case SuniversalNumberSclass:
138: case SrationalFunctionSclass:
139: case SdoubleSclass:
140: return(Kclass_ooAdd(ob1,ob2));
141: break;
142:
143:
144: default:
145: warningKan("KooAdd() has not supported yet these objects.\n");
146: break;
147: }
148: return(rob);
149: }
150:
151: struct object KooSub(ob1,ob2)
1.7 takayama 152: struct object ob1,ob2;
1.1 maekawa 153: {
154: struct object rob = NullObject;
155: POLY r;
156: int s,i;
157: objectp f1,f2,g1,g2;
158: extern struct coeff *UniversalZero;
159: struct object nn,dd;
160:
161: switch (Lookup[ob1.tag][ob2.tag]) {
162: case SintegerSinteger:
163: return(KpoInteger(ob1.lc.ival - ob2.lc.ival));
164: break;
165: case SpolySpoly:
166: r = ppSub(ob1.lc.poly,ob2.lc.poly);
167: rob.tag = Spoly; rob.lc.poly = r;
168: return(rob);
169: break;
170: case SarraySarray:
171: s = getoaSize(ob1);
172: if (s != getoaSize(ob2)) {
173: errorKan1("%s\n","Two arrays must have a same size.");
174: }
175: rob = newObjectArray(s);
176: for (i=0; i<s; i++) {
177: putoa(rob,i,KooSub(getoa(ob1,i),getoa(ob2,i)));
178: }
179: return(rob);
180: break;
181: case SuniversalNumberSuniversalNumber:
182: rob.tag = SuniversalNumber;
183: rob.lc.universalNumber = newUniversalNumber(0);
184: Csub(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
185: return(rob);
186: break;
187:
188: case SuniversalNumberSpoly:
189: rob.tag = Spoly;
190: r = ob2.lc.poly;
191: if (r ISZERO) {
192: rob = ob1;
193: return(rob); /* returns universal number. */
194: }
195: rob.lc.poly = ppSub(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
196: return(rob);
197: break;
198: case SpolySuniversalNumber:
199: rob.tag = Spoly;
200: r = ob1.lc.poly;
201: if (r ISZERO) {
202: rob.tag = SuniversalNumber;
203: rob.lc.universalNumber = newUniversalNumber(0);
204: Csub(rob.lc.universalNumber,UniversalZero,ob2.lc.universalNumber);
205: return(rob); /* returns universal number. */
206: }
207: rob.lc.poly = ppSub(r,universalToPoly(ob2.lc.universalNumber,r->m->ringp));
208: return(rob);
209: break;
210:
211: case SuniversalNumberSinteger:
212: rob.tag = SuniversalNumber;
213: rob.lc.universalNumber = newUniversalNumber(0);
214: nn.tag = SuniversalNumber;
215: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
216: Csub(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
217: return(rob);
218: break;
219: case SintegerSuniversalNumber:
220: rob.tag = SuniversalNumber;
221: rob.lc.universalNumber = newUniversalNumber(0);
222: nn.tag = SuniversalNumber;
223: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
224: Csub(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
225: return(rob);
226: break;
227:
228: case SrationalFunctionSrationalFunction:
229: f1 = Knumerator(ob1);
230: f2 = Kdenominator(ob1);
231: g1 = Knumerator(ob2);
232: g2 = Kdenominator(ob2);
233: nn = KooSub(KooMult(*g2,*f1),KooMult(*f2,*g1));
234: dd = KooMult(*f2,*g2);
235: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
236: KisInvalidRational(&rob);
237: return(rob);
238: break;
239: case SpolySrationalFunction: /* f1 - g1/g2 = (g2 f1 - g1)/g2 */
240: case SuniversalNumberSrationalFunction:
241: g1 = Knumerator(ob2);
242: g2 = Kdenominator(ob2);
243: nn = KooSub(KooMult(*g2,ob1),*g1);
244: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
245: KisInvalidRational(&rob);
246: return(rob);
247: break;
248: case SrationalFunctionSpoly:
249: case SrationalFunctionSuniversalNumber: /* f1/f2 - ob2= (f1 - f2*ob2)/f2 */
250: f1 = Knumerator(ob1);
251: f2 = Kdenominator(ob1);
252: nn = KooSub(*f1,KooMult(*f2,ob2));
253: rob = KnewRationalFunction0(copyObjectp(&nn),f2);
254: KisInvalidRational(&rob);
255: return(rob);
256: break;
257:
258: case SdoubleSdouble:
259: return(KpoDouble( KopDouble(ob1) - KopDouble(ob2) ));
260: break;
261: case SdoubleSinteger:
262: case SdoubleSuniversalNumber:
263: case SdoubleSrationalFunction:
264: return(KpoDouble( KopDouble(ob1) - toDouble0(ob2) ) );
265: break;
266: case SintegerSdouble:
267: case SuniversalNumberSdouble:
268: case SrationalFunctionSdouble:
269: return(KpoDouble( toDouble0(ob1) - KopDouble(ob2) ) );
270: break;
271:
272: default:
273: warningKan("KooSub() has not supported yet these objects.\n");
274: break;
275: }
276: return(rob);
277: }
278:
279: struct object KooMult(ob1,ob2)
1.7 takayama 280: struct object ob1,ob2;
1.1 maekawa 281: {
282: struct object rob = NullObject;
283: POLY r;
284: int i,s;
285: objectp f1,f2,g1,g2;
286: struct object dd,nn;
287:
288:
289: switch (Lookup[ob1.tag][ob2.tag]) {
290: case SintegerSinteger:
291: return(KpoInteger(ob1.lc.ival * ob2.lc.ival));
292: break;
293: case SpolySpoly:
294: r = ppMult(ob1.lc.poly,ob2.lc.poly);
295: rob.tag = Spoly; rob.lc.poly = r;
296: return(rob);
297: break;
298: case SarraySarray:
299: return(KaoMult(ob1,ob2));
300: break;
301: case SpolySarray:
302: case SuniversalNumberSarray:
303: case SrationalFunctionSarray:
304: case SintegerSarray:
305: s = getoaSize(ob2);
306: rob = newObjectArray(s);
307: for (i=0; i<s; i++) {
308: putoa(rob,i,KooMult(ob1,getoa(ob2,i)));
309: }
310: return(rob);
311: break;
312:
313: case SarraySpoly:
314: case SarraySuniversalNumber:
315: case SarraySrationalFunction:
316: case SarraySinteger:
317: s = getoaSize(ob1);
318: rob = newObjectArray(s);
319: for (i=0; i<s; i++) {
320: putoa(rob,i,KooMult(getoa(ob1,i),ob2));
321: }
322: return(rob);
323: break;
324:
325:
326: case SuniversalNumberSuniversalNumber:
327: rob.tag = SuniversalNumber;
328: rob.lc.universalNumber = newUniversalNumber(0);
329: Cmult(rob.lc.universalNumber,ob1.lc.universalNumber,ob2.lc.universalNumber);
330: return(rob);
331: break;
332:
333: case SuniversalNumberSpoly:
334: r = ob2.lc.poly;
335: if (r ISZERO) {
336: rob.tag = SuniversalNumber;
337: rob.lc.universalNumber = newUniversalNumber(0);
338: return(rob); /* returns universal number. */
339: }
340: if (isZero(ob1.lc.universalNumber)) {
341: rob.tag = Spoly;
342: rob.lc.poly = ZERO;
343: return(rob);
344: }
345: rob.tag = Spoly;
346: rob.lc.poly = ppMult(universalToPoly(ob1.lc.universalNumber,r->m->ringp),r);
347: return(rob);
348: break;
349: case SpolySuniversalNumber:
350: return(KooMult(ob2,ob1));
351: break;
352:
353: case SuniversalNumberSinteger:
354: rob.tag = SuniversalNumber;
355: rob.lc.universalNumber = newUniversalNumber(0);
356: nn.tag = SuniversalNumber;
357: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob2));
358: Cmult(rob.lc.universalNumber,ob1.lc.universalNumber,nn.lc.universalNumber);
359: return(rob);
360: break;
361: case SintegerSuniversalNumber:
362: rob.tag = SuniversalNumber;
363: rob.lc.universalNumber = newUniversalNumber(0);
364: nn.tag = SuniversalNumber;
365: nn.lc.universalNumber = newUniversalNumber(KopInteger(ob1));
366: Cmult(rob.lc.universalNumber,nn.lc.universalNumber,ob2.lc.universalNumber);
367: return(rob);
368: break;
369:
370: case SrationalFunctionSrationalFunction:
371: f1 = Knumerator(ob1);
372: f2 = Kdenominator(ob1);
373: g1 = Knumerator(ob2);
374: g2 = Kdenominator(ob2);
375: nn = KooMult(*f1,*g1);
376: dd = KooMult(*f2,*g2);
377: rob = KnewRationalFunction0(copyObjectp(&nn),copyObjectp(&dd));
378: KisInvalidRational(&rob);
379: return(rob);
380: break;
381: case SpolySrationalFunction: /* ob1 g1/g2 */
382: case SuniversalNumberSrationalFunction:
383: g1 = Knumerator(ob2);
384: g2 = Kdenominator(ob2);
385: nn = KooMult(ob1,*g1);
386: rob = KnewRationalFunction0(copyObjectp(&nn),g2);
387: KisInvalidRational(&rob);
388: return(rob);
389: break;
390: case SrationalFunctionSpoly:
391: case SrationalFunctionSuniversalNumber: /* f1*ob2/f2 */
392: f1 = Knumerator(ob1);
393: f2 = Kdenominator(ob1);
394: nn = KooMult(*f1,ob2);
395: rob = KnewRationalFunction0(copyObjectp(&nn),f2);
396: KisInvalidRational(&rob);
397: return(rob);
398: break;
399:
400: case SdoubleSdouble:
401: return(KpoDouble( KopDouble(ob1) * KopDouble(ob2) ));
402: break;
403: case SdoubleSinteger:
404: case SdoubleSuniversalNumber:
405: case SdoubleSrationalFunction:
406: return(KpoDouble( KopDouble(ob1) * toDouble0(ob2) ) );
407: break;
408: case SintegerSdouble:
409: case SuniversalNumberSdouble:
410: case SrationalFunctionSdouble:
411: return(KpoDouble( toDouble0(ob1) * KopDouble(ob2) ) );
412: break;
413:
414: default:
415: warningKan("KooMult() has not supported yet these objects.\n");
416: break;
417: }
418: return(rob);
419: }
420:
421:
422:
423: struct object KoNegate(obj)
1.7 takayama 424: struct object obj;
1.1 maekawa 425: {
426: struct object rob = NullObject;
427: extern struct ring SmallRing;
428: struct object tob;
429: switch(obj.tag) {
430: case Sinteger:
431: rob = obj;
432: rob.lc.ival = -rob.lc.ival;
433: break;
434: case Spoly:
435: rob.tag = Spoly;
436: rob.lc.poly = ppSub(ZERO,obj.lc.poly);
437: break;
438: case SuniversalNumber:
439: rob.tag = SuniversalNumber;
440: rob.lc.universalNumber = coeffNeg(obj.lc.universalNumber,&SmallRing);
441: break;
442: case SrationalFunction:
443: rob.tag = SrationalFunction;
444: tob = KoNegate(*(Knumerator(obj)));
445: Knumerator(rob) = copyObjectp( &tob);
446: Kdenominator(rob) = Kdenominator(obj);
447: break;
448:
449: case Sdouble:
450: rob = KpoDouble( - toDouble0(obj) );
451: break;
452:
453: default:
454: warningKan("KoNegate() has not supported yet these objects.\n");
455: break;
456: }
457: return(rob);
458: }
459:
460: struct object KoInverse(obj)
1.7 takayama 461: struct object obj;
1.1 maekawa 462: {
463: struct object rob = NullObject;
464: extern struct coeff *UniversalOne;
465: objectp onep;
466: struct object tob;
467: switch(obj.tag) {
468: case Spoly:
469: tob.tag = SuniversalNumber;
470: tob.lc.universalNumber = UniversalOne;
471: onep = copyObjectp(& tob);
472: rob = KnewRationalFunction0(onep,copyObjectp(&obj));
473: KisInvalidRational(&rob);
474: break;
475: case SuniversalNumber:
476: tob.tag = SuniversalNumber;
477: tob.lc.universalNumber = UniversalOne;
478: onep = copyObjectp(& tob);
479: rob = KnewRationalFunction0(onep,copyObjectp(&obj));
480: KisInvalidRational(&rob);
481: break;
482: case SrationalFunction:
483: rob = obj;
484: Knumerator(rob) = Kdenominator(obj);
485: Kdenominator(rob) = Knumerator(obj);
486: KisInvalidRational(&rob);
487: break;
488: default:
489: warningKan("KoInverse() has not supported yet these objects.\n");
490: break;
491: }
492: return(rob);
493: }
494:
495:
496: static int isVector(ob)
1.7 takayama 497: struct object ob;
1.1 maekawa 498: {
499: int i,n;
500: n = getoaSize(ob);
501: for (i=0; i<n; i++) {
502: if (getoa(ob,i).tag == Sarray) return(0);
503: }
504: return(1);
505: }
506:
507: static int isMatrix(ob,m,n)
1.7 takayama 508: struct object ob;
509: int m,n;
1.1 maekawa 510: {
511: int i,j;
512: for (i=0; i<m; i++) {
513: if (getoa(ob,i).tag != Sarray) return(0);
514: if (getoaSize(getoa(ob,i)) != n) return(0);
515: for (j=0; j<n; j++) {
516: if (getoa(getoa(ob,i),j).tag != Spoly) return(-1);
517: }
518: }
519: return(1);
520: }
521:
522:
523: struct object KaoMult(aa,bb)
1.7 takayama 524: struct object aa,bb;
525: /* aa and bb is assumed to be array. */
1.1 maekawa 526: {
527: int m,n,m2,n2;
528: int i,j,k;
529: POLY tmp;
530: POLY fik;
531: POLY gkj;
532: struct object rob;
533: int r1,r2;
534: int rsize;
535: struct object tob;
536: struct object ob1;
537: extern struct ring SmallRing;
538:
539: m = getoaSize(aa); m2 = getoaSize(bb);
540: if (m == 0 || m2 == 0) errorKan1("%s\n","KaoMult(). Invalid matrix size.");
541:
542: /* new code for vector x vector,... etc */
543: r1 = isVector(aa); r2 = isVector(bb);
544: if (r1 && r2 ) { /* vector X vector ---> scalar.*/
545: rsize = getoaSize(aa);
546: if (rsize != getoaSize(bb)) {
547: errorKan1("%s\n","KaoMult(vector,vector). The size of the vectors must be the same.");
548: }
549: if (r1 != 0) {
550: ob1 = getoa(aa,0);
551: if (ob1.tag == Spoly) {
1.7 takayama 552: rob.tag = Spoly; rob.lc.poly = ZERO;
1.1 maekawa 553: }else if (ob1.tag == Sinteger) {
1.7 takayama 554: rob.tag = Sinteger; rob.lc.ival = 0;
1.1 maekawa 555: }else {
1.7 takayama 556: rob.tag = SuniversalNumber;
557: rob.lc.universalNumber = intToCoeff(0,&SmallRing);
1.1 maekawa 558: }
559: }else{
560: rob.tag = Spoly; rob.lc.poly = ZERO;
561: }
562: for (i=0; i<rsize; i++) {
563: rob = KooAdd(rob,KooMult(getoa(aa,i),getoa(bb,i)));
564: }
565: return(rob);
566: } else if (r1 == 0 && r2 ) { /* matrix X vector ---> vector */
1.7 takayama 567: /* (m n) (m2=n) */
1.1 maekawa 568: n = getoaSize(getoa(aa,0));
569: if (isMatrix(aa,m,n) == 0) {
570: errorKan1("%s\n","KaoMult(matrix,vector). The left object is not matrix.");
571: }else if (n != m2) {
572: errorKan1("%s\n","KaoMult(). Invalid matrix and vector sizes for mult.");
573: } else ;
574: rob = newObjectArray(m);
575: for (i=0; i<m; i++) {
576: getoa(rob,i) = KooMult(getoa(aa,i),bb);
577: }
578: return(rob);
579: }else if (r1 && r2 == 0) { /* vector X matrix ---> vector */
580: tob = newObjectArray(1);
581: getoa(tob,0) = aa; /* [aa] * bb and strip [ ] */
582: tob = KooMult(tob,bb);
583: return(getoa(tob,0));
584: } else ; /* continue: matrix X matrix case. */
585: /* end of new code */
586:
587: if (getoa(aa,0).tag != Sarray || getoa(bb,0).tag != Sarray) {
588: errorKan1("%s\n","KaoMult(). Matrix must be given.");
589: }
590: n = getoaSize(getoa(aa,0));
591: n2 = getoaSize(getoa(bb,0));
592: if (n != m2) errorKan1("%s\n","KaoMult(). Invalid matrix size for mult. ((p,q)X(q,r)");
593: r1 = isMatrix(aa,m,n); r2 = isMatrix(bb,m2,n2);
594: if (r1 == -1 || r2 == -1) {
595: /* Object multiplication. Elements are not polynomials. */
596: struct object ofik,ogkj,otmp;
597: rob = newObjectArray(m);
598: for (i=0; i<m; i++) {
599: getoa(rob,i) = newObjectArray(n2);
600: }
601: for (i=0; i<m; i++) {
602: for (j=0; j<n2; j++) {
1.7 takayama 603: ofik = getoa(getoa(aa,i),0);
604: ogkj = getoa(getoa(bb,0),j);
605: otmp = KooMult( ofik, ogkj);
606: for (k=1; k<n; k++) {
607: ofik = getoa(getoa(aa,i),k);
608: ogkj = getoa(getoa(bb,k),j);
609: otmp = KooAdd(otmp, KooMult( ofik, ogkj));
610: }
611: getoa(getoa(rob,i),j) = otmp;
1.1 maekawa 612: }
613: }
614: return(rob);
615: /*errorKan1("%s\n","KaoMult().Elements of the matrix must be polynomials.");*/
616: }
617: if (r1 == 0 || r2 == 0)
618: errorKan1("%s\n","KaoMult(). Invalid matrix form for mult.");
619:
620: rob = newObjectArray(m);
621: for (i=0; i<m; i++) {
622: getoa(rob,i) = newObjectArray(n2);
623: }
624: for (i=0; i<m; i++) {
625: for (j=0; j<n2; j++) {
626: tmp = ZERO;
627: for (k=0; k<n; k++) {
1.7 takayama 628: fik = KopPOLY(getoa(getoa(aa,i),k));
629: gkj = KopPOLY(getoa(getoa(bb,k),j));
630: tmp = ppAdd(tmp, ppMult( fik, gkj));
1.1 maekawa 631: }
632: getoa(getoa(rob,i),j) = KpoPOLY(tmp);
633: }
634: }
635: return(rob);
636: }
637:
638: struct object KooDiv(ob1,ob2)
1.7 takayama 639: struct object ob1,ob2;
1.1 maekawa 640: {
641: struct object rob = NullObject;
642: switch (Lookup[ob1.tag][ob2.tag]) {
643: case SintegerSinteger:
644: return(KpoInteger((ob1.lc.ival) / (ob2.lc.ival)));
645: break;
646: case SuniversalNumberSuniversalNumber:
647: rob.tag = SuniversalNumber;
648: rob.lc.universalNumber = newUniversalNumber(0);
649: universalNumberDiv(rob.lc.universalNumber,ob1.lc.universalNumber,
1.7 takayama 650: ob2.lc.universalNumber);
1.1 maekawa 651: return(rob);
652: break;
653:
654:
655: default:
656: warningKan("KooDiv() has not supported yet these objects.\n");
657: break;
658: }
659: return(rob);
660: }
661:
662: /* :relation */
663: KooEqualQ(obj1,obj2)
1.7 takayama 664: struct object obj1;
665: struct object obj2;
1.1 maekawa 666: {
667: struct object ob;
668: int i;
669: if (obj1.tag != obj2.tag) {
670: warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n");
671: return(0);
672: }
673: switch(obj1.tag) {
1.7 takayama 674: case 0:
675: return(1); /* case of NullObject */
676: break;
677: case Sinteger:
678: if (obj1.lc.ival == obj2.lc.ival) return(1);
679: else return(0);
680: break;
681: case Sstring:
682: case Sdollar:
683: if (strcmp(obj1.lc.str, obj2.lc.str)==0) return(1);
684: else return(0);
685: break;
686: case Spoly:
687: ob = KooSub(obj1,obj2);
688: if (KopPOLY(ob) == ZERO) return(1);
689: else return(0);
690: case Sarray:
691: if (getoaSize(obj1) != getoaSize(obj2)) return(0);
692: for (i=0; i< getoaSize(obj1); i++) {
693: if (KooEqualQ(getoa(obj1,i),getoa(obj2,i))) { ; }
694: else { return(0); }
695: }
696: return(1);
697: case Slist:
698: if (KooEqualQ(*(obj1.lc.op),*(obj2.lc.op))) {
699: if (isNullList(obj1.rc.op)) {
700: if (isNullList(obj2.rc.op)) return(1);
701: else return(0);
1.1 maekawa 702: }else{
1.7 takayama 703: if (isNullList(obj2.rc.op)) return(0);
704: return(KooEqualQ(*(obj1.rc.op),*(obj2.rc.op)));
1.1 maekawa 705: }
1.7 takayama 706: }else{
707: return(0);
1.1 maekawa 708: }
1.7 takayama 709: break;
710: case SuniversalNumber:
711: return(coeffEqual(obj1.lc.universalNumber,obj2.lc.universalNumber));
712: break;
713: case Sring:
714: return(KopRingp(obj1) == KopRingp(obj2));
715: break;
716: case Sclass:
717: return(KclassEqualQ(obj1,obj2));
718: break;
719: case Sdouble:
720: return(KopDouble(obj1) == KopDouble(obj2));
721: break;
722: default:
723: errorKan1("%s\n","KooEqualQ() has not supported these objects yet.");
724: break;
725: }
1.1 maekawa 726: }
727:
728:
729: struct object KoIsPositive(ob1)
1.7 takayama 730: struct object ob1;
1.1 maekawa 731: {
732: struct object rob = NullObject;
733: switch (ob1.tag) {
734: case Sinteger:
735: return(KpoInteger(ob1.lc.ival > 0));
736: break;
737: default:
738: warningKan("KoIsPositive() has not supported yet these objects.\n");
739: break;
740: }
741: return(rob);
742: }
743:
744: struct object KooGreater(obj1,obj2)
1.7 takayama 745: struct object obj1;
746: struct object obj2;
1.1 maekawa 747: {
748: struct object ob;
749: int tt;
750: if (obj1.tag != obj2.tag) {
751: errorKan1("%s\n","You cannot compare different kinds of objects.");
752: }
753: switch(obj1.tag) {
1.7 takayama 754: case 0:
755: return(KpoInteger(1)); /* case of NullObject */
756: break;
757: case Sinteger:
758: if (obj1.lc.ival > obj2.lc.ival) return(KpoInteger(1));
759: else return(KpoInteger(0));
760: break;
761: case Sstring:
762: case Sdollar:
763: if (strcmp(obj1.lc.str, obj2.lc.str)>0) return(KpoInteger(1));
764: else return(KpoInteger(0));
765: break;
766: case Spoly:
767: if ((*mmLarger)(obj1.lc.poly,obj2.lc.poly) == 1) return(KpoInteger(1));
768: else return(KpoInteger(0));
769: break;
770: case SuniversalNumber:
771: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
772: if (tt > 0) return(KpoInteger(1));
773: else return(KpoInteger(0));
774: break;
775: case Sdouble:
776: if ( KopDouble(obj1) > KopDouble(obj2) ) return(KpoInteger(1));
777: else return(KpoInteger(0));
778: break;
779: default:
780: errorKan1("%s\n","KooGreater() has not supported these objects yet.");
781: break;
782: }
1.1 maekawa 783: }
784:
785: struct object KooLess(obj1,obj2)
1.7 takayama 786: struct object obj1;
787: struct object obj2;
1.1 maekawa 788: {
789: struct object ob;
790: int tt;
791: if (obj1.tag != obj2.tag) {
792: errorKan1("%s\n","You cannot compare different kinds of objects.");
793: }
794: switch(obj1.tag) {
1.7 takayama 795: case 0:
796: return(KpoInteger(1)); /* case of NullObject */
797: break;
798: case Sinteger:
799: if (obj1.lc.ival < obj2.lc.ival) return(KpoInteger(1));
800: else return(KpoInteger(0));
801: break;
802: case Sstring:
803: case Sdollar:
804: if (strcmp(obj1.lc.str, obj2.lc.str)<0) return(KpoInteger(1));
805: else return(KpoInteger(0));
806: break;
807: case Spoly:
808: if ((*mmLarger)(obj2.lc.poly,obj1.lc.poly) == 1) return(KpoInteger(1));
809: else return(KpoInteger(0));
810: break;
811: case SuniversalNumber:
812: tt = coeffGreater(obj1.lc.universalNumber,obj2.lc.universalNumber);
813: if (tt < 0) return(KpoInteger(1));
814: else return(KpoInteger(0));
815: break;
816: case Sdouble:
817: if ( KopDouble(obj1) < KopDouble(obj2) ) return(KpoInteger(1));
818: else return(KpoInteger(0));
819: break;
820: default:
821: errorKan1("%s\n","KooLess() has not supported these objects yet.");
822: break;
823: }
1.1 maekawa 824: }
825:
826: /* :conversion */
827:
828: struct object KdataConversion(obj,key)
1.7 takayama 829: struct object obj;
830: char *key;
1.1 maekawa 831: {
832: char tmps[128]; /* Assume that double is not more than 128 digits */
833: char intstr[100]; /* Assume that int is not more than 100 digits */
834: struct object rob;
835: extern struct ring *CurrentRingp;
836: extern struct ring SmallRing;
837: int flag;
838: struct object rob1,rob2;
839: char *s;
840: int i;
1.2 takayama 841: double f;
842: double f2;
1.1 maekawa 843: /* reports the data type */
844: if (key[0] == 't' || key[0] =='e') {
845: if (strcmp(key,"type?")==0) {
846: rob = KpoInteger(obj.tag);
847: return(rob);
848: }else if (strcmp(key,"type??")==0) {
849: if (obj.tag != Sclass) {
1.7 takayama 850: rob = KpoInteger(obj.tag);
1.1 maekawa 851: }else {
1.7 takayama 852: rob = KpoInteger(ectag(obj));
1.1 maekawa 853: }
854: return(rob);
855: }else if (strcmp(key,"error")==0) {
856: rob = KnewErrorPacketObj(obj);
857: return(rob);
858: }
859: }
860: switch(obj.tag) {
861: case Snull:
862: if (strcmp(key,"integer") == 0) {
863: rob = KpoInteger(0);
864: return(rob);
865: }else if (strcmp(key,"universalNumber") == 0) {
866: rob.tag = SuniversalNumber;
867: rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);
868: return(rob);
869: }else if (strcmp(key,"poly") == 0) {
870: rob = KpoPOLY(ZERO);
871: }else{
872: warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");
873: }
874: break;
875: case Sinteger:
876: if (strcmp(key,"string") == 0) { /* ascii code */
877: rob.tag = Sdollar;
878: rob.lc.str = (char *)sGC_malloc(2);
879: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
880: (rob.lc.str)[0] = obj.lc.ival; (rob.lc.str)[1] = '\0';
881: return(rob);
882: }else if (strcmp(key,"integer")==0) {
883: return(obj);
884: }else if (strcmp(key,"poly") == 0) {
885: rob.tag = Spoly;
886: rob.lc.poly = cxx(obj.lc.ival,0,0,CurrentRingp);
887: return(rob);
888: }else if (strcmp(key,"dollar") == 0) {
889: rob.tag = Sdollar;
890: sprintf(intstr,"%d",obj.lc.ival);
891: rob.lc.str = (char *)sGC_malloc(strlen(intstr)+2);
892: if (rob.lc.str == (char *)NULL) errorKan1("%s","No more memory.\n");
893: strcpy(rob.lc.str,intstr);
894: return(rob);
895: }else if (strcmp(key,"universalNumber")==0) {
896: rob.tag = SuniversalNumber;
897: rob.lc.universalNumber = intToCoeff(obj.lc.ival,&SmallRing);
898: return(rob);
899: }else if (strcmp(key,"double") == 0) {
900: rob = KpoDouble((double) (obj.lc.ival));
901: return(rob);
902: }else if (strcmp(key,"null") == 0) {
903: rob = NullObject;
904: return(rob);
905: }else{
906: warningKan("Sorry. This type of data conversion has not supported yet.\n");
907: }
908: break;
909: case Sdollar:
910: if (strcmp(key,"dollar") == 0 || strcmp(key,"string")==0) {
911: rob = obj;
912: return(rob);
913: }else if (strcmp(key,"literal") == 0) {
914: rob.tag = Sstring;
915: s = (char *) sGC_malloc(sizeof(char)*(strlen(obj.lc.str)+3));
916: if (s == (char *) NULL) {
1.7 takayama 917: errorKan1("%s\n","No memory.");
1.1 maekawa 918: }
919: s[0] = '/';
920: strcpy(&(s[1]),obj.lc.str);
921: rob.lc.str = &(s[1]);
922: /* set the hashing value. */
923: rob2 = lookupLiteralString(s);
924: rob.rc.op = rob2.lc.op;
925: return(rob);
926: }else if (strcmp(key,"poly")==0) {
927: rob.tag = Spoly;
928: rob.lc.poly = stringToPOLY(obj.lc.str,CurrentRingp);
929: return(rob);
930: }else if (strcmp(key,"array")==0) {
931: rob = newObjectArray(strlen(obj.lc.str));
932: for (i=0; i<strlen(obj.lc.str); i++) {
1.7 takayama 933: putoa(rob,i,KpoInteger((obj.lc.str)[i]));
1.1 maekawa 934: }
935: return(rob);
936: }else if (strcmp(key,"universalNumber") == 0) {
937: rob.tag = SuniversalNumber;
938: rob.lc.universalNumber = stringToUniversalNumber(obj.lc.str,&flag);
939: if (flag == -1) errorKan1("KdataConversion(): %s",
1.7 takayama 940: "It's not number.\n");
1.2 takayama 941: return(rob);
942: }else if (strcmp(key,"double") == 0) {
943: /* Check the format. 2.3432 e2 is not allowed. It should be 2.3232e2.*/
944: flag = 0;
945: for (i=0; (obj.lc.str)[i] != '\0'; i++) {
1.7 takayama 946: if ((obj.lc.str)[i] > ' ' && flag == 0) flag=1;
947: else if ((obj.lc.str)[i] <= ' ' && flag == 1) flag = 2;
948: else if ((obj.lc.str)[i] > ' ' && flag == 2) flag=3;
1.2 takayama 949: }
950: if (flag == 3) errorKan1("KdataConversion(): %s","The data for the double contains blanck(s)");
951: /* Read the double. */
952: if (sscanf(obj.lc.str,"%lf",&f) <= 0) {
1.7 takayama 953: errorKan1("KdataConversion(): %s","It cannot be translated to double.");
1.2 takayama 954: }
955: rob = KpoDouble(f);
1.1 maekawa 956: return(rob);
957: }else if (strcmp(key,"null") == 0) {
958: rob = NullObject;
959: return(rob);
960: }else{
961: warningKan("Sorry. This type of data conversion has not supported yet.\n");
962: }
963: break;
964: case Sarray:
965: if (strcmp(key,"array") == 0) {
966: return(rob);
967: }else if (strcmp(key,"list") == 0) {
968: rob = *( arrayToList(obj) );
969: return(rob);
970: }else if (strcmp(key,"arrayOfPOLY")==0) {
971: rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));
972: return(rob);
973: }else if (strcmp(key,"matrixOfPOLY")==0) {
974: rob = KpoMatrixOfPOLY(arrayToMatrixOfPOLY(obj));
975: return(rob);
976: }else if (strcmp(key,"gradedPolySet")==0) {
977: rob = KpoGradedPolySet(arrayToGradedPolySet(obj));
978: return(rob);
979: }else if (strcmp(key,"null") == 0) {
980: rob = NullObject;
981: return(rob);
982: }else {
983: warningKan("Sorry. This type of data conversion has not supported yet.\n");
984: }
985: break;
986: case Spoly:
1.15 takayama 987: if ((strcmp(key,"poly")==0) || (strcmp(key,"numerator")==0)) {
1.5 takayama 988: rob = obj;
1.1 maekawa 989: return(rob);
990: }else if (strcmp(key,"integer")==0) {
991: if (obj.lc.poly == ZERO) return(KpoInteger(0));
992: else {
1.7 takayama 993: return(KpoInteger(coeffToInt(obj.lc.poly->coeffp)));
1.1 maekawa 994: }
995: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
996: rob.tag = Sdollar;
997: rob.lc.str = KPOLYToString(KopPOLY(obj));
998: return(rob);
999: }else if (strcmp(key,"array") == 0) {
1000: return( POLYToArray(KopPOLY(obj)));
1001: }else if (strcmp(key,"map")==0) {
1002: return(KringMap(obj));
1003: }else if (strcmp(key,"universalNumber")==0) {
1004: if (obj.lc.poly == ZERO) {
1.7 takayama 1005: rob.tag = SuniversalNumber;
1006: rob.lc.universalNumber = newUniversalNumber(0);
1.1 maekawa 1007: } else {
1.7 takayama 1008: if (obj.lc.poly->coeffp->tag == MP_INTEGER) {
1009: rob.tag = SuniversalNumber;
1010: rob.lc.universalNumber = newUniversalNumber2(obj.lc.poly->coeffp->val.bigp);
1011: }else {
1012: rob = NullObject;
1013: warningKan("Coefficient is not MP_INT.");
1014: }
1.1 maekawa 1015: }
1016: return(rob);
1017: }else if (strcmp(key,"ring")==0) {
1018: if (obj.lc.poly ISZERO) {
1.7 takayama 1019: warningKan("Zero polynomial does not have the ring structure field.\n");
1.1 maekawa 1020: }else{
1.7 takayama 1021: rob.tag = Sring;
1022: rob.lc.ringp = (obj.lc.poly)->m->ringp;
1023: return(rob);
1.1 maekawa 1024: }
1025: }else if (strcmp(key,"null") == 0) {
1026: rob = NullObject;
1027: return(rob);
1028: }else{
1029: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1030: }
1031: break;
1032: case SarrayOfPOLY:
1033: if (strcmp(key,"array")==0) {
1034: rob = arrayOfPOLYToArray(KopArrayOfPOLYp(obj));
1035: return(rob);
1036: }else{
1037: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1038: }
1039: break;
1040: case SmatrixOfPOLY:
1041: if (strcmp(key,"array")==0) {
1042: rob = matrixOfPOLYToArray(KopMatrixOfPOLYp(obj));
1043: return(rob);
1044: }else if (strcmp(key,"null") == 0) {
1045: rob = NullObject;
1046: return(rob);
1047: }else{
1048: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1049: }
1050: break;
1051: case Slist:
1052: if (strcmp(key,"array") == 0) {
1053: rob = listToArray(&obj);
1054: return(rob);
1055: }
1056: break;
1057: case SuniversalNumber:
1.15 takayama 1058: if ((strcmp(key,"universalNumber")==0) || (strcmp(key,"numerator")==0)) {
1.1 maekawa 1059: return(rob);
1060: }else if (strcmp(key,"integer")==0) {
1061: rob = KpoInteger(coeffToInt(obj.lc.universalNumber));
1062: return(rob);
1063: }else if (strcmp(key,"poly")==0) {
1064: rob = KpoPOLY(universalToPoly(obj.lc.universalNumber,CurrentRingp));
1065: return(rob);
1066: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1067: rob.tag = Sdollar;
1068: rob.lc.str = coeffToString(obj.lc.universalNumber);
1069: return(rob);
1070: }else if (strcmp(key,"null") == 0) {
1071: rob = NullObject;
1072: return(rob);
1073: }else if (strcmp(key,"double") == 0) {
1074: rob = KpoDouble( toDouble0(obj) );
1075: return(rob);
1076: }else{
1077: warningKan("Sorry. This type of data conversion of universalNumber has not supported yet.\n");
1078: }
1079: break;
1080: case SrationalFunction:
1081: if (strcmp(key,"rationalFunction")==0) {
1082: return(rob);
1083: } if (strcmp(key,"numerator")==0) {
1084: rob = *(Knumerator(obj));
1085: return(rob);
1086: }else if (strcmp(key,"denominator")==0) {
1087: rob = *(Kdenominator(obj));
1088: return(rob);
1089: }else if (strcmp(key,"string")==0 || strcmp(key,"dollar")==0) {
1090: rob1 = KdataConversion(*(Knumerator(obj)),"string");
1091: rob2 = KdataConversion(*(Kdenominator(obj)),"string");
1092: s = sGC_malloc(sizeof(char)*( strlen(rob1.lc.str) + strlen(rob2.lc.str) + 10));
1093: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1094: sprintf(s,"(%s)/(%s)",rob1.lc.str,rob2.lc.str);
1095: rob.tag = Sdollar;
1096: rob.lc.str = s;
1097: return(rob);
1098: }else if (strcmp(key,"cancel")==0) {
1099: warningKan("Sorry. Data conversion <<cancel>> of rationalFunction has not supported yet.\n");
1100: return(obj);
1101: }else if (strcmp(key,"null") == 0) {
1102: rob = NullObject;
1103: return(rob);
1104: }else if (strcmp(key,"double") == 0) {
1105: rob = KpoDouble( toDouble0(obj) );
1106: return(rob);
1107: }else{
1108: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1109: }
1110: break;
1111: case Sdouble:
1112: if (strcmp(key,"integer") == 0) {
1113: rob = KpoInteger( (int) KopDouble(obj));
1114: return(rob);
1115: } else if (strcmp(key,"universalNumber") == 0) {
1116: rob.tag = SuniversalNumber;
1117: rob.lc.universalNumber = intToCoeff((int) KopDouble(obj),&SmallRing);
1118: return(rob);
1119: }else if ((strcmp(key,"string") == 0) || (strcmp(key,"dollar") == 0)) {
1120: sprintf(tmps,"%f",KopDouble(obj));
1121: s = sGC_malloc(strlen(tmps)+2);
1122: if (s == (char *)NULL) errorKan1("%s\n","KdataConversion(): No memory");
1123: strcpy(s,tmps);
1124: rob.tag = Sdollar;
1125: rob.lc.str = s;
1126: return(rob);
1127: }else if (strcmp(key,"double")==0) {
1128: return(obj);
1129: }else if (strcmp(key,"null") == 0) {
1130: rob = NullObject;
1131: return(rob);
1132: }else {
1133: warningKan("Sorry. This type of data conversion of rationalFunction has not supported yet.\n");
1134: }
1135: break;
1136: case Sring:
1137: if (strcmp(key,"orderMatrix")==0) {
1138: rob = oGetOrderMatrix(KopRingp(obj));
1139: return(rob);
1140: }else{
1141: warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");
1142: }
1143: break;
1144: default:
1145: warningKan("Sorry. This type of data conversion has not supported yet.\n");
1146: }
1147: return(NullObject);
1148: }
1149:
1150: /* conversion functions between primitive data and objects.
1151: If it's not time critical, it is recommended to use these functions */
1152: struct object KpoInteger(k)
1.7 takayama 1153: int k;
1.1 maekawa 1154: {
1155: struct object obj;
1156: obj.tag = Sinteger;
1157: obj.lc.ival = k; obj.rc.ival = 0;
1158: return(obj);
1159: }
1160: struct object KpoString(s)
1.7 takayama 1161: char *s;
1.1 maekawa 1162: {
1163: struct object obj;
1164: obj.tag = Sdollar;
1165: obj.lc.str = s; obj.rc.ival = 0;
1166: return(obj);
1167: }
1168: struct object KpoPOLY(f)
1.7 takayama 1169: POLY f;
1.1 maekawa 1170: {
1171: struct object obj;
1172: obj.tag = Spoly;
1173: obj.lc.poly = f; obj.rc.ival = 0;
1174: return(obj);
1175: }
1176: struct object KpoArrayOfPOLY(ap)
1.7 takayama 1177: struct arrayOfPOLY *ap ;
1.1 maekawa 1178: {
1179: struct object obj;
1180: obj.tag = SarrayOfPOLY;
1181: obj.lc.arrayp = ap; obj.rc.ival = 0;
1182: return(obj);
1183: }
1184:
1185: struct object KpoMatrixOfPOLY(mp)
1.7 takayama 1186: struct matrixOfPOLY *mp ;
1.1 maekawa 1187: {
1188: struct object obj;
1189: obj.tag = SmatrixOfPOLY;
1190: obj.lc.matrixp = mp; obj.rc.ival = 0;
1191: return(obj);
1192: }
1193:
1194: struct object KpoRingp(ringp)
1.7 takayama 1195: struct ring *ringp;
1.1 maekawa 1196: {
1197: struct object obj;
1198: obj.tag = Sring;
1199: obj.lc.ringp = ringp;
1200: return(obj);
1201: }
1202:
1203: /*** conversion 2. Data conversions on arrays and matrices. ****/
1204: struct object arrayOfPOLYToArray(aa)
1.7 takayama 1205: struct arrayOfPOLY *aa;
1.1 maekawa 1206: {
1207: POLY *a;
1208: int size;
1209: struct object r;
1210: int j;
1211: struct object tmp;
1212:
1213: size = aa->n; a = aa->array;
1214: r = newObjectArray(size);
1215: for (j=0; j<size; j++) {
1216: tmp.tag = Spoly;
1217: tmp.lc.poly= a[j];
1218: putoa(r,j,tmp);
1219: }
1220: return( r );
1221: }
1222:
1223: struct object matrixOfPOLYToArray(pmat)
1.7 takayama 1224: struct matrixOfPOLY *pmat;
1.1 maekawa 1225: {
1226: struct object r;
1227: struct object tmp;
1228: int i,j;
1229: int m,n;
1230: POLY *mat;
1231: struct arrayOfPOLY ap;
1232:
1233: m = pmat->m; n = pmat->n; mat = pmat->mat;
1234: r = newObjectArray(m);
1235: for (i=0; i<m; i++) {
1236: ap.n = n; ap.array = &(mat[ind(i,0)]);
1237: tmp = arrayOfPOLYToArray(&ap);
1238: /* ind() is the macro defined in matrix.h. */
1239: putoa(r,i,tmp);
1240: }
1241: return(r);
1242: }
1243:
1244: struct arrayOfPOLY *arrayToArrayOfPOLY(oa)
1.7 takayama 1245: struct object oa;
1.1 maekawa 1246: {
1247: POLY *a;
1248: int size;
1249: int i;
1250: struct object tmp;
1251: struct arrayOfPOLY *ap;
1252:
1253: if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",
1.7 takayama 1254: "Argument is not array\n");
1.1 maekawa 1255: size = getoaSize(oa);
1256: a = (POLY *)sGC_malloc(sizeof(POLY)*size);
1257: for (i=0; i<size; i++) {
1258: tmp = getoa(oa,i);
1259: if (tmp.tag != Spoly) errorKan1("KarrayToArrayOfPOLY():%s ",
1.7 takayama 1260: "element must be polynomial.\n");
1.1 maekawa 1261: a[i] = tmp.lc.poly;
1262: }
1263: ap = (struct arrayOfPOLY *)sGC_malloc(sizeof(struct arrayOfPOLY));
1264: ap->n = size;
1265: ap->array = a;
1266: return(ap);
1267: }
1268:
1269: struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)
1.7 takayama 1270: struct object oa;
1.1 maekawa 1271: {
1272: POLY *a;
1273: int m;
1274: int n;
1275: int i,j;
1276: struct matrixOfPOLY *ma;
1277:
1278: struct object tmp,tmp2;
1279: if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",
1.7 takayama 1280: "Argument is not array\n");
1.1 maekawa 1281: m = getoaSize(oa);
1282: tmp = getoa(oa,0);
1283: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY():%s ",
1.7 takayama 1284: "Argument is not array\n");
1.1 maekawa 1285: n = getoaSize(tmp);
1286: a = (POLY *)sGC_malloc(sizeof(POLY)*(m*n));
1287: for (i=0; i<m; i++) {
1288: tmp = getoa(oa,i);
1289: if (tmp.tag != Sarray) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1290: "element must be array.\n");
1.1 maekawa 1291: for (j=0; j<n; j++) {
1292: tmp2 = getoa(tmp,j);
1293: if (tmp2.tag != Spoly) errorKan1("arrayToMatrixOfPOLY(): %s",
1.7 takayama 1294: "element must be a polynomial.\n");
1.1 maekawa 1295: a[ind(i,j)] = tmp2.lc.poly;
1296: /* we use the macro ind here. Be careful of using m and n. */
1297: }
1298: }
1299: ma = (struct matrixOfPOLY *)sGC_malloc(sizeof(struct matrixOfPOLY));
1300: ma->m = m; ma->n = n;
1301: ma->mat = a;
1302: return(ma);
1303: }
1304:
1305: /* :misc */
1306:
1307: /* :ring :kan */
1308: int objArrayToOrderMatrix(oA,order,n,oasize)
1.7 takayama 1309: struct object oA;
1310: int order[];
1311: int n;
1312: int oasize;
1.1 maekawa 1313: {
1314: int size;
1315: int k,j;
1316: struct object tmpOa;
1317: struct object obj;
1318: if (oA.tag != Sarray) {
1319: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1320: return(-1);
1321: }
1322: size = getoaSize(oA);
1323: if (size != oasize) {
1324: warningKan("The row size of the array is wrong.");
1325: return(-1);
1326: }
1327: for (k=0; k<size; k++) {
1328: tmpOa = getoa(oA,k);
1329: if (tmpOa.tag != Sarray) {
1330: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1331: return(-1);
1332: }
1333: if (getoaSize(tmpOa) != 2*n) {
1334: warningKan("The column size of the array is wrong.");
1335: return(-1);
1336: }
1337: for (j=0; j<2*n; j++) {
1338: obj = getoa(tmpOa,j);
1339: order[k*2*n+j] = obj.lc.ival;
1340: }
1341: }
1342: return(0);
1343: }
1344:
1345: int KsetOrderByObjArray(oA)
1.7 takayama 1346: struct object oA;
1.1 maekawa 1347: {
1348: int *order;
1349: int n,c,l, oasize;
1350: extern struct ring *CurrentRingp;
1351: extern int AvoidTheSameRing;
1352: /* n,c,l must be set in the CurrentRing */
1353: if (AvoidTheSameRing) {
1354: errorKan1("%s\n","KsetOrderByObjArray(): You cannot change the order matrix when AvoidTheSameRing == 1.");
1355: }
1356: n = CurrentRingp->n;
1357: c = CurrentRingp->c;
1358: l = CurrentRingp->l;
1359: if (oA.tag != Sarray) {
1360: warningKan("The argument should be of the form [ [...] [...] ... [...]].");
1361: return(-1);
1362: }
1363: oasize = getoaSize(oA);
1364: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1365: if (order == (int *)NULL) errorKan1("%s\n","KsetOrderByObjArray(): No memory.");
1366: if (objArrayToOrderMatrix(oA,order,n,oasize) == -1) {
1367: return(-1);
1368: }
1369: setOrderByMatrix(order,n,c,l,oasize); /* Set order to the current ring. */
1370: return(0);
1371: }
1372:
1373: static int checkRelations(c,l,m,n,cc,ll,mm,nn)
1.7 takayama 1374: int c,l,m,n,cc,ll,mm,nn;
1.1 maekawa 1375: {
1376: if (!(1<=c && c<=l && l<=m && m<=n)) return(1);
1377: if (!(cc<=ll && ll<=mm && mm<=nn && nn <= n)) return(1);
1378: if (!(cc<c || ll < l || mm < m || nn < n)) {
1379: if (WarningNoVectorVariable) {
1.4 takayama 1380: warningKanNoStrictMode("Ring definition: there is no variable to represent vectors.\n");
1.1 maekawa 1381: }
1382: }
1383: if (!(cc<=c && ll <= l && mm <= m && nn <= n)) return(1);
1384: return(0);
1385: }
1386:
1387: struct object KgetOrderMatrixOfCurrentRing()
1388: {
1389: extern struct ring *CurrentRingp;
1390: return(oGetOrderMatrix(CurrentRingp));
1391: }
1392:
1393:
1394: int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
1.7 takayama 1395: struct object ob1,ob2,ob3,ob4,ob5;
1396: /* ob1 = [x(0), ..., x(n-1)];
1397: ob2 = [D(0), ..., D(n-1)];
1398: ob3 = [p,c,l,m,n,cc,ll,mm,nn,next];
1399: ob4 = Order matrix
1400: ob5 = [(keyword) value (keyword) value ....]
1401: */
1.1 maekawa 1402: #define RP_LIMIT 500
1403: {
1404: int i;
1405: struct object ob;
1406: int c,l,m,n;
1407: int cc,ll,mm,nn;
1408: int p;
1409: char **xvars;
1410: char **dvars;
1411: int *outputVars;
1412: int *order;
1413: static int rp = 0;
1414: static struct ring *rstack[RP_LIMIT];
1415:
1416: extern struct ring *CurrentRingp;
1417: struct ring *newRingp;
1418: int ob3Size;
1419: struct ring *nextRing;
1420: int oasize;
1421: static int ringSerial = 0;
1422: char *ringName = NULL;
1423: int aa;
1424: extern int AvoidTheSameRing;
1425: extern char *F_mpMult;
1426: char *fmp_mult_saved;
1427: char *mpMultName = NULL;
1428: struct object rob;
1429: struct ring *savedCurrentRingp;
1430:
1431: /* To get the ring structure. */
1432: if (ob1.tag == Snull) {
1433: rob = newObjectArray(rp);
1434: for (i=0; i<rp; i++) {
1435: putoa(rob,i,KpoRingp(rstack[i]));
1436: }
1437: KSpush(rob);
1438: return(0);
1439: }
1440:
1441: if (ob3.tag != Sarray) errorKan1("%s\n","Error in the 3rd argument. You need to give 4 arguments.");
1442: ob3Size = getoaSize(ob3);
1443: if (ob3Size != 9 && ob3Size != 10)
1444: errorKan1("%s\n","Error in the 3rd argument.");
1445: for (i=0; i<9; i++) {
1446: ob = getoa(ob3,i);
1447: if (ob.tag != Sinteger) errorKan1("%s\n","The 3rd argument should be a list of integers.");
1448: }
1449: if (ob3Size == 10) {
1450: ob = getoa(ob3,9);
1451: if (ob.tag != Sring)
1452: errorKan1("%s\n","The last arguments of the 3rd argument must be a pointer to a ring.");
1453: nextRing = KopRingp(ob);
1454: } else {
1455: nextRing = (struct ring *)NULL;
1456: }
1457:
1458: p = getoa(ob3,0).lc.ival;
1459: c = getoa(ob3,1).lc.ival; l = getoa(ob3,2).lc.ival;
1460: m = getoa(ob3,3).lc.ival; n = getoa(ob3,4).lc.ival;
1461: cc = getoa(ob3,5).lc.ival; ll = getoa(ob3,6).lc.ival;
1462: mm = getoa(ob3,7).lc.ival; nn = getoa(ob3,8).lc.ival;
1463: if (checkRelations(c,l,m,n,cc,ll,mm,nn,n)) {
1464: errorKan1("%s\n","1<=c<=l<=m<=n and cc<=c<=ll<=l<=mm<=m<=nn<=n \nand (cc<c or ll < l or mm < m or nn < n) must be satisfied.");
1465: }
1466: if (getoaSize(ob2) != n || getoaSize(ob1) != n) {
1467: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1468: }
1469: for (i=0; i<n; i++) {
1470: if (getoa(ob1,i).tag != Sdollar || getoa(ob2,i).tag != Sdollar) {
1471: errorKan1("%s\n","Error in the 1st or 2nd arguments.");
1472: }
1473: }
1474: xvars = (char **) sGC_malloc(sizeof(char *)*n);
1475: dvars = (char **) sGC_malloc(sizeof(char *)*n);
1476: if (xvars == (char **)NULL || dvars == (char **)NULL) {
1477: fprintf(stderr,"No more memory.\n");
1478: exit(15);
1479: }
1480: for (i=0; i<n; i++) {
1481: xvars[i] = getoa(ob1,i).lc.str;
1482: dvars[i] = getoa(ob2,i).lc.str;
1483: }
1484: checkDuplicateName(xvars,dvars,n);
1485:
1486: outputVars = (int *)sGC_malloc(sizeof(int)*n*2);
1487: if (outputVars == NULL) {
1488: fprintf(stderr,"No more memory.\n");
1489: exit(15);
1490: }
1491: if (ReverseOutputOrder) {
1492: for (i=0; i<n; i++) outputVars[i] = n-i-1;
1493: for (i=0; i<n; i++) outputVars[n+i] = 2*n-i-1;
1494: }else{
1495: for (i=0; i<2*n; i++) {
1496: outputVars[i] = i;
1497: }
1498: }
1499:
1500: oasize = getoaSize(ob4);
1501: order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
1502: if (order == (int *)NULL) errorKan1("%s\n","No memory.");
1503: if (objArrayToOrderMatrix(ob4,order,n,oasize) == -1) {
1504: errorKan1("%s\n","Errors in the 4th matrix (order matrix).");
1505: }
1506: /* It's better to check the consistency of the order matrix here. */
1507: savedCurrentRingp = CurrentRingp;
1508:
1509: newRingp = (struct ring *)sGC_malloc(sizeof(struct ring));
1510: if (newRingp == NULL) errorKan1("%s\n","No more memory.");
1511: /* Generate the new ring before calling setOrder...(). */
1512: *newRingp = *CurrentRingp;
1513: CurrentRingp = newRingp; /* Push the current ring. */
1514: setOrderByMatrix(order,n,c,l,oasize); /* set order to the CurrentRing. */
1515: CurrentRingp = savedCurrentRingp; /* recover it. */
1516:
1517:
1518: /* Set the default name of the ring */
1519: ringName = (char *)sGC_malloc(16);
1520: sprintf(ringName,"ring%05d",ringSerial);
1521: ringSerial++;
1522:
1523: /* Set the current ring */
1524: newRingp->n = n; newRingp->m = m; newRingp->l = l; newRingp->c = c;
1525: newRingp->nn = nn; newRingp->mm = mm; newRingp->ll = ll;
1526: newRingp->cc = cc;
1527: newRingp->x = xvars;
1528: newRingp->D = dvars;
1529: /* You don't need to set order and orderMatrixSize here.
1530: It was set by setOrder(). */
1531: setFromTo(newRingp);
1532:
1533: newRingp->p = p;
1534: newRingp->next = nextRing;
1535: newRingp->multiplication = mpMult;
1536: /* These values should will be reset if the optional value is given. */
1537: newRingp->schreyer = 0;
1538: newRingp->gbListTower = NULL;
1539: newRingp->outputOrder = outputVars;
1.9 takayama 1540: newRingp->weightedHomogenization = 0;
1.11 takayama 1541: newRingp->degreeShiftSize = 0;
1.12 takayama 1542: newRingp->degreeShiftN = 0;
1543: newRingp->degreeShift = NULL;
1.1 maekawa 1544:
1545: if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {
1546: errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");
1547: }
1548: for (i=0; i < getoaSize(ob5); i += 2) {
1549: if (getoa(ob5,i).tag == Sdollar) {
1550: if (strcmp(KopString(getoa(ob5,i)),"mpMult") == 0) {
1.7 takayama 1551: if (getoa(ob5,i+1).tag != Sdollar) {
1552: errorKan1("%s\n","A keyword should be given. (mpMult)");
1553: }
1554: fmp_mult_saved = F_mpMult;
1555: mpMultName = KopString(getoa(ob5,i+1));
1556: switch_function("mpMult",mpMultName);
1557: /* Note that this cause a global effect. It will be done again. */
1558: newRingp->multiplication = mpMult;
1559: switch_function("mpMult",fmp_mult_saved);
1.1 maekawa 1560: } else if (strcmp(KopString(getoa(ob5,i)),"coefficient ring") == 0) {
1.7 takayama 1561: if (getoa(ob5,i+1).tag != Sring) {
1562: errorKan1("%s\n","The pointer to a ring should be given. (coefficient ring)");
1563: }
1564: nextRing = KopRingp(getoa(ob5,i+1));
1565: newRingp->next = nextRing;
1.1 maekawa 1566: } else if (strcmp(KopString(getoa(ob5,i)),"valuation") == 0) {
1.7 takayama 1567: errorKan1("%s\n","Not implemented. (valuation)");
1.1 maekawa 1568: } else if (strcmp(KopString(getoa(ob5,i)),"characteristic") == 0) {
1.7 takayama 1569: if (getoa(ob5,i+1).tag != Sinteger) {
1570: errorKan1("%s\n","A integer should be given. (characteristic)");
1571: }
1572: p = KopInteger(getoa(ob5,i+1));
1573: newRingp->p = p;
1.1 maekawa 1574: } else if (strcmp(KopString(getoa(ob5,i)),"schreyer") == 0) {
1.7 takayama 1575: if (getoa(ob5,i+1).tag != Sinteger) {
1576: errorKan1("%s\n","A integer should be given. (schreyer)");
1577: }
1578: newRingp->schreyer = KopInteger(getoa(ob5,i+1));
1.1 maekawa 1579: } else if (strcmp(KopString(getoa(ob5,i)),"gbListTower") == 0) {
1.7 takayama 1580: if (getoa(ob5,i+1).tag != Slist) {
1581: errorKan1("%s\n","A list should be given (gbListTower).");
1582: }
1583: newRingp->gbListTower = newObject();
1584: *((struct object *)(newRingp->gbListTower)) = getoa(ob5,i+1);
1.1 maekawa 1585: } else if (strcmp(KopString(getoa(ob5,i)),"ringName") == 0) {
1.7 takayama 1586: if (getoa(ob5,i+1).tag != Sdollar) {
1587: errorKan1("%s\n","A name should be given. (ringName)");
1588: }
1589: ringName = KopString(getoa(ob5,i+1));
1.9 takayama 1590: } else if (strcmp(KopString(getoa(ob5,i)),"weightedHomogenization") == 0) {
1591: if (getoa(ob5,i+1).tag != Sinteger) {
1592: errorKan1("%s\n","A integer should be given. (weightedHomogenization)");
1593: }
1.11 takayama 1594: newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1));
1595: } else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) {
1596: if (getoa(ob5,i+1).tag != Sarray) {
1.12 takayama 1597: errorKan1("%s\n","An array of array should be given. (degreeShift)");
1.11 takayama 1598: }
1599: {
1600: struct object ods;
1.12 takayama 1601: struct object ods2;
1602: int dssize,k,j,nn;
1.11 takayama 1603: ods=getoa(ob5,i+1);
1.12 takayama 1604: if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) {
1605: errorKan1("%s\n", "An array of array should be given. (degreeShift)");
1606: }
1607: nn = getoaSize(ods);
1608: dssize = getoaSize(getoa(ods,0));
1.11 takayama 1609: newRingp->degreeShiftSize = dssize;
1.12 takayama 1610: newRingp->degreeShiftN = nn;
1611: newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1));
1.11 takayama 1612: if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory.");
1.12 takayama 1613: for (j=0; j<nn; j++) {
1614: ods2 = getoa(ods,j);
1615: for (k=0; k<dssize; k++) {
1616: if (getoa(ods2,k).tag == SuniversalNumber) {
1617: (newRingp->degreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber);
1618: }else{
1619: (newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k));
1620: }
1.11 takayama 1621: }
1622: }
1623: }
1.13 takayama 1624: switch_function("grade","module1v");
1625: /* Warning: grading is changed to module1v!! */
1.1 maekawa 1626: } else {
1.7 takayama 1627: errorKan1("%s\n","Unknown keyword to set_up_ring@");
1.1 maekawa 1628: }
1629: }else{
1630: errorKan1("%s\n","A keyword enclosed by braces have to be given.");
1631: }
1632: }
1633:
1634: newRingp->name = ringName;
1635:
1636:
1637: if (AvoidTheSameRing) {
1638: aa = isTheSameRing(rstack,rp,newRingp);
1639: if (aa < 0) {
1640: /* This ring has never been defined. */
1641: CurrentRingp = newRingp;
1642: /* Install it to the RingStack */
1643: if (rp <RP_LIMIT) {
1.7 takayama 1644: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1.1 maekawa 1645: }else{
1.7 takayama 1646: rp = 0;
1647: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1.1 maekawa 1648: }
1649: }else{
1650: /* This ring has been defined. */
1651: /* Discard the newRingp */
1652: CurrentRingp = rstack[aa];
1653: ringSerial--;
1654: }
1655: }else{
1656: CurrentRingp = newRingp;
1657: /* Install it to the RingStack */
1658: if (rp <RP_LIMIT) {
1659: rstack[rp] = CurrentRingp; rp++; /* Save the previous ringp */
1660: }else{
1661: rp = 0;
1662: errorKan1("%s\n","You have defined too many rings. Check the value of RP_LIMIT.");
1663: }
1664: }
1665: if (mpMultName != NULL) {
1666: switch_function("mpMult",mpMultName);
1667: }
1668:
1669: initSyzRingp();
1670:
1671: return(0);
1672: }
1673:
1674:
1675: struct object KsetVariableNames(struct object ob,struct ring *rp)
1676: {
1677: int n,i;
1678: struct object ox;
1679: struct object otmp;
1680: char **xvars;
1681: char **dvars;
1682: if (ob.tag != Sarray) {
1683: errorKan1("%s\n","KsetVariableNames(): the argument must be of the form [(x) (y) (z) ...]");
1684: }
1685: n = rp->n;
1686: ox = ob;
1687: if (getoaSize(ox) != 2*n) {
1688: errorKan1("%s\n","KsetVariableNames(): 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.");
1689: }
1690: xvars = (char **)sGC_malloc(sizeof(char *)*n);
1691: dvars = (char **)sGC_malloc(sizeof(char *)*n);
1692: if (xvars == NULL || dvars == NULL) {
1693: errorKan1("%s\n","KsetVariableNames(): no more memory.");
1694: }
1695: for (i=0; i<2*n; i++) {
1696: otmp = getoa(ox,i);
1697: if(otmp.tag != Sdollar) {
1698: errorKan1("%s\n","KsetVariableNames(): elements must be strings.");
1699: }
1700: if (i < n) {
1701: xvars[i] = KopString(otmp);
1702: }else{
1703: dvars[i-n] = KopString(otmp);
1704: }
1705: }
1706: checkDuplicateName(xvars,dvars,n);
1707: rp->x = xvars;
1708: rp->D = dvars;
1709: return(ob);
1710: }
1711:
1712:
1713:
1714: void KshowRing(ringp)
1.7 takayama 1715: struct ring *ringp;
1.1 maekawa 1716: {
1717: showRing(1,ringp);
1718: }
1719:
1720: struct object KswitchFunction(ob1,ob2)
1.7 takayama 1721: struct object ob1,ob2;
1.1 maekawa 1722: {
1723: char *ans ;
1724: struct object rob;
1725: int needWarningForAvoidTheSameRing = 0;
1726: extern int AvoidTheSameRing;
1727: if ((ob1.tag != Sdollar) || (ob2.tag != Sdollar)) {
1728: errorKan1("%s\n","$function$ $name$ switch_function\n");
1729: }
1730: if (AvoidTheSameRing && needWarningForAvoidTheSameRing) {
1731: if (strcmp(KopString(ob1),"mmLarger") == 0 ||
1732: strcmp(KopString(ob1),"mpMult") == 0 ||
1733: strcmp(KopString(ob1),"monomialAdd") == 0 ||
1734: strcmp(KopString(ob1),"isSameComponent") == 0) {
1735: fprintf(stderr,",switch_function ==> %s ",KopString(ob1));
1736: warningKan("switch_function might cause a trouble under AvoidTheSameRing == 1.\n");
1737: }
1738: }
1739: if (AvoidTheSameRing) {
1740: if (strcmp(KopString(ob1),"mmLarger") == 0 &&
1.7 takayama 1741: strcmp(KopString(ob2),"matrix") != 0) {
1.1 maekawa 1742: fprintf(stderr,"mmLarger = %s",KopString(ob2));
1743: errorKan1("%s\n","mmLarger can set only to matrix under AvoidTheSameRing == 1.");
1744: }
1745: }
1746:
1747: ans = switch_function(ob1.lc.str,ob2.lc.str);
1748: if (ans == NULL) {
1749: rob = NullObject;
1750: }else{
1751: rob = KpoString(ans);
1752: }
1753: return(rob);
1754:
1755: }
1756:
1757: void KprintSwitchStatus(void)
1758: {
1759: print_switch_status();
1760: }
1761:
1762: struct object KoReplace(of,rule)
1.7 takayama 1763: struct object of;
1764: struct object rule;
1.1 maekawa 1765: {
1766: struct object rob;
1767: POLY f;
1768: POLY lRule[N0*2];
1769: POLY rRule[N0*2];
1770: POLY r;
1771: int i;
1772: int n;
1773: struct object trule;
1774:
1775:
1776: if (rule.tag != Sarray) {
1777: errorKan1("%s\n"," KoReplace(): The second argument must be array.");
1778: }
1779: n = getoaSize(rule);
1780:
1.6 takayama 1781: if (of.tag == Spoly) {
1782: }else if (of.tag ==Sclass && ectag(of) == CLASSNAME_recursivePolynomial) {
1.7 takayama 1783: return(KreplaceRecursivePolynomial(of,rule));
1.6 takayama 1784: }else{
1.1 maekawa 1785: errorKan1("%s\n"," KoReplace(): The first argument must be a polynomial.");
1786: }
1787: f = KopPOLY(of);
1788:
1789: if (f ISZERO) {
1790: }else{
1791: if (n >= 2*(f->m->ringp->n)) {
1792: errorKan1("%s\n"," KoReplace(): too many rules for replacement. ");
1793: }
1794: }
1795:
1796: for (i=0; i<n; i++) {
1797: trule = getoa(rule,i);
1798: if (trule.tag != Sarray) {
1799: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1800: }
1801: if (getoaSize(trule) != 2) {
1802: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....].");
1803: }
1804:
1805: if (getoa(trule,0).tag != Spoly) {
1806: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1807: }
1808: if (getoa(trule,1).tag != Spoly) {
1809: errorKan1("%s\n"," KoReplace(): The second argument must be of the form [[a b] [c d] ....] where a,b,c,d,... are polynomials.");
1810: }
1811:
1812: lRule[i] = KopPOLY(getoa(trule,0));
1813: rRule[i] = KopPOLY(getoa(trule,1));
1814: }
1815:
1816: r = replace(f,lRule,rRule,n);
1817: rob.tag = Spoly; rob.lc.poly = r;
1818:
1819: return(rob);
1820: }
1821:
1822:
1823: struct object Kparts(f,v)
1.7 takayama 1824: struct object f;
1825: struct object v;
1.1 maekawa 1826: {
1827: POLY ff;
1828: POLY vv;
1829: struct object obj;
1830: struct matrixOfPOLY *co;
1831: /* check the data type */
1832: if (f.tag != Spoly || v.tag != Spoly)
1833: errorKan1("%s\n","arguments of Kparts() must have polynomial as arguments.");
1834:
1835: co = parts(KopPOLY(f),KopPOLY(v));
1836: obj = matrixOfPOLYToArray(co);
1837: return(obj);
1838: }
1839:
1840: struct object Kparts2(f,v)
1.7 takayama 1841: struct object f;
1842: struct object v;
1.1 maekawa 1843: {
1844: POLY ff;
1845: POLY vv;
1846: struct object obj;
1847: struct matrixOfPOLY *co;
1848: /* check the data type */
1849: if (f.tag != Spoly || v.tag != Spoly)
1850: errorKan1("%s\n","arguments of Kparts2() must have polynomial as arguments.");
1851:
1852: obj = parts2(KopPOLY(f),KopPOLY(v));
1853: return(obj);
1854: }
1855:
1856:
1857: struct object Kdegree(ob1,ob2)
1.7 takayama 1858: struct object ob1,ob2;
1.1 maekawa 1859: {
1860: if (ob1.tag != Spoly || ob2.tag != Spoly)
1861: errorKan1("%s\n","The arguments must be polynomials.");
1862:
1863: return(KpoInteger(pDegreeWrtV(KopPOLY(ob1),KopPOLY(ob2))));
1864: }
1865:
1866: struct object KringMap(obj)
1.7 takayama 1867: struct object obj;
1.1 maekawa 1868: {
1869: extern struct ring *CurrentRingp;
1870: extern struct ring *SyzRingp;
1871: POLY f;
1872: POLY r;
1873: if (obj.tag != Spoly)
1874: errorKan1("%s\n","The argments must be polynomial.");
1875: f = KopPOLY(obj);
1876: if (f ISZERO) return(obj);
1877: if (f->m->ringp == CurrentRingp) return(obj);
1878: if (f->m->ringp == CurrentRingp->next) {
1879: r = newCell(newCoeff(),newMonomial(CurrentRingp));
1880: r->coeffp->tag = POLY_COEFF;
1881: r->coeffp->val.f = f;
1882: return(KpoPOLY(r));
1883: }else if (f->m->ringp == SyzRingp) {
1884: return(KpoPOLY(f->coeffp->val.f));
1885: }
1886: errorKan1("%s\n","The ring map is not defined in this case.");
1887: }
1888:
1889:
1890: struct object Ksp(ob1,ob2)
1.7 takayama 1891: struct object ob1,ob2;
1.1 maekawa 1892: {
1893: struct spValue sv;
1894: struct object rob,cob;
1895: POLY f;
1896: if (ob1.tag != Spoly || ob2.tag != Spoly)
1897: errorKan1("%s\n","Ksp(): The arguments must be polynomials.");
1898: sv = (*sp)(ob1.lc.poly,ob2.lc.poly);
1899: f = ppAddv(ppMult(sv.a,KopPOLY(ob1)),
1.7 takayama 1900: ppMult(sv.b,KopPOLY(ob2)));
1.1 maekawa 1901: rob = newObjectArray(2);
1902: cob = newObjectArray(2);
1903: putoa(rob,1,KpoPOLY(f));
1904: putoa(cob,0,KpoPOLY(sv.a));
1905: putoa(cob,1,KpoPOLY(sv.b));
1906: putoa(rob,0,cob);
1907: return(rob);
1908: }
1909:
1910: struct object Khead(ob)
1.7 takayama 1911: struct object ob;
1.1 maekawa 1912: {
1913: if (ob.tag != Spoly) errorKan1("%s\n","Khead(): The argument should be a polynomial.");
1914: return(KpoPOLY(head( KopPOLY(ob))));
1915: }
1916:
1917:
1918: /* :eval */
1919: struct object Keval(obj)
1.7 takayama 1920: struct object obj;
1.1 maekawa 1921: {
1922: char *key;
1923: int size;
1924: struct object rob;
1925: rob = NullObject;
1926:
1927: if (obj.tag != Sarray)
1928: errorKan1("%s\n","[$key$ arguments] eval");
1929: if (getoaSize(obj) < 1)
1930: errorKan1("%s\n","[$key$ arguments] eval");
1931: if (getoa(obj,0).tag != Sdollar)
1932: errorKan1("%s\n","[$key$ arguments] eval");
1933: key = getoa(obj,0).lc.str;
1934: size = getoaSize(obj);
1935:
1936:
1937: return(rob);
1938: }
1939:
1940: /* :Utilities */
1941: char *KremoveSpace(str)
1.7 takayama 1942: char str[];
1.1 maekawa 1943: {
1944: int size;
1945: int start;
1946: int end;
1947: char *s;
1948: int i;
1949:
1950: size = strlen(str);
1951: for (start = 0; start <= size; start++) {
1952: if (str[start] > ' ') break;
1953: }
1954: for (end = size-1; end >= 0; end--) {
1955: if (str[end] > ' ') break;
1956: }
1957: if (start > end) return((char *) NULL);
1958: s = (char *) sGC_malloc(sizeof(char)*(end-start+2));
1959: if (s == (char *)NULL) errorKan1("%s\n","removeSpace(): No more memory.");
1960: for (i=0; i< end-start+1; i++)
1961: s[i] = str[i+start];
1962: s[end-start+1] = '\0';
1963: return(s);
1964: }
1965:
1966: struct object KtoRecords(ob)
1.7 takayama 1967: struct object ob;
1.1 maekawa 1968: {
1969: struct object obj;
1970: struct object tmp;
1971: int i;
1972: int size;
1973: char **argv;
1974:
1975: obj = NullObject;
1976: switch(ob.tag) {
1977: case Sdollar: break;
1978: default:
1979: errorKan1("%s","Argument of KtoRecords() must be a string enclosed by dollars.\n");
1980: break;
1981: }
1982: size = strlen(ob.lc.str)+3;
1983: argv = (char **) sGC_malloc((size+1)*sizeof(char *));
1984: if (argv == (char **)NULL)
1985: errorKan1("%s","No more memory.\n");
1986: size = KtoArgvbyCurryBrace(ob.lc.str,argv,size);
1987: if (size < 0)
1988: errorKan1("%s"," KtoRecords(): You have an error in the argument.\n");
1989:
1990: obj = newObjectArray(size);
1991: for (i=0; i<size; i++) {
1992: tmp.tag = Sdollar;
1993: tmp.lc.str = argv[i];
1994: (obj.rc.op)[i] = tmp;
1995: }
1996: return(obj);
1997: }
1998:
1999: int KtoArgvbyCurryBrace(str,argv,limit)
1.7 takayama 2000: char *str;
2001: char *argv[];
2002: int limit;
2003: /* This function returns argc */
2004: /* decompose into tokens by the separators
1.1 maekawa 2005: { }, [ ], and characters of which code is less than SPACE.
2006: Example. { } ---> nothing (argc=0)
2007: {x}----> x (argc=1)
2008: {x,y} --> x y (argc=2)
1.7 takayama 2009: {ab, y, z } --> ab y z (argc=3)
1.1 maekawa 2010: [[ab],c,d] --> [ab] c d
2011: */
2012: {
2013: int argc;
2014: int n;
2015: int i;
2016: int k;
2017: char *a;
2018: char *ident;
2019: int level = 0;
2020: int comma;
2021:
2022: if (str == (char *)NULL) {
2023: fprintf(stderr,"You use NULL string to toArgvbyCurryBrace()\n");
2024: return(0);
2025: }
2026:
2027: n = strlen(str);
2028: a = (char *) sGC_malloc(sizeof(char)*(n+3));
2029: a[0]=' ';
2030: strcpy(&(a[1]),str);
2031: n = strlen(a); a[0] = '\0';
2032: comma = -1;
2033: for (i=1; i<n; i++) {
2034: if (a[i] == '{' || a[i] == '[') level++;
2035: if (level <= 1 && ( a[i] == ',')) {a[i] = '\0'; ++comma;}
2036: if (level <= 1 && (a[i]=='{' || a[i]=='}' || a[i]=='[' || a[i]==']'))
2037: a[i] = '\0';
2038: if (a[i] == '}' || a[i] == ']') level--;
2039: if ((level <= 1) && (comma == -1) && ( a[i] > ' ')) comma = 0;
2040: }
2041:
2042: if (comma == -1) return(0);
2043:
2044: argc=0;
2045: for (i=0; i<n; i++) {
2046: if ((a[i] == '\0') && (a[i+1] != '\0')) ++argc;
2047: }
2048: if (argc > limit) return(-argc);
2049:
2050: k = 0;
2051: for (i=0; i<n; i++) {
2052: if ((a[i] == '\0') && (a[i+1] != '\0')) {
2053: ident = (char *) sGC_malloc(sizeof(char)*( strlen(&(a[i+1])) + 3));
2054: strcpy(ident,&(a[i+1]));
2055: argv[k] = KremoveSpace(ident);
2056: if (argv[k] != (char *)NULL) k++;
2057: if (k >= limit) errorKan1("%s\n","KtoArgvbyCurryBraces(): k>=limit.");
2058: }
2059: }
2060: argc = k;
2061: /*for (i=0; i<argc; i++) fprintf(stderr,"%d %s\n",i,argv[i]);*/
2062: return(argc);
2063: }
2064:
1.14 takayama 2065: struct object KstringToArgv(struct object ob) {
2066: struct object rob;
2067: char *s;
2068: int n,wc,i,inblank;
2069: char **argv;
2070: if (ob.tag != Sdollar)
2071: errorKan1("%s\n","KstringToArgv(): the argument must be a string.");
2072: n = strlen(KopString(ob));
2073: s = (char *) sGC_malloc(sizeof(char)*(n+2));
2074: if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory.");
2075: strcpy(s,KopString(ob));
2076: inblank = 1; wc = 0;
2077: for (i=0; i<n; i++) {
2078: if (inblank && (s[i] > ' ')) {
2079: wc++; inblank = 0;
2080: }else if ((!inblank) && (s[i] <= ' ')) {
2081: inblank = 1;
2082: }
2083: }
2084: argv = (char **) sGC_malloc(sizeof(char *)*(wc+2));
2085: argv[0] = NULL;
2086: inblank = 1; wc = 0;
2087: for (i=0; i<n; i++) {
2088: if (inblank && (s[i] > ' ')) {
2089: argv[wc] = &(s[i]); argv[wc+1]=NULL;
2090: wc++; inblank = 0;
2091: }else if ((inblank == 0) && (s[i] <= ' ')) {
2092: inblank = 1; s[i] = 0;
2093: }else if (inblank && (s[i] <= ' ')) {
2094: s[i] = 0;
2095: }
2096: }
2097:
2098: rob = newObjectArray(wc);
2099: for (i=0; i<wc; i++) {
2100: putoa(rob,i,KpoString(argv[i]));
2101: printf("%s\n",argv[i]);
2102: }
2103: return(rob);
2104: }
1.1 maekawa 2105:
2106: static void checkDuplicateName(xvars,dvars,n)
1.7 takayama 2107: char *xvars[];
2108: char *dvars[];
2109: int n;
1.1 maekawa 2110: {
2111: int i,j;
2112: char *names[N0*2];
2113: for (i=0; i<n; i++) {
2114: names[i] = xvars[i]; names[i+n] = dvars[i];
2115: }
2116: n = 2*n;
2117: for (i=0; i<n; i++) {
2118: for (j=i+1; j<n; j++) {
2119: if (strcmp(names[i],names[j]) == 0) {
1.7 takayama 2120: fprintf(stderr,"\n%d=%s, %d=%s\n",i,names[i],j,names[j]);
2121: errorKan1("%s\n","Duplicate definition of the name above in SetUpRing().");
1.1 maekawa 2122: }
2123: }
2124: }
2125: }
2126:
2127:
2128:
2129:
2130: struct object KooDiv2(ob1,ob2)
1.7 takayama 2131: struct object ob1,ob2;
1.1 maekawa 2132: {
2133: struct object rob = NullObject;
2134: POLY f;
2135: extern struct ring *CurrentRingp;
2136: int s,i;
2137: double d;
2138:
2139: switch (Lookup[ob1.tag][ob2.tag]) {
2140: case SpolySpoly:
2141: case SuniversalNumberSuniversalNumber:
2142: case SuniversalNumberSpoly:
2143: case SpolySuniversalNumber:
2144: rob = KnewRationalFunction0(copyObjectp(&ob1),copyObjectp(&ob2));
2145: KisInvalidRational(&rob);
2146: return(rob);
2147: break;
2148: case SarraySpoly:
2149: case SarraySuniversalNumber:
2150: case SarraySrationalFunction:
2151: s = getoaSize(ob1);
2152: rob = newObjectArray(s);
2153: for (i=0; i<s; i++) {
2154: putoa(rob,i,KooDiv2(getoa(ob1,i),ob2));
2155: }
2156: return(rob);
2157: break;
2158: case SpolySrationalFunction:
2159: case SrationalFunctionSpoly:
2160: case SrationalFunctionSrationalFunction:
2161: case SuniversalNumberSrationalFunction:
2162: case SrationalFunctionSuniversalNumber:
2163: rob = KoInverse(ob2);
2164: rob = KooMult(ob1,rob);
2165: return(rob);
2166: break;
2167:
2168: case SdoubleSdouble:
2169: d = KopDouble(ob2);
2170: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2171: return(KpoDouble( KopDouble(ob1) / d ));
2172: break;
2173: case SdoubleSinteger:
2174: case SdoubleSuniversalNumber:
2175: case SdoubleSrationalFunction:
2176: d = toDouble0(ob2);
2177: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2178: return(KpoDouble( KopDouble(ob1) / d) );
2179: break;
2180: case SintegerSdouble:
2181: case SuniversalNumberSdouble:
2182: case SrationalFunctionSdouble:
2183: d = KopDouble(ob2);
2184: if (d == 0.0) errorKan1("%s\n","KooDiv2, Division by zero.");
2185: return(KpoDouble( toDouble0(ob1) / d ) );
2186: break;
2187:
2188: default:
2189: warningKan("KooDiv2() has not supported yet these objects.\n");
2190: break;
2191: }
2192: return(rob);
2193: }
2194: /* Template
2195: case SrationalFunctionSrationalFunction:
2196: warningKan("Koo() has not supported yet these objects.\n");
2197: return(rob);
2198: break;
2199: case SpolySrationalFunction:
2200: warningKan("Koo() has not supported yet these objects.\n");
2201: return(rob);
2202: break;
2203: case SrationalFunctionSpoly:
2204: warningKan("Koo() has not supported yet these objects.\n");
2205: return(rob);
2206: break;
2207: case SuniversalNumberSrationalFunction:
2208: warningKan("Koo() has not supported yet these objects.\n");
2209: return(rob);
2210: break;
2211: case SrationalFunctionSuniversalNumber:
2212: warningKan("Koo() has not supported yet these objects.\n");
2213: return(rob);
2214: break;
2215: */
2216:
2217: int KisInvalidRational(op)
1.7 takayama 2218: objectp op;
1.1 maekawa 2219: {
2220: extern struct coeff *UniversalZero;
2221: if (op->tag != SrationalFunction) return(0);
2222: if (KisZeroObject(Kdenominator(*op))) {
2223: errorKan1("%s\n","KisInvalidRational(): zero division. You have f/0.");
2224: }
2225: if (KisZeroObject(Knumerator(*op))) {
2226: op->tag = SuniversalNumber;
2227: op->lc.universalNumber = UniversalZero;
2228: }
2229: return(0);
2230: }
2231:
2232: struct object KgbExtension(struct object obj)
2233: {
2234: char *key;
2235: int size;
2236: struct object keyo;
2237: struct object rob = NullObject;
2238: struct object obj1,obj2,obj3;
2239: POLY f1;
2240: POLY f2;
2241: POLY f3;
2242: POLY f;
2243: int m,i;
2244: struct pairOfPOLY pf;
1.16 takayama 2245: struct coeff *cont;
1.1 maekawa 2246:
2247: if (obj.tag != Sarray) errorKan1("%s\n","KgbExtension(): The argument must be an array.");
2248: size = getoaSize(obj);
2249: if (size < 1) errorKan1("%s\n","KgbExtension(): Empty array.");
2250: keyo = getoa(obj,0);
2251: if (keyo.tag != Sdollar) errorKan1("%s\n","KgbExtension(): No key word.");
2252: key = KopString(keyo);
2253:
2254: /* branch by the key word. */
2255: if (strcmp(key,"isReducible")==0) {
2256: if (size != 3) errorKan1("%s\n","[(isReducible) poly1 poly2] gbext.");
2257: obj1 = getoa(obj,1);
2258: obj2 = getoa(obj,2);
2259: if (obj1.tag != Spoly || obj2.tag != Spoly)
2260: errorKan1("%s\n","[(isReducible) poly1 poly2] gb.");
2261: f1 = KopPOLY(obj1);
2262: f2 = KopPOLY(obj2);
2263: rob = KpoInteger((*isReducible)(f1,f2));
2264: }else if (strcmp(key,"lcm") == 0) {
2265: if (size != 3) errorKan1("%s\n","[(lcm) poly1 poly2] gb.");
2266: obj1 = getoa(obj,1);
2267: obj2 = getoa(obj,2);
2268: if (obj1.tag != Spoly || obj2.tag != Spoly)
2269: errorKan1("%s\n","[(lcm) poly1 poly2] gbext.");
2270: f1 = KopPOLY(obj1);
2271: f2 = KopPOLY(obj2);
2272: rob = KpoPOLY((*lcm)(f1,f2));
2273: }else if (strcmp(key,"grade")==0) {
2274: if (size != 2) errorKan1("%s\n","[(grade) poly1 ] gbext.");
2275: obj1 = getoa(obj,1);
2276: if (obj1.tag != Spoly)
2277: errorKan1("%s\n","[(grade) poly1 ] gbext.");
2278: f1 = KopPOLY(obj1);
2279: rob = KpoInteger((*grade)(f1));
2280: }else if (strcmp(key,"mod")==0) {
2281: if (size != 3) errorKan1("%s\n","[(mod) poly num] gbext");
2282: obj1 = getoa(obj,1);
2283: obj2 = getoa(obj,2);
2284: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2285: errorKan1("%s\n","The datatype of the argument mismatch: [(mod) polynomial universalNumber] gbext");
2286: }
2287: rob = KpoPOLY( modulopZ(KopPOLY(obj1),KopUniversalNumber(obj2)) );
2288: }else if (strcmp(key,"tomodp")==0) {
2289: /* The ring must be a ring of characteristic p. */
2290: if (size != 3) errorKan1("%s\n","[(tomod) poly ring] gbext");
2291: obj1 = getoa(obj,1);
2292: obj2 = getoa(obj,2);
2293: if (obj1.tag != Spoly || obj2.tag != Sring) {
2294: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod) polynomial ring] gbext");
2295: }
2296: rob = KpoPOLY( modulop(KopPOLY(obj1),KopRingp(obj2)) );
2297: }else if (strcmp(key,"tomod0")==0) {
2298: /* Ring must be a ring of characteristic 0. */
2299: if (size != 3) errorKan1("%s\n","[(tomod0) poly ring] gbext");
2300: obj1 = getoa(obj,1);
2301: obj2 = getoa(obj,2);
2302: if (obj1.tag != Spoly || obj2.tag != Sring) {
2303: errorKan1("%s\n","The datatype of the argument mismatch: [(tomod0) polynomial ring] gbext");
2304: }
2305: errorKan1("%s\n","It has not been implemented.");
2306: rob = KpoPOLY( POLYNULL );
2307: }else if (strcmp(key,"divByN")==0) {
2308: if (size != 3) errorKan1("%s\n","[(divByN) poly num] gbext");
2309: obj1 = getoa(obj,1);
2310: obj2 = getoa(obj,2);
2311: if (obj1.tag != Spoly || obj2.tag != SuniversalNumber) {
2312: errorKan1("%s\n","The datatype of the argument mismatch: [(divByN) polynomial universalNumber] gbext");
2313: }
2314: pf = quotientByNumber(KopPOLY(obj1),KopUniversalNumber(obj2));
2315: rob = newObjectArray(2);
2316: putoa(rob,0,KpoPOLY(pf.first));
2317: putoa(rob,1,KpoPOLY(pf.second));
2318: }else if (strcmp(key,"isConstant")==0) {
2319: if (size != 2) errorKan1("%s\n","[(isConstant) poly ] gbext bool");
2320: obj1 = getoa(obj,1);
2321: if (obj1.tag != Spoly) {
2322: errorKan1("%s\n","The datatype of the argument mismatch: [(isConstant) polynomial] gbext");
2323: }
2324: return(KpoInteger(isConstant(KopPOLY(obj1))));
2325: }else if (strcmp(key,"schreyerSkelton") == 0) {
2326: if (size != 2) errorKan1("%s\n","[(schreyerSkelton) array_of_poly ] gbext array");
2327: obj1 = getoa(obj,1);
2328: return(KschreyerSkelton(obj1));
2329: }else if (strcmp(key,"lcoeff") == 0) {
2330: if (size != 2) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2331: obj1 = getoa(obj,1);
2332: if (obj1.tag != Spoly) errorKan1("%s\n","[(lcoeff) poly] gbext poly");
2333: f = KopPOLY(obj1);
2334: if (f == POLYNULL) return(KpoPOLY(f));
2335: return(KpoPOLY( newCell(coeffCopy(f->coeffp),newMonomial(f->m->ringp))));
2336: }else if (strcmp(key,"lmonom") == 0) {
2337: if (size != 2) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2338: obj1 = getoa(obj,1);
2339: if (obj1.tag != Spoly) errorKan1("%s\n","[(lmonom) poly] gbext poly");
2340: f = KopPOLY(obj1);
2341: if (f == POLYNULL) return(KpoPOLY(f));
2342: return(KpoPOLY( newCell(intToCoeff(1,f->m->ringp),monomialCopy(f->m))));
2343: }else if (strcmp(key,"toes") == 0) {
2344: if (size != 2) errorKan1("%s\n","[(toes) array] gbext poly");
2345: obj1 = getoa(obj,1);
2346: if (obj1.tag != Sarray) errorKan1("%s\n","[(toes) array] gbext poly");
2347: return(KvectorToSchreyer_es(obj1));
1.3 takayama 2348: }else if (strcmp(key,"toe_") == 0) {
2349: if (size != 2) errorKan1("%s\n","[(toe_) array] gbext poly");
2350: obj1 = getoa(obj,1);
2351: if (obj1.tag == Spoly) return(obj1);
2352: if (obj1.tag != Sarray) errorKan1("%s\n","[(toe_) array] gbext poly");
2353: return(KpoPOLY(arrayToPOLY(obj1)));
1.1 maekawa 2354: }else if (strcmp(key,"isOrdered") == 0) {
2355: if (size != 2) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2356: obj1 = getoa(obj,1);
2357: if (obj1.tag != Spoly) errorKan1("%s\n","[(isOrdered) poly] gbext poly");
2358: return(KisOrdered(obj1));
1.16 takayama 2359: }else if (strcmp(key,"reduceContent")==0) {
2360: if (size != 2) errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2361: obj1 = getoa(obj,1);
2362: if (obj1.tag != Spoly)
2363: errorKan1("%s\n","[(reduceContent) poly1 ] gbext.");
2364: f1 = KopPOLY(obj1);
2365: rob = newObjectArray(2);
2366: f1 = reduceContentOfPoly(f1,&cont);
2367: putoa(rob,0,KpoPOLY(f1));
2368: if (f1 == POLYNULL) {
2369: putoa(rob,1,KpoPOLY(f1));
2370: }else{
2371: putoa(rob,1,KpoPOLY(newCell(cont,newMonomial(f1->m->ringp))));
2372: }
1.17 ! takayama 2373: }else if (strcmp(key,"ord_ws_all")==0) {
! 2374: if (size != 3) errorKan1("%s\n","[(ord_ws_all) fv wv] gbext");
! 2375: obj1 = getoa(obj,1);
! 2376: obj2 = getoa(obj,2);
! 2377: rob = KordWsAll(obj1,obj2);
1.1 maekawa 2378: }else {
2379: errorKan1("%s\n","gbext : unknown tag.");
2380: }
2381: return(rob);
2382: }
2383:
2384: struct object KmpzExtension(struct object obj)
2385: {
2386: char *key;
2387: int size;
2388: struct object keyo;
2389: struct object rob = NullObject;
2390: struct object obj0,obj1,obj2,obj3;
2391: MP_INT *f;
2392: MP_INT *g;
2393: MP_INT *h;
2394: MP_INT *r0;
2395: MP_INT *r1;
2396: MP_INT *r2;
2397: int gi;
2398: extern struct ring *SmallRingp;
2399:
2400:
2401: if (obj.tag != Sarray) errorKan1("%s\n","KmpzExtension(): The argument must be an array.");
2402: size = getoaSize(obj);
2403: if (size < 1) errorKan1("%s\n","KmpzExtension(): Empty array.");
2404: keyo = getoa(obj,0);
2405: if (keyo.tag != Sdollar) errorKan1("%s\n","KmpzExtension(): No key word.");
2406: key = KopString(keyo);
2407:
2408: /* branch by the key word. */
2409: if (strcmp(key,"gcd")==0) {
2410: if (size != 3) errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2411: obj1 = getoa(obj,1);
2412: obj2 = getoa(obj,2);
2413: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2414: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2415: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2416: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2417: errorKan1("%s\n","[(gcd) universalNumber universalNumber] mpzext.");
2418: }
2419: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2420: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2421: r1 = newMP_INT();
2422: mpz_gcd(r1,f,g);
2423: rob.tag = SuniversalNumber;
2424: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2425: }else if (strcmp(key,"tdiv_qr")==0) {
2426: if (size != 3) errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2427: obj1 = getoa(obj,1);
2428: obj2 = getoa(obj,2);
2429: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2430: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2431: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2432: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2433: errorKan1("%s\n","[(tdiv_qr) universalNumber universalNumber] mpzext.");
2434: }
2435: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2436: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2437: r1 = newMP_INT();
2438: r2 = newMP_INT();
2439: mpz_tdiv_qr(r1,r2,f,g);
2440: obj1.tag = SuniversalNumber;
2441: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2442: obj2.tag = SuniversalNumber;
2443: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2444: rob = newObjectArray(2);
2445: putoa(rob,0,obj1); putoa(rob,1,obj2);
2446: } else if (strcmp(key,"cancel")==0) {
2447: if (size != 2) {
2448: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2449: }
2450: obj0 = getoa(obj,1);
2451: if (obj0.tag == SuniversalNumber) return(obj0);
2452: if (obj0.tag != SrationalFunction) {
2453: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2454: return(obj0);
2455: }
2456: obj1 = *(Knumerator(obj0));
2457: obj2 = *(Kdenominator(obj0));
2458: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber) {
2459: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2460: return(obj0);
2461: }
2462: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2463: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2464: errorKan1("%s\n","[(cancel) universalNumber/universalNumber] mpzext.");
2465: }
2466: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2467: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2468:
2469: r0 = newMP_INT();
2470: r1 = newMP_INT();
2471: r2 = newMP_INT();
2472: mpz_gcd(r0,f,g);
2473: mpz_divexact(r1,f,r0);
2474: mpz_divexact(r2,g,r0);
2475: obj1.tag = SuniversalNumber;
2476: obj1.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2477: obj2.tag = SuniversalNumber;
2478: obj2.lc.universalNumber = mpintToCoeff(r2,SmallRingp);
2479:
2480: rob = KnewRationalFunction0(copyObjectp(&obj1),copyObjectp(&obj2));
2481: KisInvalidRational(&rob);
2482: }else if (strcmp(key,"sqrt")==0 ||
1.7 takayama 2483: strcmp(key,"com")==0) {
1.1 maekawa 2484: /* One arg functions */
2485: if (size != 2) errorKan1("%s\n","[key num] mpzext");
2486: obj1 = getoa(obj,1);
2487: if (obj1.tag != SuniversalNumber)
2488: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2489: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber))
2490: errorKan1("%s\n","[key num] mpzext : num must be a universalNumber.");
2491: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2492: if (strcmp(key,"sqrt")==0) {
2493: r1 = newMP_INT();
2494: mpz_sqrt(r1,f);
2495: }else if (strcmp(key,"com")==0) {
2496: r1 = newMP_INT();
2497: mpz_com(r1,f);
2498: }
2499: rob.tag = SuniversalNumber;
2500: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2501: }else if (strcmp(key,"probab_prime_p")==0 ||
1.7 takayama 2502: strcmp(key,"and") == 0 ||
2503: strcmp(key,"ior")==0) {
1.1 maekawa 2504: /* Two args functions */
2505: if (size != 3) errorKan1("%s\n","[key num1 num2] mpzext.");
2506: obj1 = getoa(obj,1);
2507: obj2 = getoa(obj,2);
2508: if (obj1.tag != SuniversalNumber || obj2.tag != SuniversalNumber)
2509: errorKan1("%s\n","[key num1 num2] mpzext.");
2510: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2511: ! is_this_coeff_MP_INT(obj2.lc.universalNumber)) {
1.1 maekawa 2512: errorKan1("%s\n","[key num1 num2] mpzext.");
2513: }
2514: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2515: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2516: if (strcmp(key,"probab_prime_p")==0) {
2517: gi = (int) mpz_get_si(g);
2518: if (mpz_probab_prime_p(f,gi)) {
1.7 takayama 2519: rob = KpoInteger(1);
1.1 maekawa 2520: }else {
1.7 takayama 2521: rob = KpoInteger(0);
1.1 maekawa 2522: }
2523: }else if (strcmp(key,"and")==0) {
2524: r1 = newMP_INT();
2525: mpz_and(r1,f,g);
2526: rob.tag = SuniversalNumber;
2527: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2528: }else if (strcmp(key,"ior")==0) {
2529: r1 = newMP_INT();
2530: mpz_ior(r1,f,g);
2531: rob.tag = SuniversalNumber;
2532: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2533: }
2534:
2535: }else if (strcmp(key,"powm")==0) {
2536: /* three args */
2537: if (size != 4) errorKan1("%s\n","[key num1 num2 num3] mpzext");
2538: obj1 = getoa(obj,1); obj2 = getoa(obj,2); obj3 = getoa(obj,3);
2539: if (obj1.tag != SuniversalNumber ||
2540: obj2.tag != SuniversalNumber ||
2541: obj3.tag != SuniversalNumber ) {
2542: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2543: }
2544: if (! is_this_coeff_MP_INT(obj1.lc.universalNumber) ||
1.7 takayama 2545: ! is_this_coeff_MP_INT(obj2.lc.universalNumber) ||
2546: ! is_this_coeff_MP_INT(obj3.lc.universalNumber)) {
1.1 maekawa 2547: errorKan1("%s\n","[key num1 num2 num3] mpzext : num1, num2 and num3 must be universalNumbers.");
2548: }
2549: f = coeff_to_MP_INT(obj1.lc.universalNumber);
2550: g = coeff_to_MP_INT(obj2.lc.universalNumber);
2551: h = coeff_to_MP_INT(obj3.lc.universalNumber);
2552: if (mpz_sgn(g) < 0) errorKan1("%s\n","[(powm) base exp mod] mpzext : exp must not be negative.");
2553: r1 = newMP_INT();
2554: mpz_powm(r1,f,g,h);
2555: rob.tag = SuniversalNumber;
2556: rob.lc.universalNumber = mpintToCoeff(r1,SmallRingp);
2557: }else {
2558: errorKan1("%s\n","mpzExtension(): Unknown tag.");
2559: }
2560: return(rob);
2561: }
2562:
2563:
2564: /** : context */
2565: struct object KnewContext(struct object superObj,char *name) {
2566: struct context *cp;
2567: struct object ob;
2568: if (superObj.tag != Sclass) {
2569: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2570: }
2571: if (superObj.lc.ival != CLASSNAME_CONTEXT) {
2572: errorKan1("%s\n","The argument of KnewContext must be a Class.Context");
2573: }
2574: cp = newContext0((struct context *)(superObj.rc.voidp),name);
2575: ob.tag = Sclass;
2576: ob.lc.ival = CLASSNAME_CONTEXT;
2577: ob.rc.voidp = cp;
2578: return(ob);
2579: }
2580:
2581: struct object KcreateClassIncetance(struct object ob1,
1.7 takayama 2582: struct object ob2,
2583: struct object ob3)
1.1 maekawa 2584: {
2585: /* [class-tag super-obj] size [class-tag] cclass */
2586: struct object ob4;
2587: int size,size2,i;
2588: struct object ob5;
2589: struct object rob;
2590:
2591: if (ob1.tag != Sarray)
2592: errorKan1("%s\n","cclass: The first argument must be an array.");
2593: if (getoaSize(ob1) < 1)
2594: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2595: ob4 = getoa(ob1,0);
2596: if (ectag(ob4) != CLASSNAME_CONTEXT)
2597: errorKan1("%s\n","cclass: The first argument must be [class-tag ....].");
2598:
2599: if (ob2.tag != Sinteger)
2600: errorKan1("%s\n","cclass: The second argument must be an integer.");
2601: size = KopInteger(ob2);
2602: if (size < 1)
2603: errorKan1("%s\n","cclass: The size must be > 0.");
2604:
2605: if (ob3.tag != Sarray)
2606: errorKan1("%s\n","cclass: The third argument must be an array.");
2607: if (getoaSize(ob3) < 1)
2608: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
2609: ob5 = getoa(ob3,0);
2610: if (ectag(ob5) != CLASSNAME_CONTEXT)
2611: errorKan1("%s\n","cclass: The third argument must be [class-tag].");
1.7 takayama 2612:
1.1 maekawa 2613: rob = newObjectArray(size);
2614: putoa(rob,0,ob5);
2615: if (getoaSize(ob1) < size) size2 = getoaSize(ob1);
2616: else size2 = size;
2617: for (i=1; i<size2; i++) {
2618: putoa(rob,i,getoa(ob1,i));
2619: }
2620: for (i=size2; i<size; i++) {
2621: putoa(rob,i,NullObject);
2622: }
2623: return(rob);
2624: }
2625:
2626:
2627: struct object KpoDouble(double a) {
2628: struct object rob;
2629: rob.tag = Sdouble;
2630: /* rob.lc.dbl = (double *)sGC_malloc_atomic(sizeof(double)); */
2631: rob.lc.dbl = (double *)sGC_malloc(sizeof(double));
2632: if (rob.lc.dbl == (double *)NULL) {
2633: fprintf(stderr,"No memory.\n"); exit(10);
2634: }
2635: *(rob.lc.dbl) = a;
2636: return(rob);
2637: }
2638:
2639: double toDouble0(struct object ob) {
2640: double r;
2641: int r3;
2642: struct object ob2;
2643: struct object ob3;
2644: switch(ob.tag) {
2645: case Sinteger:
2646: return( (double) (KopInteger(ob)) );
2647: case SuniversalNumber:
2648: return((double) coeffToInt(ob.lc.universalNumber));
2649: case SrationalFunction:
2650: /* The argument is assumed to be a rational number. */
2651: ob2 = newObjectArray(2); ob3 = KpoString("cancel");
2652: putoa(ob2,0,ob3); putoa(ob2,1,ob);
2653: ob = KmpzExtension(ob2);
2654: ob2 = *Knumerator(ob); ob3 = *Kdenominator(ob);
2655: r3 = coeffToInt(ob3.lc.universalNumber);
2656: if (r3 == 0) {
2657: errorKan1("%s\n","toDouble0(): Division by zero.");
2658: break;
2659: }
2660: r = ((double) coeffToInt(ob2.lc.universalNumber)) / ((double)r3);
2661: return(r);
2662: case Sdouble:
2663: return( KopDouble(ob) );
2664: default:
2665: errorKan1("%s\n","toDouble0(): This type of conversion is not supported.");
2666: break;
2667: }
2668: return(0.0);
2669: }
2670:
2671: struct object KpoGradedPolySet(struct gradedPolySet *grD) {
2672: struct object rob;
2673: rob.tag = Sclass;
2674: rob.lc.ival = CLASSNAME_GradedPolySet;
2675: rob.rc.voidp = (void *) grD;
2676: return(rob);
2677: }
2678:
2679: static char *getspace0(int a) {
2680: char *s;
2681: a = (a > 0? a:-a);
2682: s = (char *) sGC_malloc(a+1);
2683: if (s == (char *)NULL) {
2684: errorKan1("%s\n","no more memory.");
2685: }
2686: return(s);
2687: }
2688: struct object KdefaultPolyRing(struct object ob) {
2689: struct object rob;
2690: int i,j,k,n;
2691: struct object ob1,ob2,ob3,ob4,ob5;
2692: struct object t1;
2693: char *s1;
2694: extern struct ring *CurrentRingp;
2695: static struct ring *a[N0];
2696:
2697: rob = NullObject;
2698: if (ob.tag != Sinteger) {
2699: errorKan1("%s\n","KdefaultPolyRing(): the argument must be integer.");
2700: }
2701: n = KopInteger(ob);
2702: if (n <= 0) {
2703: /* initializing */
2704: for (i=0; i<N0; i++) {
2705: a[i] = (struct ring*) NULL;
2706: }
2707: return(rob);
2708: }
2709:
2710: if ( a[n] != (struct ring*)NULL) return(KpoRingp(a[n]));
2711:
2712: /* Let's construct ring of polynomials of 2n variables */
2713: /* x variables */
2714: ob1 = newObjectArray(n);
2715: for (i=0; i<n; i++) {
2716: s1 = getspace0(1+ ((n-i)/10) + 1);
2717: sprintf(s1,"x%d",n-i);
2718: putoa(ob1,i,KpoString(s1));
2719: }
2720: ob2 = newObjectArray(n);
2721: s1 = getspace0(1);
2722: sprintf(s1,"h");
2723: putoa(ob2,0,KpoString(s1));
2724: for (i=1; i<n; i++) {
2725: s1 = getspace0(1+((n+n-i)/10)+1);
2726: sprintf(s1,"x%d",n+n-i);
2727: putoa(ob2,i,KpoString(s1));
2728: }
2729:
2730: ob3 = newObjectArray(9);
2731: putoa(ob3,0,KpoInteger(0));
2732: for (i=1; i<9; i++) {
2733: putoa(ob3,i,KpoInteger(n));
2734: }
2735:
2736: ob4 = newObjectArray(2*n);
2737: t1 = newObjectArray(2*n);
2738: for (i=0; i<2*n; i++) {
2739: putoa(t1,i,KpoInteger(1));
2740: }
2741: putoa(ob4,0,t1);
2742: for (i=1; i<2*n; i++) {
2743: t1 = newObjectArray(2*n);
2744: for (j=0; j<2*n; j++) {
2745: putoa(t1,j,KpoInteger(0));
2746: if (j == (2*n-i)) {
1.7 takayama 2747: putoa(t1,j,KpoInteger(-1));
1.1 maekawa 2748: }
2749: }
2750: putoa(ob4,i,t1);
2751: }
2752:
2753: ob5 = newObjectArray(2);
2754: putoa(ob5,0,KpoString("mpMult"));
2755: putoa(ob5,1,KpoString("poly"));
2756:
2757: KsetUpRing(ob1,ob2,ob3,ob4,ob5);
2758: a[n] = CurrentRingp;
2759: return(KpoRingp(a[n]));
2760: }
2761:
2762:
2763:
2764:
2765:
2766: /******************************************************************
2767: error handler
2768: ******************************************************************/
2769:
2770: errorKan1(str,message)
1.7 takayama 2771: char *str;
2772: char *message;
1.1 maekawa 2773: {
2774: extern char *GotoLabel;
2775: extern int GotoP;
2776: extern int ErrorMessageMode;
2777: char tmpc[1024];
1.10 takayama 2778: cancelAlarm();
1.1 maekawa 2779: if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {
2780: sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");
2781: if (strlen(message) < 900) {
2782: strcat(tmpc,message);
2783: }
2784: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
2785: }
2786: if (ErrorMessageMode != 1) {
2787: fprintf(stderr,"\nERROR(kanExport[0|1].c): ");
2788: fprintf(stderr,str,message);
2789: }
2790: /* fprintf(stderr,"Hello "); */
2791: if (GotoP) {
2792: /* fprintf(stderr,"Hello. GOTO "); */
2793: fprintf(Fstack,"The interpreter was looking for the label <<%s>>. It is also aborted.\n",GotoLabel);
2794: GotoP = 0;
2795: }
2796: stdOperandStack(); contextControl(CCRESTORE);
2797: /* fprintf(stderr,"Now. Long jump!\n"); */
1.8 takayama 2798: #if defined(__CYGWIN__)
2799: siglongjmp(EnvOfStackMachine,1);
2800: #else
1.1 maekawa 2801: longjmp(EnvOfStackMachine,1);
1.8 takayama 2802: #endif
1.1 maekawa 2803: }
2804:
2805: warningKan(str)
1.7 takayama 2806: char *str;
1.1 maekawa 2807: {
2808: extern int WarningMessageMode;
2809: extern int Strict;
2810: char tmpc[1024];
2811: if (WarningMessageMode == 1 || WarningMessageMode == 2) {
2812: sprintf(tmpc,"\nWARNING(kanExport[0|1].c): ");
2813: if (strlen(str) < 900) {
2814: strcat(tmpc,str);
2815: }
2816: pushErrorStack(KnewErrorPacket(SerialCurrent,-1,tmpc));
2817: }
2818: if (WarningMessageMode != 1) {
2819: fprintf(stderr,"\nWARNING(kanExport[0|1].c): ");
2820: fprintf(stderr,str);
2821: fprintf(stderr,"\n");
2822: }
2823: /* if (Strict) errorKan1("%s\n"," "); */
2824: if (Strict) errorKan1("%s\n",str);
1.4 takayama 2825: return(0);
2826: }
2827:
2828: warningKanNoStrictMode(str)
1.7 takayama 2829: char *str;
1.4 takayama 2830: {
2831: extern int Strict;
2832: int t;
2833: t = Strict;
2834: Strict = 0;
2835: warningKan(str);
2836: Strict = t;
1.1 maekawa 2837: return(0);
2838: }
2839:
2840:
2841:
2842:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>