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.8 and 1.18

version 1.8, 2003/08/23 02:28:38

version 1.18, 2005/06/16 05:07:23

Line 1

/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.7 2003/08/22 11:47:03 takayama Exp $ */

/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport1.c,v 1.17 2005/06/09 04:09:22 takayama Exp $ */

#include <stdio.h>

#include "datatype.h"

#include "stackm.h"

Line 12

static int Message = 1;

extern int KanGBmessage;

struct object DegreeShifto;

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)

Line 24 struct object Kreduction(f,set)

Line 27 struct object Kreduction(f,set)

POLY r;

struct gradedPolySet *grG;

struct syz0 syz;

struct object rob;

struct object rob = OINIT;

int flag;

extern int ReduceLowerTerms;

Line 67 struct object Kgroebner(ob)

Line 70 struct object Kgroebner(ob)

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 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 127 struct object Kgroebner(ob)

Line 133 struct object Kgroebner(ob)

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) {

Line 231 struct object Kgroebner(ob)

Line 239 struct object Kgroebner(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 248 struct object Kgroebner(ob)

Line 256 struct object Kgroebner(ob)

}

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)) {

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

Line 271 struct object Kgroebner(ob)

Line 279 struct object Kgroebner(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 338 struct object Kgroebner(ob)

Line 347 struct object Kgroebner(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 353 static struct object paddingVector(struct object ob, i

Line 362 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 408 struct object polySetToArray(ps,keepRedundant)

Line 417 struct object polySetToArray(ps,keepRedundant)

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 434 struct object gradedPolySetToGradedArray(gps,keepRedun

Line 443 struct object gradedPolySetToGradedArray(gps,keepRedun

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 452 struct object gradedPolySetToArray(gps,keepRedundant)

Line 462 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 491 struct object syzPolyToArray(size,f,grG)

Line 502 struct object syzPolyToArray(size,f,grG)

POLY f;

struct gradedPolySet *grG;

{

struct object ob;

struct object ob = OINIT;

int i,g0,i0,serial;

ob = newObjectArray(size);

Line 521 struct object getBackwardArray(grG)

Line 532 struct object getBackwardArray(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 552 POLY arrayToPOLY(ob)

Line 563 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 601 struct object POLYToArray(ff)

Line 612 struct object POLYToArray(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 661 struct object homogenizeObject(ob,gradep)

Line 672 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 727 struct object homogenizeObject_vec(ob,gradep)

Line 739 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 771 struct object homogenizeObject_vec(ob,gradep)

Line 784 struct object homogenizeObject_vec(ob,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;

struct object ob0 = OINIT;

struct object ob1;

struct object ob1 = OINIT;

struct object ob2;

struct object ob2 = OINIT;

struct object rob;

struct object rob = OINIT;

struct object tob;

struct object tob = OINIT;

struct object ob1t;

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);

Line 792 struct object homogenizeObject_go(struct object ob,int

Line 834 struct object homogenizeObject_go(struct object ob,int

}

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");

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 (DegreeShifto_size != 0) {

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

return DegreeShifto;

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

}else{

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

rob = NullObject;

KresetDegreeShift();

return rob;

}

rob = newObjectArray(2);

putoa(rob,0,DegreeShiftD);

putoa(rob,1,DegreeShifto);

return rob;

}

dssize = getoaSize(ob1);

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

if (getoaSize(ob1) == 2) {

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

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

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

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

}

DegreeShiftD = getoa(ob1,0);

if (size == 2) {

dssize = getoaSize(DegreeShiftD);

DegreeShifto = ob1;

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;

rob = ob1;

}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,0);

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

rob = KpoPOLY(f);

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

rob = ob2;

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

rob = newObjectArray(getoaSize(ob2));

int mm;

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

mm = getoaSize(ob2);

tob = newObjectArray(3);

f = objArrayToPOLY(ob2);

ob1t = newObjectArray(dssize);

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

if (getoa(ob2,i).tag == Spoly) {

rob = POLYtoObjArray(f,mm);

for (j=0; j<dssize; j++) getoa(ob1t,j) = KpoInteger(0);

for (j=0; j<dssize-i; j++) getoa(ob1t,j) = getoa(ob1,j+i);

}else{

ob1t = ob1;

}

getoa(tob,0) = ob0; getoa(tob,1) = ob1t; getoa(tob,2) = getoa(ob2,i);

getoa(rob,i) = homogenizeObject_go(tob,gradep);

}

}else{

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

}

Line 903 struct object oPrincipalPart(ob)

Line 974 struct object oPrincipalPart(ob)

struct object ob;

{

POLY f;

struct object rob;

struct object rob = OINIT;

switch(ob.tag) {

case Spoly:

Line 920 struct object oInitW(ob,oWeight)

Line 991 struct object oInitW(ob,oWeight)

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;

struct object oShift = OINIT;

int *s;

int ssize,m;

Line 935 struct object oInitW(ob,oWeight)

Line 1006 struct object oInitW(ob,oWeight)

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);

Line 1038 POLY objArrayToPOLY(struct object ob) {

Line 1110 POLY objArrayToPOLY(struct object ob) {

}

struct object POLYtoObjArray(POLY f,int size) {

struct object rob;

struct object rob = OINIT;

POLY *pa;

int d,n,i;

POLY t;

Line 1074 struct object KordWsAll(ob,oWeight)

Line 1146 struct object KordWsAll(ob,oWeight)

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;

struct object oShift = OINIT;

int *s;

int ssize,m;

Line 1089 struct object KordWsAll(ob,oWeight)

Line 1161 struct object KordWsAll(ob,oWeight)

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);

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

Line 1261 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 1220 struct object KsetOutputOrder(struct object ob, struct

Line 1293 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 1269 struct object KvectorToSchreyer_es(struct object obarr

Line 1342 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 1304 int objToInteger(struct object ob) {

Line 1377 int objToInteger(struct object 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>