File: [local] / OpenXM / src / kan96xx / Kan / kanExport1.c (download)
Revision 1.18, Thu Jun 16 05:07:23 2005 UTC (19 years, 3 months ago) by takayama
Branch: MAIN
Changes since 1.17: +54 -48
lines
The initialization of the variables of the type struct object
are added. It is necessary to initialize the field "attr"
(object attribute) of stuct object. cf. misc-2005/06/gfan/opt.sm1 test2.
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.18 2005/06/16 05:07:23 takayama Exp $ */
#include <stdio.h>
#include "datatype.h"
#include "stackm.h"
#include "extern.h"
#include "extern2.h"
#include "lookup.h"
#include "matrix.h"
#include "gradedset.h"
#include "kclass.h"
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 = OINIT;
int flag;
extern int ReduceLowerTerms;
if (f.tag != Spoly) errorKan1("%s\n","Kreduction(): the first argument must be a polynomial.");
if (ectag(set) == CLASSNAME_GradedPolySet) {
grG = KopGradedPolySet(set);
flag = 1;
}else{
if (set.tag != Sarray) errorKan1("%s\n","Kreduction(): the second argument must be a set of polynomials.");
grG = arrayToGradedPolySet(set);
flag = 0;
}
if (ReduceLowerTerms) {
r = (*reductionCdr)(f.lc.poly,grG,1,&syz);
}else{
r = (*reduction)(f.lc.poly,grG,1,&syz);
}
/* outputGradedPolySet(grG,0); */
if (flag) {
rob = newObjectArray(3);
putoa(rob,0,KpoPOLY(r));
putoa(rob,1,KpoPOLY(syz.cf));
putoa(rob,2,syzPolyToArray(countGradedPolySet(grG),syz.syz,grG));
}else {
rob = newObjectArray(4);
putoa(rob,0,KpoPOLY(r));
putoa(rob,1,KpoPOLY(syz.cf));
putoa(rob,2,syzPolyToArray(getoaSize(set),syz.syz,grG));
putoa(rob,3,gradedPolySetToArray(grG,1));
}
return(rob);
}
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 = OINIT;
struct object ob2 = OINIT;
struct object ob2c = OINIT;
int i;
struct gradedPolySet *grG;
struct pair *grP;
struct arrayOfPOLY *a;
struct object rob = OINIT;
struct gradedPolySet *grBases;
struct matrixOfPOLY *mp;
struct matrixOfPOLY *backwardMat;
struct object ob1New = OINIT;
extern char *F_groebner;
extern int CheckHomogenization;
extern int StopDegree;
int sdflag = 0;
int forceReduction = 0;
int reduceOnly = 0;
int ob1Size, ob2Size, noZeroEntry;
int *ob1ToOb2;
int *ob1ZeroPos;
int method;
int j,k;
struct object rob2 = OINIT;
struct object rob3 = OINIT;
struct object rob4 = OINIT;
struct ring *myring;
POLY f;
struct object orgB = OINIT;
struct object newB = OINIT;
struct object orgC = OINIT;
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;
StopDegree = 0x7fff;
if (ob.tag != Sarray) errorKan1("%s\n","Kgroebner(): The argument must be an array.");
switch(getoaSize(ob)) {
case 1:
needBack = 0; needSyz = 0; needInput = 0;
ob1 = getoa(ob,0);
break;
case 2:
ob1 = getoa(ob,0);
ob2 = getoa(ob,1);
if (ob2.tag != Sarray) {
errorKan1("%s\n","Kgroebner(): The options must be given by an array.");
}
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,"reduceOnly")==0) {
reduceOnly = 1;
}else if (strcmp(ob2c.lc.str,"countDown")==0) {
countDown = 1; cdflag = 1;
if (needSyz) {
warningKan("Kgroebner(): needSyz is automatically turned off.");
needSyz = 0;
}
}else if (strcmp(ob2c.lc.str,"StopDegree")==0) {
StopDegree = 0; sdflag = 1;
if (needSyz) {
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++) {
if (getoa(ob1,i).tag == Spoly) {
putoa(ob1New,i,getoa(ob1,i));
}else if (getoa(ob1,i).tag == Sarray) {
/* If the generater is given as an array, flatten it. */
putoa(ob1New,i,KpoPOLY( arrayToPOLY(getoa(ob1,i))));
}else{
errorKan1("%s\n","Kgroebner(): The elements must be polynomials or array of polynomials.");
}
/* 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.");
}
}
}
ob1 = ob1New;
/* To handle the input with zero entries. For debug, debug/gr.sm1*/
ob1Size = getoaSize(ob1);
ob2Size = 0; myring = CurrentRingp;
for (i=0; i<ob1Size; i++) {
if (KopPOLY(getoa(ob1,i)) != POLYNULL) ob2Size++;
}
if (ob2Size == ob1Size) noZeroEntry = 1;
else noZeroEntry = 0;
if (ob1Size == 0) {
if (needBack && needSyz) {
rob = newObjectArray(3);
putoa(rob,0,newObjectArray(0));
putoa(rob,1,newObjectArray(0));
putoa(rob,2,newObjectArray(0));
}else if (needBack) {
rob = newObjectArray(2);
putoa(rob,0,newObjectArray(0));
putoa(rob,1,newObjectArray(0));
}else {
rob = newObjectArray(1);
putoa(rob,0,newObjectArray(0));
}
return(rob);
}
/* Assume ob1size > 0 */
if (ob2Size == 0) {
rob2 = newObjectArray(1); putoa(rob2,0,KpoPOLY(POLYNULL));
if (needBack && needSyz) {
rob = newObjectArray(3);
putoa(rob,0,rob2);
rob3 = newObjectArray(1);
putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
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) {
rob = newObjectArray(2);
putoa(rob,0,rob2);
rob3 = newObjectArray(1);
putoa(rob3,0,unitVector(-1,ob1Size,(struct ring *)NULL));
putoa(rob,1,rob3);
}else {
rob = newObjectArray(1);
putoa(rob,0,rob2);
}
return(rob);
}
/* Assume ob1Size , ob2Size > 0 */
ob2 = newObjectArray(ob2Size);
ob1ToOb2 = (int *)sGC_malloc(sizeof(int)*ob1Size);
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++) {
f = KopPOLY(getoa(ob1,i));
if (f != POLYNULL) {
myring = f->m->ringp;
putoa(ob2,j,KpoPOLY(f));
ob1ToOb2[i] = j; j++;
}else{
ob1ToOb2[i] = -1;
ob1ZeroPos[k] = i; k++;
}
}
a = arrayToArrayOfPOLY(ob2);
grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction,reduceOnly);
if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) {
warningKan("The options needBack and needSyz are ignored.");
needBack = needSyz = 0;
}
/*return(gradedPolySetToGradedArray(grG,0));*/
if (needBack && needSyz) {
rob = newObjectArray(3);
if (Message && KanGBmessage) {
printf("Computing the backward transformation ");
fflush(stdout);
}
getBackwardTransformation(grG); /* mark and syz is modified. */
if (KanGBmessage) printf("Done.\n");
/* Computing the syzygies. */
if (Message && KanGBmessage) {
printf("Computing the syzygies ");
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));
putoa(rob,1,matrixOfPOLYToArray(backwardMat));
putoa(rob,2,matrixOfPOLYToArray(mp));
}else if (needBack) {
rob = newObjectArray(2);
if (Message && KanGBmessage) {
printf("Computing the backward transformation.....");
fflush(stdout);
}
getBackwardTransformation(grG); /* mark and syz is modified. */
if (KanGBmessage) printf("Done.\n");
putoa(rob,0,gradedPolySetToArray(grG,0));
putoa(rob,1,getBackwardArray(grG));
}else {
rob = newObjectArray(1);
putoa(rob,0,gradedPolySetToArray(grG,0));
}
/* To handle zero entries in the input. */
if (noZeroEntry) {
return(rob);
}
method = getoaSize(rob);
switch(method) {
case 1:
return(rob);
break;
case 2:
orgB = getoa(rob,1); /* backward transformation. */
newB = newObjectArray(getoaSize(orgB));
for (i=0; i<getoaSize(orgB); i++) {
putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
}
rob2 = newObjectArray(2);
putoa(rob2,0,getoa(rob,0));
putoa(rob2,1,newB);
return(rob2);
break;
case 3:
orgB = getoa(rob,1); /* backward transformation. */
newB = newObjectArray(getoaSize(orgB));
for (i=0; i<getoaSize(orgB); i++) {
putoa(newB,i,paddingVector(getoa(orgB,i),ob1ToOb2,ob1Size));
}
orgC = getoa(rob,2);
newC = newObjectArray(getoaSize(orgC)+ob1Size-ob2Size);
for (i=0; i<getoaSize(orgC); i++) {
putoa(newC, i, paddingVector(getoa(orgC,i),ob1ToOb2,ob1Size));
}
for (i = getoaSize(orgC), j = 0; i<getoaSize(orgC)+ob1Size-ob2Size; i++,j++) {
putoa(newC,i,unitVector(ob1ZeroPos[j],ob1Size,myring));
}
rob2 = newObjectArray(3);
putoa(rob2,0,getoa(rob,0));
putoa(rob2,1,newB);
putoa(rob2,2,newC);
return(rob2);
break;
default:
errorKan1("%s","Kgroebner: unknown method.");
}
}
static struct object paddingVector(struct object ob, int table[], int m)
{
struct object rob = OINIT;
int i;
rob = newObjectArray(m);
for (i=0; i<m; i++) {
if (table[i] != -1) {
putoa(rob,i,getoa(ob,table[i]));
}else{
putoa(rob,i,KpoPOLY(POLYNULL));
}
}
return(rob);
}
static struct object unitVector(int pos, int size,struct ring *r)
{
struct object rob = OINIT;
int i;
POLY one;
rob = newObjectArray(size);
for (i=0; i<size; i++) {
putoa(rob,i,KpoPOLY(POLYNULL));
}
if ((0 <= pos) && (pos < size)) {
putoa(rob,pos, KpoPOLY(cxx(1,0,0,r)));
}
return(rob);
}
/* :misc */
#define INITGRADE 3
#define INITSIZE 0
struct gradedPolySet *arrayToGradedPolySet(ob)
struct object ob;
{
int n,i,grd,ind;
POLY f;
struct gradedPolySet *grG;
int serial;
extern int Sugar;
if (ob.tag != Sarray) errorKan1("%s\n","arrayToGradedPolySet(): the argument must be array.");
n = getoaSize(ob);
for (i=0; i<n; i++) {
if (getoa(ob,i).tag != Spoly)
errorKan1("%s\n","arrayToGradedPolySet(): the elements must be polynomials.");
}
grG = newGradedPolySet(INITGRADE);
for (i=0; i<grG->lim; i++) {
grG->polys[i] = newPolySet(INITSIZE);
}
for (i=0; i<n; i++) {
f = KopPOLY(getoa(ob,i));
grd = -1; whereInG(grG,f,&grd,&ind,Sugar);
serial = i;
grG = putPolyInG(grG,f,grd,ind,(struct syz0 *)NULL,1,serial);
}
return(grG);
}
struct object polySetToArray(ps,keepRedundant)
struct polySet *ps;
int keepRedundant;
{
int n,i,j;
struct object ob = OINIT;
if (ps == (struct polySet *)NULL) return(newObjectArray(0));
n = 0;
if (keepRedundant) {
n = ps->size;
}else{
for (i=0; i<ps->size; i++) {
if (ps->del[i] == 0) ++n;
}
}
ob = newObjectArray(n);
j = 0;
for (i=0; i<ps->size; i++) {
if (keepRedundant || (ps->del[i] == 0)) {
putoa(ob,j,KpoPOLY(ps->g[i]));
j++;
}
}
return(ob);
}
struct object gradedPolySetToGradedArray(gps,keepRedundant)
struct gradedPolySet *gps;
int keepRedundant;
{
struct object ob = OINIT;
struct object vec = OINIT;
int i;
if (gps == (struct gradedPolySet *)NULL) return(NullObject);
ob = newObjectArray(gps->maxGrade +1);
vec = newObjectArray(gps->maxGrade);
for (i=0; i<gps->maxGrade; i++) {
putoa(vec,i,KpoInteger(i));
putoa(ob,i+1,polySetToArray(gps->polys[i],keepRedundant));
}
putoa(ob,0,vec);
return(ob);
}
struct object gradedPolySetToArray(gps,keepRedundant)
struct gradedPolySet *gps;
int keepRedundant;
{
struct object ob = OINIT;
struct object vec = OINIT;
struct polySet *ps;
int k;
int i,j;
int size;
if (gps == (struct gradedPolySet *)NULL) return(NullObject);
size = 0;
for (i=0; i<gps->maxGrade; i++) {
ps = gps->polys[i];
if (keepRedundant) {
size += ps->size;
}else{
for (j=0; j<ps->size; j++) {
if (ps->del[j] == 0) ++size;
}
}
}
ob = newObjectArray(size);
k = 0;
for (i=0; i<gps->maxGrade; i++) {
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++;
}
}
}
return(ob);
}
/* 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 = OINIT;
int i,g0,i0,serial;
ob = newObjectArray(size);
for (i=0; i<size; i++) {
putoa(ob,i,KpoPOLY(ZERO));
}
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.");
}
if (KopPOLY(getoa(ob,serial)) != ZERO) {
errorKan1("%s\n","syzPolyToArray(): syzygy polynomial is broken.");
}
putoa(ob,serial,KpoPOLY(f->coeffp->val.f));
f = f->next;
}
return(ob);
}
struct object getBackwardArray(grG)
struct gradedPolySet *grG;
{
/* use serial, del. cf. getBackwardTransformation(). */
int inputSize,outputSize;
int i,j,k;
struct object ob = OINIT;
struct polySet *ps;
inputSize = 0; outputSize = 0;
for (i=0; i<grG->maxGrade; i++) {
ps = grG->polys[i];
for (j=0; j<ps->size; j++) {
if (ps->serial[j] >= 0) ++inputSize;
if (ps->del[j] == 0) ++outputSize;
}
}
ob = newObjectArray(outputSize);
k = 0;
for (i=0; i<grG->maxGrade; i++) {
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++;
}
}
}
return(ob);
}
POLY arrayToPOLY(ob)
struct object ob;
{
int size,i;
struct object f = OINIT;
POLY r;
static int nn,mm,ll,cc,n,m,l,c;
static struct ring *cr = (struct ring *)NULL;
POLY ff,ee;
MONOMIAL tf;
if (ob.tag != Sarray) errorKan1("%s\n","arrayToPOLY(): The argument must be an array.");
size = getoaSize(ob);
r = ZERO;
for (i=0; i<size; i++) {
f = getoa(ob,i);
if (f.tag != Spoly) errorKan1("%s\n","arrayToPOLY(): The elements must be polynomials.");
ff = KopPOLY(f);
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);
else if (l-ll >0) ee = cxx(1,l-1,i,tf->ringp);
else if (c-cc >0) ee = cxx(1,c-1,i,tf->ringp);
else ee = ZERO;
r = ppAddv(r,ppMult(ee,ff));
}
}
return(r);
}
struct object POLYToArray(ff)
POLY ff;
{
static int nn,mm,ll,cc,n,m,l,c;
static struct ring *cr = (struct ring *)NULL;
POLY ee;
MONOMIAL tf;
int k,i,matn,size;
struct matrixOfPOLY *mat;
POLY ex,sizep;
struct object ob = OINIT;
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,1,tf->ringp);
else if (m-mm >0) ee = cxx(1,m-1,1,tf->ringp);
else if (l-ll >0) ee = cxx(1,l-1,1,tf->ringp);
else if (c-cc >0) ee = cxx(1,c-1,1,tf->ringp);
else ee = ZERO;
}else{
ob = newObjectArray(1);
getoa(ob,0) = KpoPOLY(ZERO);
return(ob);
}
mat = parts(ff,ee);
matn = mat->n;
sizep = getMatrixOfPOLY(mat,0,0);
if (sizep == ZERO) size = 1;
else size = coeffToInt(sizep->coeffp)+1;
ob = newObjectArray(size);
for (i=0; i<size; i++) getoa(ob,i) = KpoPOLY(ZERO);
for (i=0; i<matn; i++) {
ex = getMatrixOfPOLY(mat,0,i);
if (ex == ZERO) k = 0;
else {
k = coeffToInt(ex->coeffp);
}
getoa(ob,k) = KpoPOLY(getMatrixOfPOLY(mat,1,i));
}
return(ob);
}
static int isThereh(f)
POLY f;
{
POLY t;
if (f == 0) return(0);
t = f;
while (t != POLYNULL) {
if (t->m->e[0].D) return(1);
t = t->next;
}
return(0);
}
struct object homogenizeObject(ob,gradep)
struct object ob;
int *gradep;
{
struct object rob = OINIT;
struct object ob1 = OINIT;
int maxg;
int gr,flag,i,d,size;
struct ring *rp;
POLY f;
extern struct ring *CurrentRingp;
extern int Homogenize_vec;
if (!Homogenize_vec) return(homogenizeObject_vec(ob,gradep));
switch(ob.tag) {
case Spoly:
if (isThereh(KopPOLY(ob))) {
fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
errorKan1("%s\n","homogenizeObject(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
}
f = homogenize( KopPOLY(ob) );
*gradep = (*grade)(f);
return(KpoPOLY(f));
break;
case Sarray:
size = getoaSize(ob);
if (size == 0) {
errorKan1("%s\n","homogenizeObject() is called for the empty array.");
}
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;
for (i=1; i<size; i++) {
ob1 = getoa(ob,i);
ob1 = homogenizeObject(ob1,&gr);
if (gr > maxg) {
maxg = gr;
}
getoa(rob,i) = ob1;
}
maxg = maxg+size-1;
if (1) {
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;
return(rob);
break;
default:
errorKan1("%s\n","homogenizeObject(): Invalid argument data type.");
break;
}
}
struct object homogenizeObject_vec(ob,gradep)
struct object ob;
int *gradep;
{
struct object rob = OINIT;
struct object ob1 = OINIT;
int maxg;
int gr,i,size;
POLY f;
extern struct ring *CurrentRingp;
switch(ob.tag) {
case Spoly:
if (isThereh(KopPOLY(ob))) {
fprintf(stderr,"\n%s\n",KPOLYToString(KopPOLY(ob)));
errorKan1("%s\n","homogenizeObject_vec(): The above polynomial has already had a homogenization variable.\nPut the homogenization variable 1 before homogenization.\ncf. replace.");
}
if (containVectorVariable(KopPOLY(ob))) {
errorKan1("%s\n","homogenizedObject_vec(): The given polynomial contains a variable to express a vector component.");
}
f = homogenize( KopPOLY(ob) );
*gradep = (*grade)(f);
return(KpoPOLY(f));
break;
case Sarray:
size = getoaSize(ob);
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);
}
*gradep = maxg;
return(rob);
break;
default:
errorKan1("%s\n","homogenizeObject_vec(): Invalid argument data type.");
break;
}
}
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;
POLY f;
switch(ob.tag) {
case Spoly:
f = KopPOLY(ob);
if (f == ZERO) return((struct ring *)NULL);
return( f->m->ringp);
break;
case Sarray:
size = getoaSize(ob);
rp = (struct ring *)NULL;
for (i=0; i<size; i++) {
rptmp = oRingp(getoa(ob,i));
if (rptmp != (struct ring *)NULL) rp = rptmp;
return(rp);
}
break;
default:
errorKan1("%s\n","oRingp(): Invalid argument data type.");
break;
}
}
int oGrade(ob)
struct object ob;
{
int i,size;
POLY f;
int maxg,tmpg;
switch(ob.tag) {
case Spoly:
f = KopPOLY(ob);
return( (*grade)(f) );
break;
case Sarray:
size = getoaSize(ob);
if (size == 0) return(0);
maxg = oGrade(getoa(ob,0));
for (i=1; i<size; i++) {
tmpg = oGrade(getoa(ob,i));
if (tmpg > maxg) maxg = tmpg;
}
return(maxg);
break;
default:
errorKan1("%s\n","oGrade(): Invalid data type for the argument.");
break;
}
}
struct object oPrincipalPart(ob)
struct object ob;
{
POLY f;
struct object rob = OINIT;
switch(ob.tag) {
case Spoly:
f = KopPOLY(ob);
return( KpoPOLY(POLYToPrincipalPart(f)));
break;
default:
errorKan1("%s\n","oPrincipalPart(): Invalid data type for the argument.");
break;
}
}
struct object oInitW(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","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);
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 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);
size = 0;
while (f != POLYNULL) {
f = f->next;
size++;
}
return(size);
}
int validOutputOrder(int ord[],int n) {
int i,j,flag;
for (i=0; i<n; i++) {
flag = 0;
for (j=0; j<n; j++) {
if (ord[j] == i) flag = 1;
}
if (flag == 0) return(0); /* invalid */
}
return(1);
}
struct object KsetOutputOrder(struct object ob, struct ring *rp)
{
int n,i;
struct object ox = OINIT;
struct object otmp = OINIT;
int *xxx;
int *ddd;
if (ob.tag != Sarray) {
errorKan1("%s\n","KsetOutputOrder(): the argument must be of the form [x y z ...]");
}
n = rp->n;
ox = ob;
if (getoaSize(ox) != 2*n) {
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.");
}
xxx = (int *)sGC_malloc(sizeof(int)*n*2);
if (xxx == NULL ) {
errorKan1("%s\n","KsetOutputOrder(): no more memory.");
}
for (i=0; i<2*n; i++) {
otmp = getoa(ox,i);
if(otmp.tag != Sinteger) {
errorKan1("%s\n","KsetOutputOrder(): elements must be integers.");
}
xxx[i] = KopInteger(otmp);
}
if (!validOutputOrder(xxx,2*n)) {
errorKan1("%s\n","KsetOutputOrder(): Invalid output order for variables.");
}
rp->outputOrder = xxx;
return(ob);
}
struct object KschreyerSkelton(struct object g)
{
struct object rob = OINIT;
struct object ij = OINIT;
struct object ab = OINIT;
struct object tt = OINIT;
struct arrayOfPOLY *ap;
struct arrayOfMonomialSyz ans;
int k;
rob.tag = Snull;
if (g.tag != Sarray) {
errorKan1("%s\n","KschreyerSkelton(): argument must be an array of polynomials.");
}
ap = arrayToArrayOfPOLY(g);
ans = schreyerSkelton(*ap);
rob = newObjectArray(ans.size);
for (k=0; k<ans.size; k++) {
ij = newObjectArray(2);
putoa(ij,0, KpoInteger(ans.p[k]->i));
putoa(ij,1, KpoInteger(ans.p[k]->j));
ab = newObjectArray(2);
putoa(ab,0, KpoPOLY(ans.p[k]->a));
putoa(ab,1, KpoPOLY(ans.p[k]->b));
tt = newObjectArray(2);
putoa(tt,0, ij);
putoa(tt,1, ab);
putoa(rob,k,tt);
}
return(rob);
}
struct object KisOrdered(struct object of)
{
if (of.tag != Spoly) {
errorKan1("%s\n","KisOrdered(): argument must be a polynomial.");
}
if (isOrdered(KopPOLY(of))) {
return(KpoInteger(1));
}else{
return(KpoInteger(0));
}
}
struct object KvectorToSchreyer_es(struct object obarray)
{
int m,i;
int nn;
POLY f;
POLY g;
struct object ob = OINIT;
struct ring *rp;
if (obarray.tag != Sarray) {
errorKan1("%s\n","KvectorToSchreyer_es(): argument must be an array of polynomials.");
}
m = getoaSize(obarray);
f = POLYNULL;
for (i=0; i<m; i++) {
ob = getoa(obarray,i);
if (ob.tag != Spoly) {
errorKan1("%s\n","KvectorToSchreyer_es(): each element of the array must be a polynomial.");
}
g = KopPOLY(ob);
if (g != POLYNULL) {
rp = g->m->ringp;
nn = rp->nn;
/* 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;
}