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