OpenXM/src/kan96xx/Kan/kanExport1.c - diff

Return to kanExport1.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport1.c between version 1.1 and 1.20

version 1.1, 1999/10/08 02:12:02

version 1.20, 2005/06/16 08:40:04

Line 1

/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.19 2005/06/16 06:54:55 takayama Exp $ */

#include <stdio.h>

#include "datatype.h"

#include "stackm.h"

Line 11

Line 12

static int Message = 1;

extern int KanGBmessage;

struct object DegreeShifto = OINIT;

int DegreeShifto_size = 0;

int *DegreeShifto_vec = NULL;

struct object DegreeShiftD = OINIT;

int DegreeShiftD_size = 0;

int *DegreeShiftD_vec = NULL;

/** :kan, :ring */

struct object Kreduction(f,set)

struct object f;

struct object set;

{

POLY r;

struct gradedPolySet *grG;

struct syz0 syz;

struct object rob;

struct object rob = OINIT;

int flag;

extern int ReduceLowerTerms;

Line 38 struct object set;

Line 46 struct object set;

}else{

r = (*reduction)(f.lc.poly,grG,1,&syz);

}

/* outputGradedPolySet(grG,0); */

if (flag) {

rob = newObjectArray(3);

putoa(rob,0,KpoPOLY(r));

Line 54 struct object set;

Line 63 struct object set;

}

struct object Kgroebner(ob)

struct object ob;

{

int needSyz = 0;

int needBack = 0;

int needInput = 0;

int countDown = 0;

int cdflag = 0;

struct object ob1,ob2,ob2c;

struct object ob1 = OINIT;

struct object ob2 = OINIT;

struct object ob2c = OINIT;

int i;

struct gradedPolySet *grG;

struct pair *grP;

struct arrayOfPOLY *a;

struct object rob;

struct object rob = OINIT;

struct gradedPolySet *grBases;

struct matrixOfPOLY *mp;

struct matrixOfPOLY *backwardMat;

struct object ob1New;

struct object ob1New = OINIT;

extern char *F_groebner;

extern int CheckHomogenization;

extern int StopDegree;

int sdflag = 0;

int forceReduction = 0;

int reduceOnly = 0;

int gbCheck = 0; /* see @s/2005/06/16-note.pdf */

int ob1Size, ob2Size, noZeroEntry;

int *ob1ToOb2;

int *ob1ZeroPos;

int method;

int j,k;

struct object rob2;

struct object rob2 = OINIT;

struct object rob3;

struct object rob3 = OINIT;

struct object rob4;

struct object rob4 = OINIT;

struct ring *myring;

POLY f;

struct object orgB;

struct object orgB = OINIT;

struct object newB;

struct object newB = OINIT;

struct object orgC;

struct object orgC = OINIT;

struct object newC;

struct object newC = OINIT;

static struct object paddingVector(struct object ob, int table[], int m);

static struct object unitVector(int pos, int size,struct ring *r);

extern struct ring *CurrentRingp;

Line 109 struct object ob;

Line 122 struct object ob;

if (ob2.tag != Sarray) {

errorKan1("%s\n","Kgroebner(): The options must be given by an array.");

}

/* Note: If you add a new option, change /configureGroebnerOption, too */

for (i=0; i<getoaSize(ob2); i++) {

ob2c = getoa(ob2,i);

if (ob2c.tag == Sdollar) {

if (strcmp(ob2c.lc.str,"needBack")==0) {

needBack = 1;

}else if (strcmp(ob2c.lc.str,"needSyz")==0) {

if (!needBack) {

/* warningKan("Kgroebner(): needBack is automatically set."); */

}

needSyz = needBack = 1;

}else if (strcmp(ob2c.lc.str,"forceReduction")==0) {

forceReduction = 1;

}else if (strcmp(ob2c.lc.str,"countDown")==0) {

}else if (strcmp(ob2c.lc.str,"reduceOnly")==0) {

countDown = 1; cdflag = 1;

reduceOnly = 1;

if (needSyz) {

}else if (strcmp(ob2c.lc.str,"gbCheck")==0) {

warningKan("Kgroebner(): needSyz is automatically turned off.");

gbCheck = 1;

needSyz = 0;

}else if (strcmp(ob2c.lc.str,"countDown")==0) {

}

countDown = 1; cdflag = 1;

}else if (strcmp(ob2c.lc.str,"StopDegree")==0) {

if (needSyz) {

StopDegree = 0; sdflag = 1;

warningKan("Kgroebner(): needSyz is automatically turned off.");

if (needSyz) {

needSyz = 0;

warningKan("Kgroebner(): needSyz is automatically turned off.");

}

needSyz = 0;

}else if (strcmp(ob2c.lc.str,"StopDegree")==0) {

}

StopDegree = 0; sdflag = 1;

}else {

if (needSyz) {

warningKan("Unknown keyword for options.");

warningKan("Kgroebner(): needSyz is automatically turned off.");

}

needSyz = 0;

}

}else {

warningKan("Unknown keyword for options.");

}

}else if (ob2c.tag == Sinteger) {

if (cdflag) {

cdflag = 0;

countDown = KopInteger(ob2c);

}else if (sdflag) {

sdflag = 0;

StopDegree = KopInteger(ob2c);

}

break;

default:

errorKan1("%s\n","Kgroebner(): [ [polynomials] ] or [[polynomials] [options]].");

}

if (ob1.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array. Example: [ [$x-1$ . $x y -2$ .] [$needBack$ $needSyz$ $needInput$]] ");

ob1New = newObjectArray(getoaSize(ob1));

for (i=0; i< getoaSize(ob1); i++) {

Line 165 struct object ob;

Line 183 struct object ob;

/* getoa(ob1,i) is poly, now check the homogenization. */

if (CheckHomogenization) {

if ((strcmp(F_groebner,"standard")==0) &&

!isHomogenized(KopPOLY(getoa(ob1New,i)))) {

fprintf(stderr,"\n%s",KPOLYToString(KopPOLY(getoa(ob1New,i))));

errorKan1("%s\n","Kgroebner(): The above polynomial is not homogenized. cf. homogenize.");

}

Line 208 struct object ob;

Line 226 struct object ob;

putoa(rob,1,rob3);

rob4 = newObjectArray(ob1Size);

for (i=0; i<ob1Size; i++) {

putoa(rob4,i,unitVector(i,ob1Size,myring));

}

putoa(rob,2,rob4);

}else if (needBack) {

Line 225 struct object ob;

Line 243 struct object ob;

}

/* Assume ob1Size , ob2Size > 0 */

ob2 = newObjectArray(ob2Size);

ob1ToOb2 = (int *)GC_malloc(sizeof(int)*ob1Size);

ob1ToOb2 = (int *)sGC_malloc(sizeof(int)*ob1Size);

ob1ZeroPos = (int *)GC_malloc(sizeof(int)*(ob1Size-ob2Size+1));

ob1ZeroPos = (int *)sGC_malloc(sizeof(int)*(ob1Size-ob2Size+1));

if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory.");

j = 0; k = 0;

for (i=0; i<ob1Size; i++) {

Line 242 struct object ob;

Line 260 struct object ob;

}

a = arrayToArrayOfPOLY(ob2);

grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction);

grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction,reduceOnly,gbCheck);

if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {

warningKan("The options needBack and needSyz are ignored.");

Line 265 struct object ob;

Line 283 struct object ob;

fflush(stdout);

}

mp = getSyzygy(grG,grP->next,&grBases,&backwardMat);

if (mp == NULL) errorKan1("%s\n","Internal error in getSyzygy(). BUG of sm1.");

if (KanGBmessage) printf("Done.\n");

putoa(rob,0,gradedPolySetToArray(grG,0));

Line 286 struct object ob;

Line 305 struct object ob;

}

/* To handle zero entries in the input. */

rob=KsetAttribute(rob,KpoString("gb"),KpoInteger(grG->gb));

putoa(rob,0,KsetAttribute(getoa(rob,0),KpoString("gb"),KpoInteger(grG->gb)));

if (noZeroEntry) {

return(rob);

}

Line 303 struct object ob;

Line 324 struct object ob;

rob2 = newObjectArray(2);

putoa(rob2,0,getoa(rob,0));

putoa(rob2,1,newB);

rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));

return(rob2);

break;

case 3:

Line 323 struct object ob;

Line 345 struct object ob;

putoa(rob2,0,getoa(rob,0));

putoa(rob2,1,newB);

putoa(rob2,2,newC);

rob2=KsetAttribute(rob2,KpoString("gb"),KpoInteger(grG->gb));

return(rob2);

break;

default:

Line 332 struct object ob;

Line 355 struct object ob;

static struct object paddingVector(struct object ob, int table[], int m)

{

struct object rob;

struct object rob = OINIT;

int i;

rob = newObjectArray(m);

for (i=0; i<m; i++) {

Line 347 static struct object paddingVector(struct object ob, i

Line 370 static struct object paddingVector(struct object ob, i

static struct object unitVector(int pos, int size,struct ring *r)

{

struct object rob;

struct object rob = OINIT;

int i;

POLY one;

rob = newObjectArray(size);

Line 368 static struct object unitVector(int pos, int size,stru

Line 391 static struct object unitVector(int pos, int size,stru

#define INITSIZE 0

struct gradedPolySet *arrayToGradedPolySet(ob)

struct object ob;

{

int n,i,grd,ind;

POLY f;

Line 398 struct object ob;

Line 421 struct object ob;

struct object polySetToArray(ps,keepRedundant)

struct polySet *ps;

int keepRedundant;

{

int n,i,j;

struct object ob;

struct object ob = OINIT;

if (ps == (struct polySet *)NULL) return(newObjectArray(0));

n = 0;

if (keepRedundant) {

Line 425 int keepRedundant;

Line 448 int keepRedundant;

struct object gradedPolySetToGradedArray(gps,keepRedundant)

struct gradedPolySet *gps;

int keepRedundant;

{

struct object ob,vec;

struct object ob = OINIT;

struct object vec = OINIT;

int i;

if (gps == (struct gradedPolySet *)NULL) return(NullObject);

ob = newObjectArray(gps->maxGrade +1);

Line 443 int keepRedundant;

Line 467 int keepRedundant;

struct object gradedPolySetToArray(gps,keepRedundant)

struct gradedPolySet *gps;

int keepRedundant;

{

struct object ob,vec;

struct object ob = OINIT;

struct object vec = OINIT;

struct polySet *ps;

int k;

int i,j;

Line 459 int keepRedundant;

Line 484 int keepRedundant;

size += ps->size;

}else{

for (j=0; j<ps->size; j++) {

if (ps->del[j] == 0) ++size;

}

Line 470 int keepRedundant;

Line 495 int keepRedundant;

ps = gps->polys[i];

for (j=0; j<ps->size; j++) {

if (keepRedundant || (ps->del[j] == 0)) {

putoa(ob,k,KpoPOLY(ps->g[j]));

k++;

}

Line 481 int keepRedundant;

Line 506 int keepRedundant;

/* serial == -1 : It's not in the marix input. */

struct object syzPolyToArray(size,f,grG)

int size;

POLY f;

struct gradedPolySet *grG;

{

struct object ob;

struct object ob = OINIT;

int i,g0,i0,serial;

ob = newObjectArray(size);

Line 495 struct gradedPolySet *grG;

Line 520 struct gradedPolySet *grG;

while (f != POLYNULL) {

g0 = srGrade(f);

i0 = srIndex(f);

serial = grG->polys[g0]->serial[i0];

if (serial < 0) {

errorKan1("%s\n","syzPolyToArray(): invalid serial[i] of grG.");

Line 510 struct gradedPolySet *grG;

Line 535 struct gradedPolySet *grG;

}

struct object getBackwardArray(grG)

struct gradedPolySet *grG;

{

/* use serial, del. cf. getBackwardTransformation(). */

int inputSize,outputSize;

int i,j,k;

struct object ob;

struct object ob = OINIT;

struct polySet *ps;

inputSize = 0; outputSize = 0;

Line 533 struct gradedPolySet *grG;

Line 558 struct gradedPolySet *grG;

ps = grG->polys[i];

for (j=0; j<ps->size; j++) {

if (ps->del[j] == 0) {

putoa(ob,k,syzPolyToArray(inputSize,ps->syz[j]->syz,grG));

k++;

}

Line 543 struct gradedPolySet *grG;

Line 568 struct gradedPolySet *grG;

POLY arrayToPOLY(ob)

struct object ob;

{

int size,i;

struct object f;

struct object f = OINIT;

POLY r;

static int nn,mm,ll,cc,n,m,l,c;

static struct ring *cr = (struct ring *)NULL;

Line 563 struct object ob;

Line 588 struct object ob;

if (ff != ZERO) {

tf = ff->m;

if (tf->ringp != cr) {

n = tf->ringp->n;

m = tf->ringp->m;

l = tf->ringp->l;

c = tf->ringp->c;

nn = tf->ringp->nn;

mm = tf->ringp->mm;

ll = tf->ringp->ll;

cc = tf->ringp->cc;

cr = tf->ringp;

}

if (n-nn >0) ee = cxx(1,n-1,i,tf->ringp);

else if (m-mm >0) ee = cxx(1,m-1,i,tf->ringp);

Line 585 struct object ob;

Line 610 struct object ob;

}

struct object POLYToArray(ff)

POLY ff;

{

static int nn,mm,ll,cc,n,m,l,c;

Line 595 POLY ff;

Line 620 POLY ff;

int k,i,matn,size;

struct matrixOfPOLY *mat;

POLY ex,sizep;

struct object ob;

struct object ob = OINIT;

if (ff != ZERO) {

tf = ff->m;

Line 639 POLY ff;

Line 664 POLY ff;

}

static int isThereh(f)

POLY f;

{

POLY t;

if (f == 0) return(0);

Line 652 POLY f;

Line 677 POLY f;

}

struct object homogenizeObject(ob,gradep)

struct object ob;

int *gradep;

{

struct object rob,ob1;

struct object rob = OINIT;

struct object ob1 = OINIT;

int maxg;

int gr,flag,i,d,size;

struct ring *rp;

Line 683 int *gradep;

Line 709 int *gradep;

rob = newObjectArray(size);

flag = 0;

ob1 = getoa(ob,0);

if (ob1.tag == Sdollar) return(homogenizeObject_go(ob,gradep));

ob1 = homogenizeObject(ob1,&gr);

maxg = gr;

getoa(rob,0) = ob1;

Line 690 int *gradep;

Line 717 int *gradep;

ob1 = getoa(ob,i);

ob1 = homogenizeObject(ob1,&gr);

if (gr > maxg) {

maxg = gr;

}

getoa(rob,i) = ob1;

}

Line 699 int *gradep;

Line 726 int *gradep;

rp = oRingp(rob);

if (rp == (struct ring *)NULL) rp = CurrentRingp;

for (i=0; i<size; i++) {

gr = oGrade(getoa(rob,i));

/**printf("maxg=%d, gr=%d(i=%d) ",maxg,gr,i); fflush(stdout);**/

if (maxg > gr) {

f = cdd(1,0,maxg-gr-i,rp); /* h^{maxg-gr-i} */

getoa(rob,i) = KooMult(KpoPOLY(f),getoa(rob,i));

}

*gradep = maxg;

Line 717 int *gradep;

Line 744 int *gradep;

}

struct object homogenizeObject_vec(ob,gradep)

struct object ob;

int *gradep;

{

struct object rob,ob1;

struct object rob = OINIT;

struct object ob1 = OINIT;

int maxg;

int gr,i,size;

POLY f;

Line 744 int *gradep;

Line 772 int *gradep;

if (size == 0) {

errorKan1("%s\n","homogenizeObject_vec() is called for the empty array.");

}

if (getoa(ob,0).tag == Sdollar) return(homogenizeObject_go(ob,gradep));

rob = newObjectArray(size);

for (i=0; i<size; i++) {

ob1 = getoa(ob,i);

ob1 = homogenizeObject_vec(ob1,&gr);

if (i==0) maxg = gr;

else {

maxg = (maxg > gr? maxg: gr);

}

putoa(rob,i,ob1);

}

Line 763 int *gradep;

Line 792 int *gradep;

}

void KresetDegreeShift() {

DegreeShifto = NullObject;

DegreeShifto_vec = (int *)NULL;

DegreeShifto_size = 0;

DegreeShiftD = NullObject;

DegreeShiftD_vec = (int *)NULL;

DegreeShiftD_size = 0;

}

struct object homogenizeObject_go(struct object ob,int *gradep) {

int size,i,dssize,j;

struct object ob0 = OINIT;

struct object ob1 = OINIT;

struct object ob2 = OINIT;

struct object rob = OINIT;

struct object tob = OINIT;

struct object ob1t = OINIT;

int *ds;

POLY f;

int onlyS;

onlyS = 0; /* default value */

rob = NullObject;

/*printf("[%d,%d]\n",DegreeShiftD_size,DegreeShifto_size);*/

if (DegreeShifto_size == 0) DegreeShifto = NullObject;

if (DegreeShiftD_size == 0) DegreeShiftD = NullObject;

DegreeShiftD : Degree shift vector for (0,1)-h-homogenization,

which is {\vec n} in G-O paper.

It is used in dGrade1() redm.c

DegreeShifto : Degree shift vector for (u,v)-s-homogenization

which is used only in ecart division and (u,v) is

usually (-1,1).

This shift vector is written {\vec v} in G-O paper.

It may differ from the degree shift for the ring,

which is used to get (minimal) Schreyer resolution.

This shift vector is denoted by {\vec m} in G-O paper.

It is often used as an argument for uvGrade1 and

goHomogenize*

if (ob.tag != Sarray) errorKan1("%s\n","homogenizeObject_go(): Invalid argument data type.");

size = getoaSize(ob);

if (size == 0) errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");

ob0 = getoa(ob,0);

if (ob0.tag != Sdollar) {

errorKan1("%s\n","homogenizeObject_go(): the first argument must be a string.");

}

if (strcmp(KopString(ob0),"degreeShift") == 0) {

if (size < 2)

errorKan1("%s\n","homogenizeObject_go(): [(degreeShift) shift-vector obj] or [(degreeShift) shift-vector] or [(degreeShift) (value)] homogenize.\nshift-vector=(0,1)-shift vector or [(0,1)-shift vector, (u,v)-shift vector].");

ob1 = getoa(ob,1);

if (ob1.tag != Sarray) {

if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"value")==0)) {

/* Reporting the value. It is done below. */

}else if ((ob1.tag == Sdollar) && (strcmp(KopString(ob1),"reset")==0)) {

KresetDegreeShift();

}

rob = newObjectArray(2);

putoa(rob,0,DegreeShiftD);

putoa(rob,1,DegreeShifto);

return rob;

}

if (getoaSize(ob1) == 2) {

/* [(degreeShift) [ [1 2] [3 4] ] ...] homogenize */

/* (0,1)-h (u,v)-s */

DegreeShiftD = getoa(ob1,0);

dssize = getoaSize(DegreeShiftD);

ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));

if (ds == NULL) errorKan1("%s\n","no more memory.");

for (i=0; i<dssize; i++) {

ds[i] = objToInteger(getoa(DegreeShiftD,i));

}

DegreeShiftD_size = dssize;

DegreeShiftD_vec = ds;

DegreeShifto = getoa(ob1,1);

dssize = getoaSize(DegreeShifto);

ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));

if (ds == NULL) errorKan1("%s\n","no more memory.");

for (i=0; i<dssize; i++) {

ds[i] = objToInteger(getoa(DegreeShifto,i));

}

DegreeShifto_size = dssize;

DegreeShifto_vec = ds;

}else if (getoaSize(ob1) == 1) {

/* Set only for (0,1)-h */

DegreeShiftD = getoa(ob1,0);

dssize = getoaSize(DegreeShiftD);

ds = (int *)sGC_malloc(sizeof(int)*(dssize>0?dssize:1));

if (ds == NULL) errorKan1("%s\n","no more memory.");

for (i=0; i<dssize; i++) {

ds[i] = objToInteger(getoa(DegreeShiftD,i));

}

DegreeShiftD_size = dssize;

DegreeShiftD_vec = ds;

}

ds = DegreeShifto_vec;

dssize = DegreeShifto_size;

if (size == 2) {

rob = newObjectArray(2);

putoa(rob,0,DegreeShiftD);

putoa(rob,1,DegreeShifto);

return rob;

}else{

ob2 = getoa(ob,2);

if (ob2.tag == Spoly) {

f = goHomogenize11(KopPOLY(ob2),ds,dssize,-1,onlyS);

rob = KpoPOLY(f);

}else if (ob2.tag == SuniversalNumber) {

rob = ob2;

}else if (ob2.tag == Sarray) {

int mm;

mm = getoaSize(ob2);

f = objArrayToPOLY(ob2);

f = goHomogenize11(f,ds,dssize,-1,onlyS);

rob = POLYtoObjArray(f,mm);

}else{

errorKan1("%s\n","homogenizeObject_go(): invalid object for the third element.");

}

}else{

errorKan1("%s\n","homogenizeObject_go(): unknown key word.");

}

return( rob );

}

struct ring *oRingp(ob)

struct object ob;

{

struct ring *rp,*rptmp;

int i,size;

Line 791 struct object ob;

Line 951 struct object ob;

}

int oGrade(ob)

struct object ob;

{

int i,size;

POLY f;

Line 819 struct object ob;

Line 979 struct object ob;

struct object oPrincipalPart(ob)

struct object ob;

{

POLY f;

struct object rob;

struct object rob = OINIT;

switch(ob.tag) {

case Spoly:

Line 835 struct object ob;

Line 995 struct object ob;

}

struct object oInitW(ob,oWeight)

struct object ob;

struct object oWeight;

{

POLY f;

struct object rob;

struct object rob = OINIT;

int w[2*N0];

int n,i;

struct object ow;

struct object ow = OINIT;

int shiftvec;

struct object oShift = OINIT;

int *s;

int ssize,m;

shiftvec = 0;

s = NULL;

if (oWeight.tag != Sarray) {

errorKan1("%s\n","oInitW(): the second argument must be array.");

}

oWeight = Kto_int32(oWeight);

n = getoaSize(oWeight);

if (n == 0) {

m = getoaSize(ob);

f = objArrayToPOLY(ob);

f = head(f);

return POLYtoObjArray(f,m);

}

if (getoa(oWeight,0).tag == Sarray) {

if (n != 2) errorKan1("%s\n","oInitW(): the size of the second argument should be 2.");

shiftvec = 1;

oShift = getoa(oWeight,1);

oWeight = getoa(oWeight,0);

if (oWeight.tag != Sarray) {

errorKan1("%s\n","oInitW(): the weight vector must be array.");

}

n = getoaSize(oWeight);

if (oShift.tag != Sarray) {

errorKan1("%s\n","oInitW(): the shift vector must be array.");

}

/* oWeight = Ksm1WeightExpressionToVec(oWeight); */

if (n >= 2*N0) errorKan1("%s\n","oInitW(): the size of the second argument is invalid.");

for (i=0; i<n; i++) {

ow = getoa(oWeight,i);

if (ow.tag == SuniversalNumber) {

ow = KpoInteger(coeffToInt(ow.lc.universalNumber));

}

if (ow.tag != Sinteger) {

errorKan1("%s\n","oInitW(): the entries of the second argument must be integers.");

}

w[i] = KopInteger(ow);

}

if (shiftvec) {

ssize = getoaSize(oShift);

s = (int *)sGC_malloc(sizeof(int)*(ssize+1));

if (s == NULL) errorKan1("%s\n","oInitW() no more memory.");

for (i=0; i<ssize; i++) {

ow = getoa(oShift,i);

if (ow.tag == SuniversalNumber) {

ow = KpoInteger(coeffToInt(ow.lc.universalNumber));

}

if (ow.tag != Sinteger) {

errorKan1("%s\n","oInitW(): the entries of shift vector must be integers.");

}

s[i] = KopInteger(ow);

}

switch(ob.tag) {

case Spoly:

f = KopPOLY(ob);

return( KpoPOLY(POLYToInitW(f,w)));

if (shiftvec) {

return( KpoPOLY(POLYToInitWS(f,w,s)));

}else{

return( KpoPOLY(POLYToInitW(f,w)));

}

break;

case Sarray:

m = getoaSize(ob);

f = objArrayToPOLY(ob);

/* printf("1.%s\n",POLYToString(f,'*',1)); */

if (shiftvec) {

f = POLYToInitWS(f,w,s);

}else{

f = POLYToInitW(f,w);

}

/* printf("2.%s\n",POLYToString(f,'*',1)); */

return POLYtoObjArray(f,m);

default:

errorKan1("%s\n","oInitW(): Argument must be polynomial.");

errorKan1("%s\n","oInitW(): Argument must be polynomial or a vector of polynomials");

break;

}

POLY objArrayToPOLY(struct object ob) {

int m;

POLY f;

POLY t;

int i,n;

struct ring *ringp;

if (ob.tag != Sarray) errorKan1("%s\n", "objArrayToPOLY() the argument must be an array.");

m = getoaSize(ob);

ringp = NULL;

f = POLYNULL;

for (i=0; i<m; i++) {

if (getoa(ob,i).tag != Spoly) errorKan1("%s\n","objArrayToPOLY() elements must be a polynomial.");

t = KopPOLY(getoa(ob,i));

if (t ISZERO) {

}else{

if (ringp == NULL) {

ringp = t->m->ringp;

n = ringp->n;

if (n - ringp->nn <= 0) errorKan1("%s\n","Graduation variable in D is not given.");

}

t = (*mpMult)(cxx(1,n-1,i,ringp),t);

f = ppAddv(f,t);

}

return f;

}

struct object POLYtoObjArray(POLY f,int size) {

struct object rob = OINIT;

POLY *pa;

int d,n,i;

POLY t;

if (size < 0) errorKan1("%s\n","POLYtoObjArray() invalid size.");

rob = newObjectArray(size);

pa = (POLY *) sGC_malloc(sizeof(POLY)*(size+1));

if (pa == NULL) errorKan1("%s\n","POLYtoObjArray() no more memory.");

for (i=0; i<size; i++) {

pa[i] = POLYNULL;

putoa(rob,i,KpoPOLY(pa[i]));

}

if (f == POLYNULL) {

return rob;

}

n = f->m->ringp->n;

while (f != POLYNULL) {

d = f->m->e[n-1].x;

if (d >= size) errorKan1("%s\n","POLYtoObjArray() size is too small.");

t = newCell(coeffCopy(f->coeffp),monomialCopy(f->m));

i = t->m->e[n-1].x;

t->m->e[n-1].x = 0;

pa[i] = ppAddv(pa[i],t); /* slow to add from the top. */

f = f->next;

}

for (i=0; i<size; i++) {

putoa(rob,i,KpoPOLY(pa[i]));

}

return rob;

}

struct object KordWsAll(ob,oWeight)

struct object ob;

struct object oWeight;

{

POLY f;

struct object rob = OINIT;

int w[2*N0];

int n,i;

struct object ow = OINIT;

int shiftvec;

struct object oShift = OINIT;

int *s;

int ssize,m;

shiftvec = 0;

s = NULL;

if (oWeight.tag != Sarray) {

errorKan1("%s\n","ordWsAll(): the second argument must be array.");

}

oWeight = Kto_int32(oWeight);

n = getoaSize(oWeight);

if (n == 0) {

m = getoaSize(ob);

f = objArrayToPOLY(ob);

f = head(f);

return POLYtoObjArray(f,m);

}

if (getoa(oWeight,0).tag == Sarray) {

if (n != 2) errorKan1("%s\n","ordWsAll(): the size of the second argument should be 2.");

shiftvec = 1;

oShift = getoa(oWeight,1);

oWeight = getoa(oWeight,0);

if (oWeight.tag != Sarray) {

errorKan1("%s\n","ordWsAll(): the weight vector must be array.");

}

n = getoaSize(oWeight);

if (oShift.tag != Sarray) {

errorKan1("%s\n","ordWsAll(): the shift vector must be array.");

}

/* oWeight = Ksm1WeightExpressionToVec(oWeight); */

if (n >= 2*N0) errorKan1("%s\n","ordWsAll(): the size of the second argument is invalid.");

for (i=0; i<n; i++) {

ow = getoa(oWeight,i);

if (ow.tag == SuniversalNumber) {

ow = KpoInteger(coeffToInt(ow.lc.universalNumber));

}

if (ow.tag != Sinteger) {

errorKan1("%s\n","ordWsAll(): the entries of the second argument must be integers.");

}

w[i] = KopInteger(ow);

}

if (shiftvec) {

ssize = getoaSize(oShift);

s = (int *)sGC_malloc(sizeof(int)*(ssize+1));

if (s == NULL) errorKan1("%s\n","ordWsAll() no more memory.");

for (i=0; i<ssize; i++) {

ow = getoa(oShift,i);

if (ow.tag == SuniversalNumber) {

ow = KpoInteger(coeffToInt(ow.lc.universalNumber));

}

if (ow.tag != Sinteger) {

errorKan1("%s\n","ordWsAll(): the entries of shift vector must be integers.");

}

s[i] = KopInteger(ow);

}

switch(ob.tag) {

case Spoly:

f = KopPOLY(ob);

if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");

if (shiftvec) {

return( KpoInteger(ordWsAll(f,w,s)));

}else{

return( KpoInteger(ordWsAll(f,w,(int *) NULL)));

}

break;

case Sarray:

m = getoaSize(ob);

f = objArrayToPOLY(ob);

if (f == POLYNULL) errorKan1("%s\n","ordWsAll(): the argument is 0");

if (shiftvec) {

return KpoInteger(ordWsAll(f,w,s));

}else{

return KpoInteger(ordWsAll(f,w,(int *)NULL));

}

default:

errorKan1("%s\n","ordWsAll(): Argument must be polynomial or a vector of polynomials");

break;

}

int KpolyLength(POLY f) {

int size;

if (f == POLYNULL) return(1);

Line 893 int validOutputOrder(int ord[],int n) {

Line 1269 int validOutputOrder(int ord[],int n) {

struct object KsetOutputOrder(struct object ob, struct ring *rp)

{

int n,i;

struct object ox;

struct object ox = OINIT;

struct object otmp;

struct object otmp = OINIT;

int *xxx;

int *ddd;

if (ob.tag != Sarray) {

Line 925 struct object KsetOutputOrder(struct object ob, struct

Line 1301 struct object KsetOutputOrder(struct object ob, struct

struct object KschreyerSkelton(struct object g)

{

struct object rob;

struct object rob = OINIT;

struct object ij;

struct object ij = OINIT;

struct object ab;

struct object ab = OINIT;

struct object tt;

struct object tt = OINIT;

struct arrayOfPOLY *ap;

struct arrayOfMonomialSyz ans;

int k;

Line 974 struct object KvectorToSchreyer_es(struct object obarr

Line 1350 struct object KvectorToSchreyer_es(struct object obarr

int nn;

POLY f;

POLY g;

struct object ob;

struct object ob = OINIT;

struct ring *rp;

if (obarray.tag != Sarray) {

errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");

Line 993 struct object KvectorToSchreyer_es(struct object obarr

Line 1369 struct object KvectorToSchreyer_es(struct object obarr

/* g = es^i g */

g = mpMult_poly(cxx(1,nn,i,rp), g);

if (!isOrdered(g)) {

errorKan1("%s\n","KvectorToSchreyer_es(): given polynomial is not ordered properly by the given Schreyer order.");

}

f = ppAdd(f,g);

}

return(KpoPOLY(f));

}

int objToInteger(struct object ob) {

if (ob.tag == Sinteger) {

return KopInteger(ob);

}else if (ob.tag == SuniversalNumber) {

return(coeffToInt(KopUniversalNumber(ob)));

}else {

errorKan1("%s\n","objToInteger(): invalid argument.");

}

struct object KgetExponents(struct object obPoly,struct object otype) {

int type,asize,i;

POLY f;

POLY ff;

MONOMIAL tf;

struct object rob = OINIT;

struct object tob = OINIT;

static int nn,mm,ll,cc,n,m,l,c;

static struct ring *cr = (struct ring *)NULL;

extern struct ring *CurrentRingp;

int size,hsize,fsize,p,r;

if (otype.tag == Sinteger) {

type = KopInteger(otype);

}else if (otype.tag == SuniversalNumber) {

type = coeffToInt(KopUniversalNumber(otype));

}else {

errorKan1("%s\n","KgetExponents(): invalid translation type.");

}

if (obPoly.tag == Spoly) {

f = KopPOLY(obPoly);

}else if (obPoly.tag == Sarray) {

asize = getoaSize(obPoly);

rob = newObjectArray(asize);

for (i=0; i<asize; i++) {

tob = KgetExponents(getoa(obPoly,i),otype);

putoa(rob,i,tob);

}

return rob;

}else{

errorKan1("%s\n","KgetExponents(): argument must be a polynomial.");

}

/* type == 0 x,y,Dx,Dy (no commutative, no vector)

type == 1 x,y,Dx,Dy,h,H (commutative & no vector)

type == 2 x,y,Dx,Dy,h (commutative & no vector)

if (f ISZERO) {

cr = CurrentRingp;

}else{

tf = f->m;

}

if (tf->ringp != cr) {

n = tf->ringp->n;

m = tf->ringp->m;

l = tf->ringp->l;

c = tf->ringp->c;

nn = tf->ringp->nn;

mm = tf->ringp->mm;

ll = tf->ringp->ll;

cc = tf->ringp->cc;

cr = tf->ringp;

}

if (type == 0) {

size = 0;

for (i=c; i<ll; i++) size += 2;

for (i=l; i<mm; i++) size += 2;

for (i=m; i<nn; i++) size += 2;

}else if (type == 1) {

size = 0;

for (i=0; i<cc; i++) size += 2;

for (i=c; i<ll; i++) size += 2;

for (i=l; i<mm; i++) size += 2;

for (i=m; i<nn; i++) size += 2;

}else if (type == 2) {

size = 0;

for (i=0; i<cc; i++) size += 1;

for (i=c; i<ll; i++) size += 2;

for (i=l; i<mm; i++) size += 2;

for (i=m; i<nn; i++) size += 2;

}else{

errorKan1("%s\n","KgetExponent, unknown type.");

}

if (type == 1 || type == 2) {

hsize = (size-cc)/2;

}else{

hsize = size/2;

}

if (f ISZERO) {

tob = newObjectArray(size);

for (i=0; i<size; i++) {

putoa(tob,i,KpoInteger(0));

}

rob = newObjectArray(1);

putoa(rob,0,tob);

return rob;

}

fsize = 0;

ff = f;

while (ff != POLYNULL) {

fsize++;

ff = ff->next;

}

rob = newObjectArray(fsize);

ff = f;

p = 0;

while (ff != POLYNULL) {

r = 0;

tob = newObjectArray(size);

tf = ff->m;

for (i=ll-1; i>=c; i--) {

putoa(tob,r,KpoInteger(tf->e[i].x));

putoa(tob,hsize+r,KpoInteger(tf->e[i].D));

r++;

}

for (i=mm-1; i>=l; i--) {

putoa(tob,r,KpoInteger(tf->e[i].x));

putoa(tob,hsize+r,KpoInteger(tf->e[i].D));

r++;

}

for (i=nn-1; i>=m; i--) {

putoa(tob,r,KpoInteger(tf->e[i].x));

putoa(tob,hsize+r,KpoInteger(tf->e[i].D));

r++;

}

if (type == 1) {

for (i=cc-1; i>=0; i--) {

putoa(tob,hsize+r,KpoInteger(tf->e[i].D));

r++;

putoa(tob,hsize+r,KpoInteger(tf->e[i].x));

r++;

}

}else if (type == 2) {

for (i=cc-1; i>=0; i--) {

putoa(tob,hsize+r,KpoInteger(tf->e[i].D));

r++;

}

putoa(rob,p,tob);

p++;

ff = ff->next;

}

return rob;

}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>