version 1.245, 2018/03/29 01:32:52 |
version 1.249, 2020/10/04 03:14:08 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.244 2018/03/05 06:43:09 noro Exp $ */ |
/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.248 2019/03/03 05:21:16 noro Exp $ */ |
|
|
#include "nd.h" |
#include "nd.h" |
|
|
Line 107 NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int |
|
Line 107 NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int |
|
int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat); |
int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat); |
NODE nd_f4_lf_trace_main(int m,int **indp); |
NODE nd_f4_lf_trace_main(int m,int **indp); |
void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp); |
void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp); |
|
void addlf(Z a,Z b,Z *c); |
|
void sublf(Z a,Z b,Z *c); |
|
void mullf(Z a,Z b,Z *c); |
|
void divlf(Z a,Z b,Z *c); |
|
void chsgnlf(Z a,Z *c); |
|
int cmplf(Z a,Z b); |
|
void simplf(Z a,Z *b); |
|
void simplf_force(Z a,Z *b); |
|
void setmod_lf(Z p); |
|
void lmtolf(LM f,Z *b); |
|
void invgz(GZ n1,GZ *nq); |
|
|
extern int lf_lazy; |
extern int lf_lazy; |
extern GZ current_mod_lf; |
extern GZ current_mod_lf; |
|
|
r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos); |
r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos); |
else |
else |
r = (NDV)BDY(t); |
r = (NDV)BDY(t); |
if ( m ) ndv_mod(m,r); |
#if 0 |
|
// moved to nd_f4_lf_trace() |
|
if ( m == -2 ) ndv_mod(m,r); |
|
#endif |
d = ndvtond(m,r); |
d = ndvtond(m,r); |
stat = nd_nf(m,0,d,nd_ps,0,0,&nf); |
stat = nd_nf(m,0,d,nd_ps,0,0,&nf); |
if ( !stat ) { |
if ( !stat ) { |
Line 4104 void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos |
|
Line 4118 void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos |
|
NMV m,mr0,mr,t; |
NMV m,mr0,mr,t; |
|
|
len = p->len; |
len = p->len; |
for ( m = BDY(p), i = 0, max = 1; i < len; NMV_OADV(m), i++ ) |
for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ ) |
max = MAX(max,TD(DL(m))); |
max = MAX(max,TD(DL(m))); |
mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p); |
mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p); |
m = (NMV)((char *)mr0+(len-1)*oadv); |
m = (NMV)((char *)mr0+(len-1)*oadv); |
Line 8716 P ndctop(int mod,union oNDC c) |
|
Line 8730 P ndctop(int mod,union oNDC c) |
|
|
|
if ( mod == -1 ) { |
if ( mod == -1 ) { |
e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs; |
e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs; |
|
} else if ( mod == -2 ) { |
|
q = gztoz(c.gz); return (P)q; |
} else if ( mod > 0 ) { |
} else if ( mod > 0 ) { |
STOQ(c.m,q); return (P)q; |
STOQ(c.m,q); return (P)q; |
} else |
} else |
Line 8825 void parse_nd_option(NODE opt) |
|
Line 8841 void parse_nd_option(NODE opt) |
|
|
|
ND mdptond(DP d); |
ND mdptond(DP d); |
ND nd_mul_nm(int mod,NM m0,ND p); |
ND nd_mul_nm(int mod,NM m0,ND p); |
|
ND nd_mul_nm_lf(NM m0,ND p); |
ND *btog(NODE ti,ND **p,int nb,int mod); |
ND *btog(NODE ti,ND **p,int nb,int mod); |
ND btog_one(NODE ti,ND *p,int nb,int mod); |
ND btog_one(NODE ti,ND *p,int nb,int mod); |
MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp); |
MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp); |
Line 8869 ND nd_mul_nm(int mod,NM m0,ND p) |
|
Line 8886 ND nd_mul_nm(int mod,NM m0,ND p) |
|
return r; |
return r; |
} |
} |
|
|
|
ND nd_mul_nm_lf(NM m0,ND p) |
|
{ |
|
UINT *d0; |
|
GZ c0,c1,c; |
|
NM tm,mr,mr0; |
|
ND r; |
|
|
|
if ( !p ) return 0; |
|
d0 = DL(m0); |
|
c0 = CZ(m0); |
|
mr0 = 0; |
|
for ( tm = BDY(p); tm; tm = NEXT(tm) ) { |
|
NEXTNM(mr0,mr); |
|
c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1; |
|
ndl_add(d0,DL(tm),DL(mr)); |
|
} |
|
NEXT(mr) = 0; |
|
MKND(NV(p),mr0,LEN(p),r); |
|
return r; |
|
} |
|
|
ND *btog(NODE ti,ND **p,int nb,int mod) |
ND *btog(NODE ti,ND **p,int nb,int mod) |
{ |
{ |
PGeoBucket *r; |
PGeoBucket *r; |
Line 8908 ND *btog(NODE ti,ND **p,int nb,int mod) |
|
Line 8946 ND *btog(NODE ti,ND **p,int nb,int mod) |
|
return rd; |
return rd; |
} |
} |
|
|
|
/* YYY */ |
|
ND *btog_lf(NODE ti,ND **p,int nb) |
|
{ |
|
PGeoBucket *r; |
|
int i; |
|
NODE t,s; |
|
ND m,tp; |
|
ND *pi,*rd; |
|
LM lm; |
|
GZ lf,c; |
|
|
|
r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket)); |
|
for ( i = 0; i < nb; i++ ) |
|
r[i] = create_pbucket(); |
|
for ( t = ti; t; t = NEXT(t) ) { |
|
s = BDY((LIST)BDY(t)); |
|
if ( ARG0(s) ) { |
|
m = mdptond((DP)ARG2(s)); |
|
simp_ff((Obj)HCQ(m),&lm); |
|
if ( lm ) { |
|
lmtolf(lm,&lf); HCZ(m) = lf; |
|
pi = p[QTOS((Q)ARG1(s))]; |
|
for ( i = 0; i < nb; i++ ) { |
|
tp = nd_mul_nm_lf(BDY(m),pi[i]); |
|
add_pbucket(-2,r[i],tp); |
|
} |
|
} |
|
c = ONEGZ; |
|
} else { |
|
simp_ff((Obj)ARG3(s),&lm); lmtolf(lm,&lf); invgz(lf,&c); |
|
} |
|
} |
|
rd = (ND *)MALLOC(nb*sizeof(ND)); |
|
for ( i = 0; i < nb; i++ ) |
|
rd[i] = normalize_pbucket(-2,r[i]); |
|
for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c); |
|
return rd; |
|
} |
|
|
ND btog_one(NODE ti,ND *p,int nb,int mod) |
ND btog_one(NODE ti,ND *p,int nb,int mod) |
{ |
{ |
PGeoBucket r; |
PGeoBucket r; |
Line 8948 ND btog_one(NODE ti,ND *p,int nb,int mod) |
|
Line 9025 ND btog_one(NODE ti,ND *p,int nb,int mod) |
|
return rd; |
return rd; |
} |
} |
|
|
|
MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp); |
|
|
MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp) |
MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp) |
{ |
{ |
int i,j,n,m,nb,pi0,pi1,nvar; |
int i,j,n,m,nb,pi0,pi1,nvar; |
Line 8959 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
Line 9038 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
P inv; |
P inv; |
MAT mat; |
MAT mat; |
|
|
|
if ( mod == -2 ) |
|
return nd_btog_lf(f,v,ord,tlist,rp); |
|
|
parse_nd_option(current_option); |
parse_nd_option(current_option); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
Line 8990 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
Line 9072 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
p = (ND **)MALLOC(n*sizeof(ND *)); |
p = (ND **)MALLOC(n*sizeof(ND *)); |
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
pi = BDY((LIST)BDY(t)); |
pi = BDY((LIST)BDY(t)); |
pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); |
pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); |
p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND)); |
p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND)); |
ptomp(mod,(P)ARG2(pi),&inv); |
ptomp(mod,(P)ARG2(pi),&inv); |
((MQ)inv)->cont = invm(((MQ)inv)->cont,mod); |
((MQ)inv)->cont = invm(((MQ)inv)->cont,mod); |
u = ptond(CO,vv,(P)ONE); |
u = ptond(CO,vv,(P)ONE); |
HCM(u) = ((MQ)inv)->cont; |
HCM(u) = ((MQ)inv)->cont; |
c[pi1] = u; |
c[pi1] = u; |
} |
} |
for ( t = trace,i=0; t; t = NEXT(t), i++ ) { |
for ( t = trace,i=0; t; t = NEXT(t), i++ ) { |
printf("%d ",i); fflush(stdout); |
printf("%d ",i); fflush(stdout); |
ti = BDY((LIST)BDY(t)); |
ti = BDY((LIST)BDY(t)); |
p[j=QTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod); |
p[j=QTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod); |
} |
} |
for ( t = intred, i=0; t; t = NEXT(t), i++ ) { |
for ( t = intred, i=0; t; t = NEXT(t), i++ ) { |
printf("%d ",i); fflush(stdout); |
printf("%d ",i); fflush(stdout); |
ti = BDY((LIST)BDY(t)); |
ti = BDY((LIST)BDY(t)); |
p[j=QTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod); |
p[j=QTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod); |
} |
} |
Line 9012 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
Line 9094 MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o |
|
MKMAT(mat,nb,m); |
MKMAT(mat,nb,m); |
for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) |
for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) |
for ( i = 0, c = p[QTOS((Q)BDY(t))]; i < nb; i++ ) |
for ( i = 0, c = p[QTOS((Q)BDY(t))]; i < nb; i++ ) |
BDY(mat)[i][j] = ndtodp(mod,c[i]); |
BDY(mat)[i][j] = ndtodp(mod,c[i]); |
return mat; |
return mat; |
} |
} |
|
|
|
MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp) |
|
{ |
|
int i,j,n,m,nb,pi0,pi1,nvar; |
|
VL fv,tv,vv; |
|
NODE permtrace,perm,trace,intred,ind,t,pi,ti; |
|
ND **p; |
|
ND *c; |
|
ND u; |
|
MAT mat; |
|
LM lm; |
|
GZ lf,inv; |
|
|
|
parse_nd_option(current_option); |
|
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
|
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
|
switch ( ord->id ) { |
|
case 1: |
|
if ( ord->nv != nvar ) |
|
error("nd_check : invalid order specification"); |
|
break; |
|
default: |
|
break; |
|
} |
|
nd_init_ord(ord); |
|
#if 0 |
|
nd_bpe = QTOS((Q)ARG7(BDY(tlist))); |
|
#else |
|
nd_bpe = 32; |
|
#endif |
|
nd_setup_parameters(nvar,0); |
|
permtrace = BDY((LIST)ARG2(BDY(tlist))); |
|
intred = BDY((LIST)ARG3(BDY(tlist))); |
|
ind = BDY((LIST)ARG4(BDY(tlist))); |
|
perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace); |
|
for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) { |
|
j = QTOS((Q)BDY(BDY((LIST)BDY(t)))); |
|
if ( j > i ) i = j; |
|
} |
|
n = i+1; |
|
nb = length(BDY(f)); |
|
p = (ND **)MALLOC(n*sizeof(ND *)); |
|
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
|
pi = BDY((LIST)BDY(t)); |
|
pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); |
|
p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND)); |
|
simp_ff((Obj)ARG2(pi),&lm); lmtolf(lm,&lf); invgz(lf,&inv); |
|
u = ptond(CO,vv,(P)ONE); |
|
HCZ(u) = inv; |
|
c[pi1] = u; |
|
} |
|
for ( t = trace,i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb); |
|
} |
|
for ( t = intred, i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb); |
|
} |
|
m = length(ind); |
|
MKMAT(mat,nb,m); |
|
for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) |
|
for ( i = 0, c = p[QTOS((Q)BDY(t))]; i < nb; i++ ) |
|
BDY(mat)[i][j] = ndtodp(-2,c[i]); |
|
return mat; |
|
} |
|
|
VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord, |
VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord, |
LIST tlist,int pos,MAT *rp) |
LIST tlist,int pos,MAT *rp) |
{ |
{ |
Line 9028 VECT nd_btog_one(LIST f,LIST v,int mod,struct order_sp |
|
Line 9178 VECT nd_btog_one(LIST f,LIST v,int mod,struct order_sp |
|
P inv; |
P inv; |
VECT vect; |
VECT vect; |
|
|
|
if ( mod == -2 ) |
|
error("nd_btog_one : not implemented yet for a large finite field"); |
|
|
parse_nd_option(current_option); |
parse_nd_option(current_option); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
Line 9194 void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,s |
|
Line 9347 void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,s |
|
if ( ishomo ) |
if ( ishomo ) |
ishomo = ishomo && ndv_ishomo(c); |
ishomo = ishomo && ndv_ishomo(c); |
if ( c ) { |
if ( c ) { |
NEXTNODE(in0,in); BDY(in) = (pointer)c; |
|
NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c); |
NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c); |
|
ndv_mod(-2,c); |
|
NEXTNODE(in0,in); BDY(in) = (pointer)c; |
} |
} |
} |
} |
if ( in0 ) NEXT(in) = 0; |
if ( in0 ) NEXT(in) = 0; |