Annotation of OpenXM/src/kan96xx/Kan/kanExport0.c, Revision 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