version 1.9, 2003/08/24 05:19:42 |
version 1.17, 2005/06/09 04:09:22 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.8 2003/08/23 02:28:38 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.16 2004/09/05 07:42:43 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
Line 85 struct object Kgroebner(ob) |
|
Line 85 struct object Kgroebner(ob) |
|
extern int StopDegree; |
extern int StopDegree; |
int sdflag = 0; |
int sdflag = 0; |
int forceReduction = 0; |
int forceReduction = 0; |
|
int reduceOnly = 0; |
|
|
int ob1Size, ob2Size, noZeroEntry; |
int ob1Size, ob2Size, noZeroEntry; |
int *ob1ToOb2; |
int *ob1ToOb2; |
Line 130 struct object Kgroebner(ob) |
|
Line 131 struct object Kgroebner(ob) |
|
needSyz = needBack = 1; |
needSyz = needBack = 1; |
}else if (strcmp(ob2c.lc.str,"forceReduction")==0) { |
}else if (strcmp(ob2c.lc.str,"forceReduction")==0) { |
forceReduction = 1; |
forceReduction = 1; |
|
}else if (strcmp(ob2c.lc.str,"reduceOnly")==0) { |
|
reduceOnly = 1; |
}else if (strcmp(ob2c.lc.str,"countDown")==0) { |
}else if (strcmp(ob2c.lc.str,"countDown")==0) { |
countDown = 1; cdflag = 1; |
countDown = 1; cdflag = 1; |
if (needSyz) { |
if (needSyz) { |
Line 234 struct object Kgroebner(ob) |
|
Line 237 struct object Kgroebner(ob) |
|
} |
} |
/* Assume ob1Size , ob2Size > 0 */ |
/* Assume ob1Size , ob2Size > 0 */ |
ob2 = newObjectArray(ob2Size); |
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."); |
if (ob1ToOb2 == NULL || ob1ZeroPos == NULL) errorKan1("%s\n","No more memory."); |
j = 0; k = 0; |
j = 0; k = 0; |
for (i=0; i<ob1Size; i++) { |
for (i=0; i<ob1Size; i++) { |
Line 251 struct object Kgroebner(ob) |
|
Line 254 struct object Kgroebner(ob) |
|
} |
} |
|
|
a = arrayToArrayOfPOLY(ob2); |
a = arrayToArrayOfPOLY(ob2); |
grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction); |
grG = (*groebner)(a,needBack,needSyz,&grP,countDown,forceReduction,reduceOnly); |
|
|
if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) { |
if (strcmp(F_groebner,"gm") == 0 && (needBack || needSyz)) { |
warningKan("The options needBack and needSyz are ignored."); |
warningKan("The options needBack and needSyz are ignored."); |
Line 274 struct object Kgroebner(ob) |
|
Line 277 struct object Kgroebner(ob) |
|
fflush(stdout); |
fflush(stdout); |
} |
} |
mp = getSyzygy(grG,grP->next,&grBases,&backwardMat); |
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"); |
if (KanGBmessage) printf("Done.\n"); |
|
|
putoa(rob,0,gradedPolySetToArray(grG,0)); |
putoa(rob,0,gradedPolySetToArray(grG,0)); |
Line 996 struct object oInitW(ob,oWeight) |
|
Line 1000 struct object oInitW(ob,oWeight) |
|
if (oWeight.tag != Sarray) { |
if (oWeight.tag != Sarray) { |
errorKan1("%s\n","oInitW(): the second argument must be array."); |
errorKan1("%s\n","oInitW(): the second argument must be array."); |
} |
} |
|
oWeight = Kto_int32(oWeight); |
n = getoaSize(oWeight); |
n = getoaSize(oWeight); |
if (n == 0) { |
if (n == 0) { |
m = getoaSize(ob); |
m = getoaSize(ob); |
Line 1150 struct object KordWsAll(ob,oWeight) |
|
Line 1155 struct object KordWsAll(ob,oWeight) |
|
if (oWeight.tag != Sarray) { |
if (oWeight.tag != Sarray) { |
errorKan1("%s\n","ordWsAll(): the second argument must be array."); |
errorKan1("%s\n","ordWsAll(): the second argument must be array."); |
} |
} |
|
oWeight = Kto_int32(oWeight); |
n = getoaSize(oWeight); |
n = getoaSize(oWeight); |
if (n == 0) { |
if (n == 0) { |
m = getoaSize(ob); |
m = getoaSize(ob); |
Line 1365 int objToInteger(struct object ob) { |
|
Line 1371 int objToInteger(struct object ob) { |
|
}else { |
}else { |
errorKan1("%s\n","objToInteger(): invalid argument."); |
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; |
|
struct object tob; |
|
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; |
} |
} |