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