Annotation of OpenXM/src/kan96xx/Kan/kanExport1.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: static int Message = 1;
! 12: extern int KanGBmessage;
! 13:
! 14: /** :kan, :ring */
! 15: struct object Kreduction(f,set)
! 16: struct object f;
! 17: struct object set;
! 18: {
! 19: POLY r;
! 20: struct gradedPolySet *grG;
! 21: struct syz0 syz;
! 22: struct object rob;
! 23: int flag;
! 24: extern int ReduceLowerTerms;
! 25:
! 26: if (f.tag != Spoly) errorKan1("%s\n","Kreduction(): the first argument must be a polynomial.");
! 27:
! 28: if (ectag(set) == CLASSNAME_GradedPolySet) {
! 29: grG = KopGradedPolySet(set);
! 30: flag = 1;
! 31: }else{
! 32: if (set.tag != Sarray) errorKan1("%s\n","Kreduction(): the second argument must be a set of polynomials.");
! 33: grG = arrayToGradedPolySet(set);
! 34: flag = 0;
! 35: }
! 36: if (ReduceLowerTerms) {
! 37: r = (*reductionCdr)(f.lc.poly,grG,1,&syz);
! 38: }else{
! 39: r = (*reduction)(f.lc.poly,grG,1,&syz);
! 40: }
! 41: if (flag) {
! 42: rob = newObjectArray(3);
! 43: putoa(rob,0,KpoPOLY(r));
! 44: putoa(rob,1,KpoPOLY(syz.cf));
! 45: putoa(rob,2,syzPolyToArray(countGradedPolySet(grG),syz.syz,grG));
! 46: }else {
! 47: rob = newObjectArray(4);
! 48: putoa(rob,0,KpoPOLY(r));
! 49: putoa(rob,1,KpoPOLY(syz.cf));
! 50: putoa(rob,2,syzPolyToArray(getoaSize(set),syz.syz,grG));
! 51: putoa(rob,3,gradedPolySetToArray(grG,1));
! 52: }
! 53: return(rob);
! 54: }
! 55:
! 56: struct object Kgroebner(ob)
! 57: struct object ob;
! 58: {
! 59: int needSyz = 0;
! 60: int needBack = 0;
! 61: int needInput = 0;
! 62: int countDown = 0;
! 63: int cdflag = 0;
! 64: struct object ob1,ob2,ob2c;
! 65: int i;
! 66: struct gradedPolySet *grG;
! 67: struct pair *grP;
! 68: struct arrayOfPOLY *a;
! 69: struct object rob;
! 70: struct gradedPolySet *grBases;
! 71: struct matrixOfPOLY *mp;
! 72: struct matrixOfPOLY *backwardMat;
! 73: struct object ob1New;
! 74: extern char *F_groebner;
! 75: extern int CheckHomogenization;
! 76: extern int StopDegree;
! 77: int sdflag = 0;
! 78: int forceReduction = 0;
! 79:
! 80: int ob1Size, ob2Size, noZeroEntry;
! 81: int *ob1ToOb2;
! 82: int *ob1ZeroPos;
! 83: int method;
! 84: int j,k;
! 85: struct object rob2;
! 86: struct object rob3;
! 87: struct object rob4;
! 88: struct ring *myring;
! 89: POLY f;
! 90: struct object orgB;
! 91: struct object newB;
! 92: struct object orgC;
! 93: struct object newC;
! 94: static struct object paddingVector(struct object ob, int table[], int m);
! 95: static struct object unitVector(int pos, int size,struct ring *r);
! 96: extern struct ring *CurrentRingp;
! 97:
! 98: StopDegree = 0x7fff;
! 99:
! 100: if (ob.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array.");
! 101: switch(getoaSize(ob)) {
! 102: case 1:
! 103: needBack = 0; needSyz = 0; needInput = 0;
! 104: ob1 = getoa(ob,0);
! 105: break;
! 106: case 2:
! 107: ob1 = getoa(ob,0);
! 108: ob2 = getoa(ob,1);
! 109: if (ob2.tag != Sarray) {
! 110: errorKan1("%s\n","Kgroebner(): The options must be given by an array.");
! 111: }
! 112: for (i=0; i<getoaSize(ob2); i++) {
! 113: ob2c = getoa(ob2,i);
! 114: if (ob2c.tag == Sdollar) {
! 115: if (strcmp(ob2c.lc.str,"needBack")==0) {
! 116: needBack = 1;
! 117: }else if (strcmp(ob2c.lc.str,"needSyz")==0) {
! 118: if (!needBack) {
! 119: /* warningKan("Kgroebner(): needBack is automatically set."); */
! 120: }
! 121: needSyz = needBack = 1;
! 122: }else if (strcmp(ob2c.lc.str,"forceReduction")==0) {
! 123: forceReduction = 1;
! 124: }else if (strcmp(ob2c.lc.str,"countDown")==0) {
! 125: countDown = 1; cdflag = 1;
! 126: if (needSyz) {
! 127: warningKan("Kgroebner(): needSyz is automatically turned off.");
! 128: needSyz = 0;
! 129: }
! 130: }else if (strcmp(ob2c.lc.str,"StopDegree")==0) {
! 131: StopDegree = 0; sdflag = 1;
! 132: if (needSyz) {
! 133: warningKan("Kgroebner(): needSyz is automatically turned off.");
! 134: needSyz = 0;
! 135: }
! 136: }else {
! 137: warningKan("Unknown keyword for options.");
! 138: }
! 139: }else if (ob2c.tag == Sinteger) {
! 140: if (cdflag) {
! 141: cdflag = 0;
! 142: countDown = KopInteger(ob2c);
! 143: }else if (sdflag) {
! 144: sdflag = 0;
! 145: StopDegree = KopInteger(ob2c);
! 146: }
! 147: }
! 148: }
! 149: break;
! 150: default:
! 151: errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");
! 152: }
! 153:
! 154: if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");
! 155: ob1New = newObjectArray(getoaSize(ob1));
! 156: for (i=0; i< getoaSize(ob1); i++) {
! 157: if (getoa(ob1,i).tag == Spoly) {
! 158: putoa(ob1New,i,getoa(ob1,i));
! 159: }else if (getoa(ob1,i).tag == Sarray) {
! 160: /* If the generater is given as an array, flatten it. */
! 161: putoa(ob1New,i,KpoPOLY( arrayToPOLY(getoa(ob1,i))));
! 162: }else{
! 163: errorKan1("%s\n","Kgroebner(): The elements must be polynomials or array of polynomials.");
! 164: }
! 165: /* getoa(ob1,i) is poly, now check the homogenization. */
! 166: if (CheckHomogenization) {
! 167: if ((strcmp(F_groebner,"standard")==0) &&
! 168: !isHomogenized(KopPOLY(getoa(ob1New,i)))) {
! 169: fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));
! 170: errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");
! 171: }
! 172: }
! 173: }
! 174: ob1 = ob1New;
! 175:
! 176: /* To handle the input with zero entries. For debug, debug/gr.sm1*/
! 177: ob1Size = getoaSize(ob1);
! 178: ob2Size = 0; myring = CurrentRingp;
! 179: for (i=0; i<ob1Size; i++) {
! 180: if (KopPOLY(getoa(ob1,i)) != POLYNULL) ob2Size++;
! 181: }
! 182: if (ob2Size == ob1Size) noZeroEntry = 1;
! 183: else noZeroEntry = 0;
! 184: if (ob1Size == 0) {
! 185: if (needBack && needSyz) {
! 186: rob = newObjectArray(3);
! 187: putoa(rob,0,newObjectArray(0));
! 188: putoa(rob,1,newObjectArray(0));
! 189: putoa(rob,2,newObjectArray(0));
! 190: }else if (needBack) {
! 191: rob = newObjectArray(2);
! 192: putoa(rob,0,newObjectArray(0));
! 193: putoa(rob,1,newObjectArray(0));
! 194: }else {
! 195: rob = newObjectArray(1);
! 196: putoa(rob,0,newObjectArray(0));
! 197: }
! 198: return(rob);
! 199: }
! 200: /* Assume ob1size > 0 */
! 201: if (ob2Size == 0) {
! 202: rob2 = newObjectArray(1); putoa(rob2,0,KpoPOLY(POLYNULL));
! 203: if (needBack && needSyz) {
! 204: rob = newObjectArray(3);
! 205: putoa(rob,0,rob2);
! 206: rob3 = newObjectArray(1);
! 207: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
! 208: putoa(rob,1,rob3);
! 209: rob4 = newObjectArray(ob1Size);
! 210: for (i=0; i<ob1Size; i++) {
! 211: putoa(rob4,i,unitVector(i,ob1Size,myring));
! 212: }
! 213: putoa(rob,2,rob4);
! 214: }else if (needBack) {
! 215: rob = newObjectArray(2);
! 216: putoa(rob,0,rob2);
! 217: rob3 = newObjectArray(1);
! 218: putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
! 219: putoa(rob,1,rob3);
! 220: }else {
! 221: rob = newObjectArray(1);
! 222: putoa(rob,0,rob2);
! 223: }
! 224: return(rob);
! 225: }
! 226: /* Assume ob1Size , ob2Size > 0 */
! 227: ob2 = newObjectArray(ob2Size);
! 228: ob1ToOb2 = (int *)GC_malloc(sizeof(int)*ob1Size);
! 229: ob1ZeroPos = (int *)GC_malloc(sizeof(int)*(ob1Size-ob2Size+1));
! 230: if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");
! 231: j = 0; k = 0;
! 232: for (i=0; i<ob1Size; i++) {
! 233: f = KopPOLY(getoa(ob1,i));
! 234: if (f != POLYNULL) {
! 235: myring = f->m->ringp;
! 236: putoa(ob2,j,KpoPOLY(f));
! 237: ob1ToOb2[i] = j; j++;
! 238: }else{
! 239: ob1ToOb2[i] = -1;
! 240: ob1ZeroPos[k] = i; k++;
! 241: }
! 242: }
! 243:
! 244: a = arrayToArrayOfPOLY(ob2);
! 245: grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction);
! 246:
! 247: if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {
! 248: warningKan("The options needBack and needSyz are ignored.");
! 249: needBack = needSyz = 0;
! 250: }
! 251:
! 252: /*return(gradedPolySetToGradedArray(grG,0));*/
! 253: if (needBack && needSyz) {
! 254: rob = newObjectArray(3);
! 255: if (Message && KanGBmessage) {
! 256: printf("Computing the backward transformation ");
! 257: fflush(stdout);
! 258: }
! 259: getBackwardTransformation(grG); /* mark and syz is modified. */
! 260: if (KanGBmessage) printf("Done.\n");
! 261:
! 262: /* Computing the syzygies. */
! 263: if (Message && KanGBmessage) {
! 264: printf("Computing the syzygies ");
! 265: fflush(stdout);
! 266: }
! 267: mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);
! 268: if (KanGBmessage) printf("Done.\n");
! 269:
! 270: putoa(rob,0,gradedPolySetToArray(grG,0));
! 271: putoa(rob,1,matrixOfPOLYToArray(backwardMat));
! 272: putoa(rob,2,matrixOfPOLYToArray(mp));
! 273: }else if (needBack) {
! 274: rob = newObjectArray(2);
! 275: if (Message && KanGBmessage) {
! 276: printf("Computing the backward transformation.....");
! 277: fflush(stdout);
! 278: }
! 279: getBackwardTransformation(grG); /* mark and syz is modified. */
! 280: if (KanGBmessage) printf("Done.\n");
! 281: putoa(rob,0,gradedPolySetToArray(grG,0));
! 282: putoa(rob,1,getBackwardArray(grG));
! 283: }else {
! 284: rob = newObjectArray(1);
! 285: putoa(rob,0,gradedPolySetToArray(grG,0));
! 286: }
! 287:
! 288: /* To handle zero entries in the input. */
! 289: if (noZeroEntry) {
! 290: return(rob);
! 291: }
! 292: method = getoaSize(rob);
! 293: switch(method) {
! 294: case 1:
! 295: return(rob);
! 296: break;
! 297: case 2:
! 298: orgB = getoa(rob,1); /* backward transformation. */
! 299: newB = newObjectArray(getoaSize(orgB));
! 300: for (i=0; i<getoaSize(orgB); i++) {
! 301: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
! 302: }
! 303: rob2 = newObjectArray(2);
! 304: putoa(rob2,0,getoa(rob,0));
! 305: putoa(rob2,1,newB);
! 306: return(rob2);
! 307: break;
! 308: case 3:
! 309: orgB = getoa(rob,1); /* backward transformation. */
! 310: newB = newObjectArray(getoaSize(orgB));
! 311: for (i=0; i<getoaSize(orgB); i++) {
! 312: putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
! 313: }
! 314: orgC = getoa(rob,2);
! 315: newC = newObjectArray(getoaSize(orgC)+ob1Size-ob2Size);
! 316: for (i=0; i<getoaSize(orgC); i++) {
! 317: putoa(newC, i, paddingVector(getoa(orgC,i),ob1ToOb2,ob1Size));
! 318: }
! 319: for (i = getoaSize(orgC), j = 0; i<getoaSize(orgC)+ob1Size-ob2Size; i++,j++) {
! 320: putoa(newC,i,unitVector(ob1ZeroPos[j],ob1Size,myring));
! 321: }
! 322: rob2 = newObjectArray(3);
! 323: putoa(rob2,0,getoa(rob,0));
! 324: putoa(rob2,1,newB);
! 325: putoa(rob2,2,newC);
! 326: return(rob2);
! 327: break;
! 328: default:
! 329: errorKan1("%s","Kgroebner: unknown method.");
! 330: }
! 331: }
! 332:
! 333: static struct object paddingVector(struct object ob, int table[], int m)
! 334: {
! 335: struct object rob;
! 336: int i;
! 337: rob = newObjectArray(m);
! 338: for (i=0; i<m; i++) {
! 339: if (table[i] != -1) {
! 340: putoa(rob,i,getoa(ob,table[i]));
! 341: }else{
! 342: putoa(rob,i,KpoPOLY(POLYNULL));
! 343: }
! 344: }
! 345: return(rob);
! 346: }
! 347:
! 348: static struct object unitVector(int pos, int size,struct ring *r)
! 349: {
! 350: struct object rob;
! 351: int i;
! 352: POLY one;
! 353: rob = newObjectArray(size);
! 354: for (i=0; i<size; i++) {
! 355: putoa(rob,i,KpoPOLY(POLYNULL));
! 356: }
! 357: if ((0 <= pos) && (pos < size)) {
! 358: putoa(rob,pos, KpoPOLY(cxx(1,0,0,r)));
! 359: }
! 360: return(rob);
! 361: }
! 362:
! 363:
! 364:
! 365: /* :misc */
! 366:
! 367: #define INITGRADE 3
! 368: #define INITSIZE 0
! 369:
! 370: struct gradedPolySet *arrayToGradedPolySet(ob)
! 371: struct object ob;
! 372: {
! 373: int n,i,grd,ind;
! 374: POLY f;
! 375: struct gradedPolySet *grG;
! 376: int serial;
! 377: extern int Sugar;
! 378:
! 379: if (ob.tag != Sarray) errorKan1("%s\n","arrayToGradedPolySet(): the argument must be array.");
! 380: n = getoaSize(ob);
! 381: for (i=0; i<n; i++) {
! 382: if (getoa(ob,i).tag != Spoly)
! 383: errorKan1("%s\n","arrayToGradedPolySet(): the elements must be polynomials.");
! 384: }
! 385: grG = newGradedPolySet(INITGRADE);
! 386:
! 387: for (i=0; i<grG->lim; i++) {
! 388: grG->polys[i] = newPolySet(INITSIZE);
! 389: }
! 390: for (i=0; i<n; i++) {
! 391: f = KopPOLY(getoa(ob,i));
! 392: grd = -1; whereInG(grG,f,&grd,&ind,Sugar);
! 393: serial = i;
! 394: grG = putPolyInG(grG,f,grd,ind,(struct syz0 *)NULL,1,serial);
! 395: }
! 396: return(grG);
! 397: }
! 398:
! 399:
! 400: struct object polySetToArray(ps,keepRedundant)
! 401: struct polySet *ps;
! 402: int keepRedundant;
! 403: {
! 404: int n,i,j;
! 405: struct object ob;
! 406: if (ps == (struct polySet *)NULL) return(newObjectArray(0));
! 407: n = 0;
! 408: if (keepRedundant) {
! 409: n = ps->size;
! 410: }else{
! 411: for (i=0; i<ps->size; i++) {
! 412: if (ps->del[i] == 0) ++n;
! 413: }
! 414: }
! 415: ob = newObjectArray(n);
! 416: j = 0;
! 417: for (i=0; i<ps->size; i++) {
! 418: if (keepRedundant || (ps->del[i] == 0)) {
! 419: putoa(ob,j,KpoPOLY(ps->g[i]));
! 420: j++;
! 421: }
! 422: }
! 423: return(ob);
! 424: }
! 425:
! 426:
! 427: struct object gradedPolySetToGradedArray(gps,keepRedundant)
! 428: struct gradedPolySet *gps;
! 429: int keepRedundant;
! 430: {
! 431: struct object ob,vec;
! 432: int i;
! 433: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
! 434: ob = newObjectArray(gps->maxGrade +1);
! 435: vec = newObjectArray(gps->maxGrade);
! 436: for (i=0; i<gps->maxGrade; i++) {
! 437: putoa(vec,i,KpoInteger(i));
! 438: putoa(ob,i+1,polySetToArray(gps->polys[i],keepRedundant));
! 439: }
! 440: putoa(ob,0,vec);
! 441: return(ob);
! 442: }
! 443:
! 444:
! 445: struct object gradedPolySetToArray(gps,keepRedundant)
! 446: struct gradedPolySet *gps;
! 447: int keepRedundant;
! 448: {
! 449: struct object ob,vec;
! 450: struct polySet *ps;
! 451: int k;
! 452: int i,j;
! 453: int size;
! 454: if (gps == (struct gradedPolySet *)NULL) return(NullObject);
! 455: size = 0;
! 456: for (i=0; i<gps->maxGrade; i++) {
! 457: ps = gps->polys[i];
! 458: if (keepRedundant) {
! 459: size += ps->size;
! 460: }else{
! 461: for (j=0; j<ps->size; j++) {
! 462: if (ps->del[j] == 0) ++size;
! 463: }
! 464: }
! 465: }
! 466:
! 467: ob = newObjectArray(size);
! 468: k = 0;
! 469: for (i=0; i<gps->maxGrade; i++) {
! 470: ps = gps->polys[i];
! 471: for (j=0; j<ps->size; j++) {
! 472: if (keepRedundant || (ps->del[j] == 0)) {
! 473: putoa(ob,k,KpoPOLY(ps->g[j]));
! 474: k++;
! 475: }
! 476: }
! 477: }
! 478: return(ob);
! 479: }
! 480:
! 481:
! 482: /* serial == -1 : It's not in the marix input. */
! 483: struct object syzPolyToArray(size,f,grG)
! 484: int size;
! 485: POLY f;
! 486: struct gradedPolySet *grG;
! 487: {
! 488: struct object ob;
! 489: int i,g0,i0,serial;
! 490:
! 491: ob = newObjectArray(size);
! 492: for (i=0; i<size; i++) {
! 493: putoa(ob,i,KpoPOLY(ZERO));
! 494: }
! 495:
! 496: while (f != POLYNULL) {
! 497: g0 = srGrade(f);
! 498: i0 = srIndex(f);
! 499: serial = grG->polys[g0]->serial[i0];
! 500: if (serial < 0) {
! 501: errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");
! 502: }
! 503: if (KopPOLY(getoa(ob,serial)) != ZERO) {
! 504: errorKan1("%s\n","syzPolyToArray(): syzygy polynomial is broken.");
! 505: }
! 506: putoa(ob,serial,KpoPOLY(f->coeffp->val.f));
! 507: f = f->next;
! 508: }
! 509: return(ob);
! 510: }
! 511:
! 512: struct object getBackwardArray(grG)
! 513: struct gradedPolySet *grG;
! 514: {
! 515: /* use serial, del. cf. getBackwardTransformation(). */
! 516: int inputSize,outputSize;
! 517: int i,j,k;
! 518: struct object ob;
! 519: struct polySet *ps;
! 520:
! 521: inputSize = 0; outputSize = 0;
! 522: for (i=0; i<grG->maxGrade; i++) {
! 523: ps = grG->polys[i];
! 524: for (j=0; j<ps->size; j++) {
! 525: if (ps->serial[j] >= 0) ++inputSize;
! 526: if (ps->del[j] == 0) ++outputSize;
! 527: }
! 528: }
! 529:
! 530: ob = newObjectArray(outputSize);
! 531: k = 0;
! 532: for (i=0; i<grG->maxGrade; i++) {
! 533: ps = grG->polys[i];
! 534: for (j=0; j<ps->size; j++) {
! 535: if (ps->del[j] == 0) {
! 536: putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));
! 537: k++;
! 538: }
! 539: }
! 540: }
! 541: return(ob);
! 542: }
! 543:
! 544:
! 545: POLY arrayToPOLY(ob)
! 546: struct object ob;
! 547: {
! 548: int size,i;
! 549: struct object f;
! 550: POLY r;
! 551: static int nn,mm,ll,cc,n,m,l,c;
! 552: static struct ring *cr = (struct ring *)NULL;
! 553: POLY ff,ee;
! 554: MONOMIAL tf;
! 555:
! 556: if (ob.tag != Sarray) errorKan1("%s\n","arrayToPOLY(): The argument must be an array.");
! 557: size = getoaSize(ob);
! 558: r = ZERO;
! 559: for (i=0; i<size; i++) {
! 560: f = getoa(ob,i);
! 561: if (f.tag != Spoly) errorKan1("%s\n","arrayToPOLY(): The elements must be polynomials.");
! 562: ff = KopPOLY(f);
! 563: if (ff != ZERO) {
! 564: tf = ff->m;
! 565: if (tf->ringp != cr) {
! 566: n = tf->ringp->n;
! 567: m = tf->ringp->m;
! 568: l = tf->ringp->l;
! 569: c = tf->ringp->c;
! 570: nn = tf->ringp->nn;
! 571: mm = tf->ringp->mm;
! 572: ll = tf->ringp->ll;
! 573: cc = tf->ringp->cc;
! 574: cr = tf->ringp;
! 575: }
! 576: if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);
! 577: else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);
! 578: else if (l-ll >0) ee = cxx(1,l-1,i,tf->ringp);
! 579: else if (c-cc >0) ee = cxx(1,c-1,i,tf->ringp);
! 580: else ee = ZERO;
! 581: r = ppAddv(r,ppMult(ee,ff));
! 582: }
! 583: }
! 584: return(r);
! 585: }
! 586:
! 587: struct object POLYToArray(ff)
! 588: POLY ff;
! 589: {
! 590:
! 591: static int nn,mm,ll,cc,n,m,l,c;
! 592: static struct ring *cr = (struct ring *)NULL;
! 593: POLY ee;
! 594: MONOMIAL tf;
! 595: int k,i,matn,size;
! 596: struct matrixOfPOLY *mat;
! 597: POLY ex,sizep;
! 598: struct object ob;
! 599:
! 600: if (ff != ZERO) {
! 601: tf = ff->m;
! 602: if (tf->ringp != cr) {
! 603: n = tf->ringp->n;
! 604: m = tf->ringp->m;
! 605: l = tf->ringp->l;
! 606: c = tf->ringp->c;
! 607: nn = tf->ringp->nn;
! 608: mm = tf->ringp->mm;
! 609: ll = tf->ringp->ll;
! 610: cc = tf->ringp->cc;
! 611: cr = tf->ringp;
! 612: }
! 613: if (n-nn >0) ee = cxx(1,n-1,1,tf->ringp);
! 614: else if (m-mm >0) ee = cxx(1,m-1,1,tf->ringp);
! 615: else if (l-ll >0) ee = cxx(1,l-1,1,tf->ringp);
! 616: else if (c-cc >0) ee = cxx(1,c-1,1,tf->ringp);
! 617: else ee = ZERO;
! 618: }else{
! 619: ob = newObjectArray(1);
! 620: getoa(ob,0) = KpoPOLY(ZERO);
! 621: return(ob);
! 622: }
! 623: mat = parts(ff,ee);
! 624: matn = mat->n;
! 625: sizep = getMatrixOfPOLY(mat,0,0);
! 626: if (sizep == ZERO) size = 1;
! 627: else size = coeffToInt(sizep->coeffp)+1;
! 628: ob = newObjectArray(size);
! 629: for (i=0; i<size; i++) getoa(ob,i) = KpoPOLY(ZERO);
! 630: for (i=0; i<matn; i++) {
! 631: ex = getMatrixOfPOLY(mat,0,i);
! 632: if (ex == ZERO) k = 0;
! 633: else {
! 634: k = coeffToInt(ex->coeffp);
! 635: }
! 636: getoa(ob,k) = KpoPOLY(getMatrixOfPOLY(mat,1,i));
! 637: }
! 638: return(ob);
! 639: }
! 640:
! 641: static int isThereh(f)
! 642: POLY f;
! 643: {
! 644: POLY t;
! 645: if (f == 0) return(0);
! 646: t = f;
! 647: while (t != POLYNULL) {
! 648: if (t->m->e[0].D) return(1);
! 649: t = t->next;
! 650: }
! 651: return(0);
! 652: }
! 653:
! 654: struct object homogenizeObject(ob,gradep)
! 655: struct object ob;
! 656: int *gradep;
! 657: {
! 658: struct object rob,ob1;
! 659: int maxg;
! 660: int gr,flag,i,d,size;
! 661: struct ring *rp;
! 662: POLY f;
! 663: extern struct ring *CurrentRingp;
! 664: extern int Homogenize_vec;
! 665:
! 666: if (!Homogenize_vec) return(homogenizeObject_vec(ob,gradep));
! 667:
! 668: switch(ob.tag) {
! 669: case Spoly:
! 670: if (isThereh(KopPOLY(ob))) {
! 671: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
! 672: errorKan1("%s\n","homogenizeObject(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
! 673: }
! 674: f = homogenize( KopPOLY(ob) );
! 675: *gradep = (*grade)(f);
! 676: return(KpoPOLY(f));
! 677: break;
! 678: case Sarray:
! 679: size = getoaSize(ob);
! 680: if (size == 0) {
! 681: errorKan1("%s\n","homogenizeObject() is called for the empty array.");
! 682: }
! 683: rob = newObjectArray(size);
! 684: flag = 0;
! 685: ob1 = getoa(ob,0);
! 686: ob1 = homogenizeObject(ob1,&gr);
! 687: maxg = gr;
! 688: getoa(rob,0) = ob1;
! 689: for (i=1; i<size; i++) {
! 690: ob1 = getoa(ob,i);
! 691: ob1 = homogenizeObject(ob1,&gr);
! 692: if (gr > maxg) {
! 693: maxg = gr;
! 694: }
! 695: getoa(rob,i) = ob1;
! 696: }
! 697: maxg = maxg+size-1;
! 698: if (1) {
! 699: rp = oRingp(rob);
! 700: if (rp == (struct ring *)NULL) rp = CurrentRingp;
! 701: for (i=0; i<size; i++) {
! 702: gr = oGrade(getoa(rob,i));
! 703: /**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/
! 704: if (maxg > gr) {
! 705: f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */
! 706: getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));
! 707: }
! 708: }
! 709: }
! 710: *gradep = maxg;
! 711: return(rob);
! 712: break;
! 713: default:
! 714: errorKan1("%s\n","homogenizeObject(): Invalid argument data type.");
! 715: break;
! 716: }
! 717: }
! 718:
! 719: struct object homogenizeObject_vec(ob,gradep)
! 720: struct object ob;
! 721: int *gradep;
! 722: {
! 723: struct object rob,ob1;
! 724: int maxg;
! 725: int gr,i,size;
! 726: POLY f;
! 727: extern struct ring *CurrentRingp;
! 728:
! 729: switch(ob.tag) {
! 730: case Spoly:
! 731: if (isThereh(KopPOLY(ob))) {
! 732: fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
! 733: errorKan1("%s\n","homogenizeObject_vec(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
! 734: }
! 735: if (containVectorVariable(KopPOLY(ob))) {
! 736: errorKan1("%s\n","homogenizedObject_vec(): The given polynomial contains a variable to express a vector component.");
! 737: }
! 738: f = homogenize( KopPOLY(ob) );
! 739: *gradep = (*grade)(f);
! 740: return(KpoPOLY(f));
! 741: break;
! 742: case Sarray:
! 743: size = getoaSize(ob);
! 744: if (size == 0) {
! 745: errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");
! 746: }
! 747: rob = newObjectArray(size);
! 748: for (i=0; i<size; i++) {
! 749: ob1 = getoa(ob,i);
! 750: ob1 = homogenizeObject_vec(ob1,&gr);
! 751: if (i==0) maxg = gr;
! 752: else {
! 753: maxg = (maxg > gr? maxg: gr);
! 754: }
! 755: putoa(rob,i,ob1);
! 756: }
! 757: *gradep = maxg;
! 758: return(rob);
! 759: break;
! 760: default:
! 761: errorKan1("%s\n","homogenizeObject_vec(): Invalid argument data type.");
! 762: break;
! 763: }
! 764: }
! 765:
! 766: struct ring *oRingp(ob)
! 767: struct object ob;
! 768: {
! 769: struct ring *rp,*rptmp;
! 770: int i,size;
! 771: POLY f;
! 772: switch(ob.tag) {
! 773: case Spoly:
! 774: f = KopPOLY(ob);
! 775: if (f == ZERO) return((struct ring *)NULL);
! 776: return( f->m->ringp);
! 777: break;
! 778: case Sarray:
! 779: size = getoaSize(ob);
! 780: rp = (struct ring *)NULL;
! 781: for (i=0; i<size; i++) {
! 782: rptmp = oRingp(getoa(ob,i));
! 783: if (rptmp != (struct ring *)NULL) rp = rptmp;
! 784: return(rp);
! 785: }
! 786: break;
! 787: default:
! 788: errorKan1("%s\n","oRingp(): Invalid argument data type.");
! 789: break;
! 790: }
! 791: }
! 792:
! 793: int oGrade(ob)
! 794: struct object ob;
! 795: {
! 796: int i,size;
! 797: POLY f;
! 798: int maxg,tmpg;
! 799: switch(ob.tag) {
! 800: case Spoly:
! 801: f = KopPOLY(ob);
! 802: return( (*grade)(f) );
! 803: break;
! 804: case Sarray:
! 805: size = getoaSize(ob);
! 806: if (size == 0) return(0);
! 807: maxg = oGrade(getoa(ob,0));
! 808: for (i=1; i<size; i++) {
! 809: tmpg = oGrade(getoa(ob,i));
! 810: if (tmpg > maxg) maxg = tmpg;
! 811: }
! 812: return(maxg);
! 813: break;
! 814: default:
! 815: errorKan1("%s\n","oGrade(): Invalid data type for the argument.");
! 816: break;
! 817: }
! 818: }
! 819:
! 820:
! 821: struct object oPrincipalPart(ob)
! 822: struct object ob;
! 823: {
! 824: POLY f;
! 825: struct object rob;
! 826:
! 827: switch(ob.tag) {
! 828: case Spoly:
! 829: f = KopPOLY(ob);
! 830: return( KpoPOLY(POLYToPrincipalPart(f)));
! 831: break;
! 832: default:
! 833: errorKan1("%s\n","oPrincipalPart(): Invalid data type for the argument.");
! 834: break;
! 835: }
! 836: }
! 837: struct object oInitW(ob,oWeight)
! 838: struct object ob;
! 839: struct object oWeight;
! 840: {
! 841: POLY f;
! 842: struct object rob;
! 843: int w[2*N0];
! 844: int n,i;
! 845: struct object ow;
! 846:
! 847: if (oWeight.tag != Sarray) {
! 848: errorKan1("%s\n","oInitW(): the second argument must be array.");
! 849: }
! 850: n = getoaSize(oWeight);
! 851: if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");
! 852: for (i=0; i<n; i++) {
! 853: ow = getoa(oWeight,i);
! 854: if (ow.tag != Sinteger) {
! 855: errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");
! 856: }
! 857: w[i] = KopInteger(ow);
! 858: }
! 859: switch(ob.tag) {
! 860: case Spoly:
! 861: f = KopPOLY(ob);
! 862: return( KpoPOLY(POLYToInitW(f,w)));
! 863: break;
! 864: default:
! 865: errorKan1("%s\n","oInitW(): Argument must be polynomial.");
! 866: break;
! 867: }
! 868: }
! 869:
! 870: int KpolyLength(POLY f) {
! 871: int size;
! 872: if (f == POLYNULL) return(1);
! 873: size = 0;
! 874: while (f != POLYNULL) {
! 875: f = f->next;
! 876: size++;
! 877: }
! 878: return(size);
! 879: }
! 880:
! 881: int validOutputOrder(int ord[],int n) {
! 882: int i,j,flag;
! 883: for (i=0; i<n; i++) {
! 884: flag = 0;
! 885: for (j=0; j<n; j++) {
! 886: if (ord[j] == i) flag = 1;
! 887: }
! 888: if (flag == 0) return(0); /* invalid */
! 889: }
! 890: return(1);
! 891: }
! 892:
! 893: struct object KsetOutputOrder(struct object ob, struct ring *rp)
! 894: {
! 895: int n,i;
! 896: struct object ox;
! 897: struct object otmp;
! 898: int *xxx;
! 899: int *ddd;
! 900: if (ob.tag != Sarray) {
! 901: errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...]");
! 902: }
! 903: n = rp->n;
! 904: ox = ob;
! 905: if (getoaSize(ox) != 2*n) {
! 906: errorKan1("%s\n","KsetOutputOrder(): 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.");
! 907: }
! 908: xxx = (int *)sGC_malloc(sizeof(int)*n*2);
! 909: if (xxx == NULL ) {
! 910: errorKan1("%s\n","KsetOutputOrder(): no more memory.");
! 911: }
! 912: for (i=0; i<2*n; i++) {
! 913: otmp = getoa(ox,i);
! 914: if(otmp.tag != Sinteger) {
! 915: errorKan1("%s\n","KsetOutputOrder(): elements must be integers.");
! 916: }
! 917: xxx[i] = KopInteger(otmp);
! 918: }
! 919: if (!validOutputOrder(xxx,2*n)) {
! 920: errorKan1("%s\n","KsetOutputOrder(): Invalid output order for variables.");
! 921: }
! 922: rp->outputOrder = xxx;
! 923: return(ob);
! 924: }
! 925:
! 926: struct object KschreyerSkelton(struct object g)
! 927: {
! 928: struct object rob;
! 929: struct object ij;
! 930: struct object ab;
! 931: struct object tt;
! 932: struct arrayOfPOLY *ap;
! 933: struct arrayOfMonomialSyz ans;
! 934: int k;
! 935: rob.tag = Snull;
! 936: if (g.tag != Sarray) {
! 937: errorKan1("%s\n","KschreyerSkelton(): argument must be an array of polynomials.");
! 938: }
! 939:
! 940: ap = arrayToArrayOfPOLY(g);
! 941: ans = schreyerSkelton(*ap);
! 942:
! 943: rob = newObjectArray(ans.size);
! 944: for (k=0; k<ans.size; k++) {
! 945: ij = newObjectArray(2);
! 946: putoa(ij,0, KpoInteger(ans.p[k]->i));
! 947: putoa(ij,1, KpoInteger(ans.p[k]->j));
! 948: ab = newObjectArray(2);
! 949: putoa(ab,0, KpoPOLY(ans.p[k]->a));
! 950: putoa(ab,1, KpoPOLY(ans.p[k]->b));
! 951: tt = newObjectArray(2);
! 952: putoa(tt,0, ij);
! 953: putoa(tt,1, ab);
! 954: putoa(rob,k,tt);
! 955: }
! 956: return(rob);
! 957: }
! 958:
! 959: struct object KisOrdered(struct object of)
! 960: {
! 961: if (of.tag != Spoly) {
! 962: errorKan1("%s\n","KisOrdered(): argument must be a polynomial.");
! 963: }
! 964: if (isOrdered(KopPOLY(of))) {
! 965: return(KpoInteger(1));
! 966: }else{
! 967: return(KpoInteger(0));
! 968: }
! 969: }
! 970:
! 971: struct object KvectorToSchreyer_es(struct object obarray)
! 972: {
! 973: int m,i;
! 974: int nn;
! 975: POLY f;
! 976: POLY g;
! 977: struct object ob;
! 978: struct ring *rp;
! 979: if (obarray.tag != Sarray) {
! 980: errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
! 981: }
! 982: m = getoaSize(obarray);
! 983: f = POLYNULL;
! 984: for (i=0; i<m; i++) {
! 985: ob = getoa(obarray,i);
! 986: if (ob.tag != Spoly) {
! 987: errorKan1("%s\n","KvectorToSchreyer_es(): each element of the array must be a polynomial.");
! 988: }
! 989: g = KopPOLY(ob);
! 990: if (g != POLYNULL) {
! 991: rp = g->m->ringp;
! 992: nn = rp->nn;
! 993: /* g = es^i g */
! 994: g = mpMult_poly(cxx(1,nn,i,rp), g);
! 995: if (!isOrdered(g)) {
! 996: errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");
! 997: }
! 998: f = ppAdd(f,g);
! 999: }
! 1000: }
! 1001: return(KpoPOLY(f));
! 1002: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to kanExport1.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan