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