version 1.2, 2000/01/16 07:55:39 |
version 1.14, 2005/06/16 05:07:23 |
|
|
/* $OpenXM$ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/order.c,v 1.13 2004/09/13 11:24:11 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
Line 21 static void warningOrder(char *s); |
|
Line 21 static void warningOrder(char *s); |
|
static void errorOrder(char *s); |
static void errorOrder(char *s); |
|
|
void setOrderByMatrix(order,n,c,l,omsize) |
void setOrderByMatrix(order,n,c,l,omsize) |
int order[]; |
int order[]; |
int n,c,l,omsize; |
int n,c,l,omsize; |
{ |
{ |
int i,j; |
int i,j; |
int *Order; |
int *Order; |
extern struct ring *CurrentRingp; |
extern struct ring *CurrentRingp; |
|
|
switch_mmLarger("default"); |
switch_mmLarger("default"); |
/* q-case */ |
/* q-case */ |
if ( l-c > 0) { |
if ( l-c > 0) { |
switch_mmLarger("qmatrix"); |
switch_mmLarger("qmatrix"); |
} |
} |
Line 46 int n,c,l,omsize; |
|
Line 46 int n,c,l,omsize; |
|
} |
} |
|
|
void showRing(level,ringp) |
void showRing(level,ringp) |
int level; |
int level; |
struct ring *ringp; |
struct ring *ringp; |
{ |
{ |
int i,j; |
int i,j; |
FILE *fp; |
FILE *fp; |
Line 58 struct ring *ringp; |
|
Line 58 struct ring *ringp; |
|
int P; |
int P; |
char *mtype; |
char *mtype; |
extern char *F_isSameComponent; |
extern char *F_isSameComponent; |
|
POLY f; |
|
POLY fx; |
|
POLY fd; |
|
POLY rf; |
fp = stdout; |
fp = stdout; |
|
|
N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c; |
N=ringp->n; M = ringp->m; L = ringp->l; C = ringp->c; |
Line 80 struct ring *ringp; |
|
Line 84 struct ring *ringp; |
|
fprintf(fp,"\n"); |
fprintf(fp,"\n"); |
fprintf(fp,"where "); |
fprintf(fp,"where "); |
for (i=M; i<N; i++) { |
for (i=M; i<N; i++) { |
fprintf(fp," %s %s - %s %s = 1, ",TransD[i],TransX[i], |
fx = cxx(1,i,1,ringp); fd = cdd(1,i,1,ringp); |
TransX[i],TransD[i]); |
rf = ppSub(ppMult(fd,fx),ppMult(fx,fd)); |
|
fprintf(fp," %s %s - %s %s = %s, ",TransD[i],TransX[i], |
|
TransX[i],TransD[i],POLYToString(rf,'*',0)); |
} |
} |
fprintf(fp,"\n\n"); |
fprintf(fp,"\n\n"); |
} |
} |
Line 92 struct ring *ringp; |
|
Line 98 struct ring *ringp; |
|
fprintf(fp,"\n"); |
fprintf(fp,"\n"); |
fprintf(fp,"where "); |
fprintf(fp,"where "); |
for (i=L; i<M; i++) { |
for (i=L; i<M; i++) { |
fprintf(fp," %s %s - %s %s = %s, ",TransD[i],TransX[i], |
fprintf(fp," %s %s - %s %s = ",TransD[i],TransX[i], |
TransX[i],TransD[i], |
TransX[i],TransD[i]); |
TransD[i]); |
f=ppSub(ppMult(cdd(1,i,1,ringp),cxx(1,i,1,ringp)), |
|
ppMult(cxx(1,i,1,ringp),cdd(1,i,1,ringp))); |
|
fprintf(fp," %s, ",POLYToString(f,'*',0)); |
} |
} |
fprintf(fp,"\n\n"); |
fprintf(fp,"\n\n"); |
} |
} |
Line 106 struct ring *ringp; |
|
Line 114 struct ring *ringp; |
|
fprintf(fp,"where "); |
fprintf(fp,"where "); |
for (i=C; i<L; i++) { |
for (i=C; i<L; i++) { |
fprintf(fp," %s %s = %s %s %s, ",TransD[i],TransX[i], |
fprintf(fp," %s %s = %s %s %s, ",TransD[i],TransX[i], |
TransX[0], |
TransX[0], |
TransX[i],TransD[i]); |
TransX[i],TransD[i]); |
} |
} |
fprintf(fp,"\n\n"); |
fprintf(fp,"\n\n"); |
} |
} |
Line 166 struct ring *ringp; |
|
Line 174 struct ring *ringp; |
|
mtype = "unknown"; |
mtype = "unknown"; |
} |
} |
fprintf(fp,"Multiplication function --%s(%xH).\n", |
fprintf(fp,"Multiplication function --%s(%xH).\n", |
mtype,(unsigned int) ringp->multiplication); |
mtype,(unsigned int) ringp->multiplication); |
if (ringp->schreyer) { |
if (ringp->schreyer) { |
fprintf(fp,"schreyer=1, gbListTower="); |
fprintf(fp,"schreyer=1, gbListTower="); |
printObjectList((struct object *)(ringp->gbListTower)); |
printObjectList((struct object *)(ringp->gbListTower)); |
fprintf(fp,"\n"); |
fprintf(fp,"\n"); |
} |
} |
|
if (ringp->degreeShiftSize) { |
|
fprintf(fp,"degreeShift vector (N=%d,Size=%d)= \n[\n",ringp->degreeShiftN,ringp->degreeShiftSize); |
|
{ |
|
int i,j; |
|
for (i=0; i<ringp->degreeShiftN; i++) { |
|
fprintf(fp," ["); |
|
for (j=0; j< ringp->degreeShiftSize; j++) { |
|
fprintf(fp," %d ",ringp->degreeShift[i*(ringp->degreeShiftSize)+j]); |
|
} |
|
fprintf(fp,"]\n"); |
|
} |
|
} |
|
fprintf(fp,"]\n"); |
|
} |
|
fprintf(fp,"--- weight vectors ---\n"); |
if (level) printOrder(ringp); |
if (level) printOrder(ringp); |
|
|
|
if (ringp->partialEcart) { |
|
fprintf(fp,"--- partialEcartGlobalVarX ---\n"); |
|
for (i=0; i<ringp->partialEcart; i++) { |
|
fprintf(fp," %4s ",TransX[ringp->partialEcartGlobalVarX[i]]); |
|
} |
|
fprintf(fp,"\n"); |
|
} |
|
|
if (ringp->next != (struct ring *)NULL) { |
if (ringp->next != (struct ring *)NULL) { |
fprintf(fp,"\n\n-------- The next ring is .... --------------\n"); |
fprintf(fp,"\n\n-------- The next ring is .... --------------\n"); |
Line 203 if (isD(i)) D_{itod(i)} |
|
Line 233 if (isD(i)) D_{itod(i)} |
|
*/ |
*/ |
|
|
void printOrder(ringp) |
void printOrder(ringp) |
struct ring *ringp; |
struct ring *ringp; |
{ |
{ |
int i,j; |
int i,j; |
FILE *fp; |
FILE *fp; |
Line 245 struct ring *ringp; |
|
Line 275 struct ring *ringp; |
|
fprintf(fp,"\n"); |
fprintf(fp,"\n"); |
|
|
/* print D: differential DE: differential, should be eliminated |
/* print D: differential DE: differential, should be eliminated |
E: difference |
E: difference |
Q: q-difference |
Q: q-difference |
C: commutative |
C: commutative |
*/ |
*/ |
if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) { |
if (strcmp(F_isSameComponent,"x")== 0 || strcmp(F_isSameComponent,"xd")==0) { |
for (i=0; i<N; i++) { |
for (i=0; i<N; i++) { |
Line 296 struct ring *ringp; |
|
Line 326 struct ring *ringp; |
|
|
|
struct object oGetOrderMatrix(struct ring *ringp) |
struct object oGetOrderMatrix(struct ring *ringp) |
{ |
{ |
struct object rob,ob2; |
struct object rob = OINIT; |
|
struct object ob2 = OINIT; |
int n,i,j,m; |
int n,i,j,m; |
int *om; |
int *om; |
n = ringp->n; |
n = ringp->n; |
Line 316 struct object oGetOrderMatrix(struct ring *ringp) |
|
Line 347 struct object oGetOrderMatrix(struct ring *ringp) |
|
|
|
|
|
int mmLarger_matrix(ff,gg) |
int mmLarger_matrix(ff,gg) |
POLY ff; POLY gg; |
POLY ff; POLY gg; |
{ |
{ |
int exp[2*N0]; /* exponents */ |
int exp[2*N0]; /* exponents */ |
int i,k; |
int i,k; |
Line 328 POLY ff; POLY gg; |
|
Line 359 POLY ff; POLY gg; |
|
int in2; |
int in2; |
int *from, *to; |
int *from, *to; |
int omsize; |
int omsize; |
|
int dssize; |
|
int dsn; |
|
int *degreeShiftVector; |
|
|
if (ff == POLYNULL ) { |
if (ff == POLYNULL ) { |
if (gg == POLYNULL) return( 2 ); |
if (gg == POLYNULL) return( 2 ); |
Line 345 POLY ff; POLY gg; |
|
Line 379 POLY ff; POLY gg; |
|
from = rp->from; |
from = rp->from; |
to = rp->to; |
to = rp->to; |
omsize = rp->orderMatrixSize; |
omsize = rp->orderMatrixSize; |
|
if (dssize = rp->degreeShiftSize) { |
|
degreeShiftVector = rp->degreeShift; /* Note. 2003.06.26 */ |
|
dsn = rp->degreeShiftN; |
|
} |
|
|
flag = 1; |
flag = 1; |
for (i=N-1,k=0; i>=0; i--,k++) { |
for (i=N-1,k=0; i>=0; i--,k++) { |
Line 361 POLY ff; POLY gg; |
|
Line 399 POLY ff; POLY gg; |
|
sum = 0; in2 = i*2*N; |
sum = 0; in2 = i*2*N; |
/* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */ |
/* for (k=0; k<2*N; k++) sum += exp[k]*Order[in2+k]; */ |
for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k]; |
for (k=from[i]; k<to[i]; k++) sum += exp[k]*Order[in2+k]; |
|
if (dssize && ( i < dsn)) { /* Note, 2003.06.26 */ |
|
if ((f->e[N-1].x < dssize) && (f->e[N-1].x >= 0) && |
|
(g->e[N-1].x < dssize) && (g->e[N-1].x >= 0)) { |
|
sum += degreeShiftVector[i*dssize+ (f->e[N-1].x)] |
|
-degreeShiftVector[i*dssize+ (g->e[N-1].x)]; |
|
}else{ |
|
/*warningOrder("Size mismatch in the degree shift vector. It is ignored.");*/ |
|
} |
|
} |
if (sum > 0) return(1); |
if (sum > 0) return(1); |
if (sum < 0) return(0); |
if (sum < 0) return(0); |
} |
} |
Line 369 POLY ff; POLY gg; |
|
Line 416 POLY ff; POLY gg; |
|
|
|
/* This should be used in case of q */ |
/* This should be used in case of q */ |
int mmLarger_qmatrix(ff,gg) |
int mmLarger_qmatrix(ff,gg) |
POLY ff; POLY gg; |
POLY ff; POLY gg; |
{ |
{ |
int exp[2*N0]; /* exponents */ |
int exp[2*N0]; /* exponents */ |
int i,k; |
int i,k; |
Line 418 POLY ff; POLY gg; |
|
Line 465 POLY ff; POLY gg; |
|
|
|
/* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */ |
/* x(N-1)>x(N-2)>....>D(N-1)>....>D(0) */ |
mmLarger_pureLexicographic(f,g) |
mmLarger_pureLexicographic(f,g) |
POLY f; |
POLY f; |
POLY g; |
POLY g; |
{ |
{ |
int i,r; |
int i,r; |
int n; |
int n; |
|
|
|
|
|
|
void setFromTo(ringp) |
void setFromTo(ringp) |
struct ring *ringp; |
struct ring *ringp; |
{ |
{ |
int n; |
int n; |
int i,j,oasize; |
int i,j,oasize; |
Line 474 struct ring *ringp; |
|
Line 521 struct ring *ringp; |
|
ringp->from[i] = 0; ringp->to[i] = n; |
ringp->from[i] = 0; ringp->to[i] = n; |
for (j=0; j<n; j++) { |
for (j=0; j<n; j++) { |
if (ringp->order[i*n+j] != 0) { |
if (ringp->order[i*n+j] != 0) { |
ringp->from[i] = j; |
ringp->from[i] = j; |
break; |
break; |
} |
} |
} |
} |
for (j=n-1; j>=0; j--) { |
for (j=n-1; j>=0; j--) { |
if (ringp->order[i*n+j] != 0) { |
if (ringp->order[i*n+j] != 0) { |
ringp->to[i] = j+1; |
ringp->to[i] = j+1; |
break; |
break; |
} |
} |
} |
} |
} |
} |
Line 490 struct ring *ringp; |
|
Line 537 struct ring *ringp; |
|
/* It ignores h and should be used with mmLarger_tower */ |
/* It ignores h and should be used with mmLarger_tower */ |
/* cf. mmLarger_matrix. h always must be checked at last. */ |
/* cf. mmLarger_matrix. h always must be checked at last. */ |
static int mmLarger_matrix_schreyer(ff,gg) |
static int mmLarger_matrix_schreyer(ff,gg) |
POLY ff; POLY gg; |
POLY ff; POLY gg; |
{ |
{ |
int exp[2*N0]; /* exponents */ |
int exp[2*N0]; /* exponents */ |
int i,k; |
int i,k; |
Line 558 int mmLarger_tower(POLY f,POLY g) { |
|
Line 605 int mmLarger_tower(POLY f,POLY g) { |
|
} |
} |
if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer)) |
if (!(f->m->ringp->schreyer) || !(g->m->ringp->schreyer)) |
return(mmLarger_matrix(f,g)); |
return(mmLarger_matrix(f,g)); |
/* modifiable: mmLarger_qmatrix */ |
/* modifiable: mmLarger_qmatrix */ |
gbList = (struct object *)(g->m->ringp->gbListTower); |
gbList = (struct object *)(g->m->ringp->gbListTower); |
if (gbList == NULL) return(mmLarger_matrix(f,g)); |
if (gbList == NULL) return(mmLarger_matrix(f,g)); |
/* modifiable: mmLarger_qmatrix */ |
/* modifiable: mmLarger_qmatrix */ |
if (gbList->tag != Slist) { |
if (gbList->tag != Slist) { |
warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); |
warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); |
return(1); |
return(1); |
} |
} |
if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); |
if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); |
/* modifiable: mmLarger_qmatrix */ |
/* modifiable: mmLarger_qmatrix */ |
|
|
r = mmLarger_tower3(f,g,gbList); |
r = mmLarger_tower3(f,g,gbList); |
/* printf("mmLarger_tower3(%s,%s) --> %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */ |
/* printf("mmLarger_tower3(%s,%s) --> %d\n",POLYToString(head(f),'*',1),POLYToString(head(g),'*',1),r); */ |
Line 585 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
Line 632 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
int n,fv,gv,t,r,nn; |
int n,fv,gv,t,r,nn; |
POLY fm; |
POLY fm; |
POLY gm; |
POLY gm; |
struct object gb; |
struct object gb = OINIT; |
|
|
if (f == POLYNULL) { |
if (f == POLYNULL) { |
if (g == POLYNULL) return(2); |
if (g == POLYNULL) return(2); |
Line 598 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
Line 645 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
n = f->m->ringp->n; |
n = f->m->ringp->n; |
nn = f->m->ringp->nn; |
nn = f->m->ringp->nn; |
/* critical and modifiable */ /* m e_u > m e_v <==> m g_u > m g_v */ |
/* critical and modifiable */ /* m e_u > m e_v <==> m g_u > m g_v */ |
/* or equal and u < v */ |
/* or equal and u < v */ |
fv = f->m->e[nn].x ; /* extract component (vector) number of f! */ |
fv = f->m->e[nn].x ; /* extract component (vector) number of f! */ |
gv = g->m->e[nn].x ; |
gv = g->m->e[nn].x ; |
if (fv == gv) { /* They have the same component number. */ |
if (fv == gv) { /* They have the same component number. */ |
Line 606 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
Line 653 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
} |
} |
|
|
if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g)); |
if (gbList == NULL) return(mmLarger_matrix_schreyer(f,g)); |
/* modifiable: mmLarger_qmatrix */ |
/* modifiable: mmLarger_qmatrix */ |
if (gbList->tag != Slist) { |
if (gbList->tag != Slist) { |
warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); |
warningOrder("mmLarger_tower(): gbList must be in Slist.\n"); |
return(1); |
return(1); |
} |
} |
if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); |
if (klength(gbList) ==0) return(mmLarger_matrix(f,g)); |
/* modifiable: mmLarger_qmatrix */ |
/* modifiable: mmLarger_qmatrix */ |
gb = car(gbList); /* each entry must be monomials */ |
gb = car(gbList); /* each entry must be monomials */ |
if (gb.tag != Sarray) { |
if (gb.tag != Sarray) { |
warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n"); |
warningOrder("mmLarger_tower3(): car(gbList) must be an array.\n"); |
Line 626 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
Line 673 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
if (fv >= t || gv >= t) { |
if (fv >= t || gv >= t) { |
warningOrder("mmLarger_tower3(): incompatible input and gbList.\n"); |
warningOrder("mmLarger_tower3(): incompatible input and gbList.\n"); |
printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f), |
printf("Length of gb is %d, f is %s, g is %s\n",t,KPOLYToString(f), |
KPOLYToString(g)); |
KPOLYToString(g)); |
|
KSexecuteString(" show_ring "); |
return(1); |
return(1); |
} |
} |
/* mpMult_poly is too expensive to call. @@@*/ |
/* mpMult_poly is too expensive to call. @@@*/ |
Line 638 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
Line 686 int mmLarger_tower3(POLY f,POLY g,struct object *gbLis |
|
else if (fv > gv) return(0); /* modifiable */ |
else if (fv > gv) return(0); /* modifiable */ |
else if (fv < gv) return(1); /* modifiable */ |
else if (fv < gv) return(1); /* modifiable */ |
} |
} |
|
|
|
static struct object auxPruneZeroRow(struct object ob) { |
|
int i,m,size; |
|
struct object obt = OINIT; |
|
struct object rob = OINIT; |
|
m = getoaSize(ob); |
|
size=0; |
|
for (i=0; i<m; i++) { |
|
obt = getoa(ob,i); |
|
if (getoaSize(obt) != 0) size++; |
|
} |
|
if (size == m) return ob; |
|
rob = newObjectArray(size); |
|
for (i=0, size=0; i<m; i++) { |
|
obt = getoa(ob,i); |
|
if (getoaSize(obt) != 0) { |
|
putoa(rob,size,obt); size++; |
|
} |
|
} |
|
return rob; |
|
} |
|
static struct object oRingToOXringStructure_long(struct ring *ringp) |
|
{ |
|
struct object rob = OINIT; |
|
struct object ob2 = OINIT; |
|
struct object obMat = OINIT; |
|
struct object obV = OINIT; |
|
struct object obShift = OINIT; |
|
struct object obt = OINIT; |
|
char **TransX; char **TransD; |
|
int n,i,j,m,p,nonzero; |
|
int *om; |
|
n = ringp->n; |
|
m = ringp->orderMatrixSize; |
|
om = ringp->order; |
|
TransX = ringp->x; TransD = ringp->D; |
|
if (m<=0) m = 1; |
|
/*test: (1). getRing /rr set rr (oxRingStructure) dc */ |
|
obMat = newObjectArray(m); |
|
for (i=0; i<m; i++) { |
|
nonzero = 0; |
|
for (j=0; j<2*n; j++) { |
|
if (om[2*n*i+j] != 0) nonzero++; |
|
} |
|
ob2 = newObjectArray(nonzero*2); |
|
nonzero=0; |
|
for (j=0; j<2*n; j++) { |
|
/* fprintf(stderr,"%d, ",nonzero); */ |
|
if (om[2*n*i+j] != 0) { |
|
if (j < n) { |
|
putoa(ob2,nonzero,KpoString(TransX[n-1-j])); nonzero++; |
|
}else{ |
|
putoa(ob2,nonzero,KpoString(TransD[n-1-(j-n)])); nonzero++; |
|
} |
|
putoa(ob2,nonzero,KpoUniversalNumber(newUniversalNumber(om[2*n*i+j]))); nonzero++; |
|
} |
|
} |
|
/* printObject(ob2,0,stderr); fprintf(stderr,".\n"); */ |
|
putoa(obMat,i,ob2); |
|
} |
|
obMat = auxPruneZeroRow(obMat); |
|
/* printObject(obMat,0,stderr); */ |
|
|
|
obV = newObjectArray(2*n); |
|
for (i=0; i<n; i++) putoa(obV,i,KpoString(TransX[n-1-i])); |
|
for (i=0; i<n; i++) putoa(obV,i+n,KpoString(TransD[n-1-i])); |
|
/* printObject(obV,0,stderr); */ |
|
|
|
if (ringp->degreeShiftSize) { |
|
/*test: |
|
[(x) ring_of_differential_operators [[(x)]] weight_vector 0 |
|
[(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ; |
|
(1). getRing /rr set rr (oxRingStructure) dc message |
|
*/ |
|
obShift = newObjectArray(ringp->degreeShiftN); |
|
for (i=0; i<ringp->degreeShiftN; i++) { |
|
obt = newObjectArray(ringp->degreeShiftSize); |
|
for (j=0; j< ringp->degreeShiftSize; j++) { |
|
putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j]))); |
|
} |
|
putoa(obShift,i,obt); |
|
} |
|
/* printObject(obShift,0,stderr); */ |
|
} |
|
|
|
p = 0; |
|
if (ringp->degreeShiftSize) { |
|
rob = newObjectArray(3); |
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("degreeShift")); |
|
putoa(obt,1,obShift); |
|
putoa(rob,p, obt); p++; |
|
}else { |
|
rob = newObjectArray(2); |
|
} |
|
|
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("v")); |
|
putoa(obt,1,obV); |
|
putoa(rob,p, obt); p++; |
|
|
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("order")); |
|
putoa(obt,1,obMat); |
|
putoa(rob,p, obt); p++; |
|
|
|
return(rob); |
|
} |
|
static int auxEffectiveVar(int idx,int n) { |
|
int x; |
|
if (idx < n) x=1; else x=0; |
|
if (x) { |
|
if ((idx >= 1) && (idx < n-1)) return 1; |
|
else return 0; |
|
}else{ |
|
if ( 1 <= idx-n ) return 1; |
|
else return 0; |
|
} |
|
} |
|
/*test: |
|
[(x,y) ring_of_differential_operators [[(Dx) 1 (Dy) 1]] |
|
weight_vector 0] define_ring |
|
(x). getRing (oxRingStructure) dc :: |
|
*/ |
|
static struct object oRingToOXringStructure_short(struct ring *ringp) |
|
{ |
|
struct object rob = OINIT; |
|
struct object ob2 = OINIT; |
|
struct object obMat = OINIT; |
|
struct object obV = OINIT; |
|
struct object obShift = OINIT; |
|
struct object obt = OINIT; |
|
char **TransX; char **TransD; |
|
int n,i,j,m,p,nonzero; |
|
int *om; |
|
n = ringp->n; |
|
m = ringp->orderMatrixSize; |
|
om = ringp->order; |
|
TransX = ringp->x; TransD = ringp->D; |
|
if (m<=0) m = 1; |
|
/*test: (1). getRing /rr set rr (oxRingStructure) dc */ |
|
obMat = newObjectArray(m); |
|
for (i=0; i<m; i++) { |
|
nonzero = 0; |
|
for (j=0; j<2*n; j++) { |
|
if ((om[2*n*i+j] != 0) && auxEffectiveVar(j,n)) nonzero++; |
|
} |
|
ob2 = newObjectArray(nonzero*2); |
|
nonzero=0; |
|
for (j=0; j<2*n; j++) { |
|
/* fprintf(stderr,"%d, ",nonzero); */ |
|
if ((om[2*n*i+j] != 0) && auxEffectiveVar(j,n)) { |
|
if (j < n) { |
|
putoa(ob2,nonzero,KpoString(TransX[n-1-j])); nonzero++; |
|
}else{ |
|
putoa(ob2,nonzero,KpoString(TransD[n-1-(j-n)])); nonzero++; |
|
} |
|
putoa(ob2,nonzero,KpoUniversalNumber(newUniversalNumber(om[2*n*i+j]))); nonzero++; |
|
} |
|
} |
|
/* printObject(ob2,0,stderr); fprintf(stderr,".\n"); */ |
|
putoa(obMat,i,ob2); |
|
} |
|
obMat = auxPruneZeroRow(obMat); |
|
/* printObject(obMat,0,stderr); */ |
|
|
|
obV = newObjectArray(2*n-3); |
|
for (i=0; i<n-2; i++) putoa(obV,i,KpoString(TransX[n-1-i-1])); |
|
for (i=0; i<n-1; i++) putoa(obV,i+n-2,KpoString(TransD[n-1-i-1])); |
|
/* printObject(obV,0,stderr); */ |
|
|
|
if (ringp->degreeShiftSize) { |
|
/*test: |
|
[(x) ring_of_differential_operators [[(x)]] weight_vector 0 |
|
[(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] ] define_ring ; |
|
(1). getRing /rr set rr (oxRingStructure) dc message |
|
*/ |
|
obShift = newObjectArray(ringp->degreeShiftN); |
|
for (i=0; i<ringp->degreeShiftN; i++) { |
|
obt = newObjectArray(ringp->degreeShiftSize); |
|
for (j=0; j< ringp->degreeShiftSize; j++) { |
|
putoa(obt,j,KpoUniversalNumber(newUniversalNumber(ringp->degreeShift[i*(ringp->degreeShiftSize)+j]))); |
|
} |
|
putoa(obShift,i,obt); |
|
} |
|
/* printObject(obShift,0,stderr); */ |
|
} |
|
|
|
p = 0; |
|
if (ringp->degreeShiftSize) { |
|
rob = newObjectArray(3); |
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("degreeShift")); |
|
putoa(obt,1,obShift); |
|
putoa(rob,p, obt); p++; |
|
}else { |
|
rob = newObjectArray(2); |
|
} |
|
|
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("v")); |
|
putoa(obt,1,obV); |
|
putoa(rob,p, obt); p++; |
|
|
|
obt = newObjectArray(2); |
|
putoa(obt,0,KpoString("order")); |
|
putoa(obt,1,obMat); |
|
putoa(rob,p, obt); p++; |
|
|
|
return(rob); |
|
} |
|
struct object oRingToOXringStructure(struct ring *ringp) |
|
{ |
|
struct object rob = OINIT; |
|
struct object tob = OINIT; |
|
rob = newObjectArray(2); |
|
tob = oRingToOXringStructure_short(ringp); |
|
putoa(rob,0,tob); |
|
tob = oRingToOXringStructure_long(ringp); |
|
putoa(rob,1,tob); |
|
return(rob); |
|
} |
|
|
static void warningOrder(s) |
static void warningOrder(s) |
char *s; |
char *s; |
{ |
{ |
fprintf(stderr,"Warning in order.c: %s\n",s); |
fprintf(stderr,"Warning in order.c: %s\n",s); |
} |
} |
|
|
static void errorOrder(s) |
static void errorOrder(s) |
char *s; |
char *s; |
{ |
{ |
fprintf(stderr,"order.c: %s\n",s); |
fprintf(stderr,"order.c: %s\n",s); |
exit(14); |
exit(14); |