Return to dist.c CVS log | Up to [local] / OpenXM_contrib2 / asir2018 / engine |
version 1.2, 2018/09/28 08:20:28 | version 1.7, 2019/09/06 00:11:59 | ||
---|---|---|---|
|
|
||
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | ||
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. | * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. | ||
* | * | ||
* $OpenXM: OpenXM_contrib2/asir2018/engine/dist.c,v 1.1 2018/09/19 05:45:07 noro Exp $ | * $OpenXM: OpenXM_contrib2/asir2018/engine/dist.c,v 1.6 2019/09/05 08:49:43 noro Exp $ | ||
*/ | */ | ||
#include "ca.h" | #include "ca.h" | ||
|
|
||
dp_current_spec = spec; | dp_current_spec = spec; | ||
} | } | ||
int dpm_ispot; | int dpm_ordtype; | ||
/* type=0 => TOP, type=1 => POT */ | |||
void initdpm(struct order_spec *spec,int type) | |||
{ | |||
int len,i,k,row; | |||
Q **mat; | |||
initd(spec); | |||
dpm_ispot = type; | |||
} | |||
void ptod(VL vl,VL dvl,P p,DP *pr) | void ptod(VL vl,VL dvl,P p,DP *pr) | ||
{ | { | ||
int n,i,j,k; | int n,i,j,k; | ||
|
|
||
d3->d[i] = d1->d[i]+d2->d[i]; | d3->d[i] = d1->d[i]+d2->d[i]; | ||
} | } | ||
void _addtodl(int n,DL d1,DL d2) | |||
{ | |||
int i; | |||
d2->td += d1->td; | |||
for ( i = 0; i < n; i++ ) | |||
d2->d[i] += d1->d[i]; | |||
} | |||
void _copydl(int n,DL d1,DL d2) | |||
{ | |||
int i; | |||
d2->td = d1->td; | |||
for ( i = 0; i < n; i++ ) | |||
d2->d[i] = d1->d[i]; | |||
} | |||
int _eqdl(int n,DL d1,DL d2) | |||
{ | |||
int i; | |||
if ( d2->td != d1->td ) return 0; | |||
for ( i = 0; i < n; i++ ) | |||
if ( d2->d[i] != d1->d[i] ) return 0; | |||
return 1; | |||
} | |||
/* m1 <- m1 U dl*f, destructive */ | /* m1 <- m1 U dl*f, destructive */ | ||
NODE mul_dllist(DL dl,DP f); | NODE mul_dllist(DL dl,DP f); | ||
|
|
||
/* DPM functions */ | /* DPM functions */ | ||
DMMstack dmm_stack; | |||
extern LIST schreyer_obj; | |||
void push_schreyer_order(LIST data) | |||
{ | |||
DMMstack t; | |||
int len,i; | |||
NODE in,t1; | |||
/* data = [DPM,...,DPM] */ | |||
in = BDY(data); | |||
len = length(in); | |||
NEWDMMstack(t); | |||
t->rank = len; | |||
t->in = (DMM *)MALLOC((len+1)*sizeof(DMM)); | |||
t->ordtype = 0; | |||
for ( i = 1; i <= len; i++, in = NEXT(in) ) { | |||
t->in[i] = BDY((DPM)BDY(in)); | |||
} | |||
t->next = dmm_stack; | |||
dmm_stack = t; | |||
dpm_ordtype = 2; | |||
MKNODE(t1,data,schreyer_obj?BDY(schreyer_obj):0); | |||
MKLIST(schreyer_obj,t1); | |||
} | |||
// data=[Ink,...,In0] | |||
// Ini = a list of module monomials | |||
void set_schreyer_order(LIST data) | |||
{ | |||
NODE in; | |||
LIST *w; | |||
int i,len; | |||
if ( !data ) { | |||
dmm_stack = 0; | |||
if ( dp_current_spec && dp_current_spec->id >= 256 ) | |||
dpm_ordtype = dp_current_spec->ispot; | |||
else | |||
dpm_ordtype = 0; | |||
return; | |||
} else { | |||
dmm_stack = 0; | |||
in = BDY(data); | |||
len = length(in); | |||
w = (LIST *)MALLOC(len*sizeof(LIST)); | |||
for ( i = 0; i < len; i++, in = NEXT(in) ) w[i] = (LIST)BDY(in); | |||
for ( i = len-1; i >= 0; i-- ) push_schreyer_order(w[i]); | |||
dpm_ordtype = 2; | |||
} | |||
} | |||
// construct a base of syz(g) | |||
// assuming the schrerer order is properly set | |||
DP dpm_sp_hm(DPM p1,DPM p2); | |||
void dpm_sp(DPM p1,DPM p2,DPM *sp,DP *t1,DP *t2); | |||
DP *dpm_nf_and_quotient(NODE b,DPM sp,VECT psv,DPM *nf,P *dn); | |||
void dpm_sort(DPM p,DPM *r); | |||
extern int DP_Multiple; | |||
void dpm_nf_z(NODE b,DPM g,VECT psv,int full,int multiple,DPM *rp); | |||
NODE dpm_sort_list(NODE l); | |||
void dpm_ptozp(DPM p,Z *cont,DPM *r); | |||
NODE dpm_reduceall(NODE in) | |||
{ | |||
int n,i; | |||
VECT psv; | |||
DPM *ps; | |||
NODE t,t1; | |||
DPM g,r; | |||
Z cont; | |||
n = length(in); | |||
MKVECT(psv,n); | |||
ps = (DPM *)BDY(psv); | |||
for ( i = 0, t = in; i < n; i++, t = NEXT(t) ) ps[i] = BDY(t); | |||
for ( i = 0; i < n; i++ ) { | |||
g = ps[i]; ps[i] = 0; | |||
dpm_nf_z(0,g,psv,1,DP_Multiple,&r); | |||
ps[i] = r; | |||
} | |||
t = 0; | |||
for ( i = n-1; i >= 0; i-- ) { | |||
dpm_ptozp(ps[i],&cont,&r); | |||
MKNODE(t1,r,t); t = t1; | |||
} | |||
return t; | |||
} | |||
void dpm_schreyer_base(LIST g,LIST *s) | |||
{ | |||
NODE nd,t,b0,b; | |||
int n,i,j,k,nv; | |||
Z cont; | |||
P dn,c; | |||
DP h,t1,t2; | |||
MP d; | |||
DMM r0,r; | |||
DPM sp,nf,dpm; | |||
DPM *ps; | |||
VECT psv; | |||
DP **m,*quo; | |||
struct oEGT eg_nf,eg0,eg1; | |||
extern struct oEGT egc,egcomp; | |||
// init_eg(&eg_nf); | |||
// init_eg(&egcomp); | |||
nd = BDY(g); | |||
n = length(nd); | |||
MKVECT(psv,n); | |||
ps = (DPM *)BDY(psv); | |||
for ( i = 0, t = nd; i < n; i++, t = NEXT(t) ) ps[i] = (DPM)BDY(t); | |||
nv = ps[0]->nv; | |||
m = (DP **)almat_pointer(n,n); | |||
b0 = 0; | |||
// init_eg(&egc); | |||
for ( i = 0; i < n; i++ ) { | |||
// sp(ps[i],ps[j]) = ti*ps[i]-tj*ps[j] => m[i][j] = ti | |||
for ( j = i+1; j < n; j++ ) m[i][j] = dpm_sp_hm(ps[i],ps[j]); | |||
for ( j = i+1; j < n; j++ ) { | |||
// for ( j = n-1; j > i; j-- ) { | |||
if ( !m[i][j] ) continue; | |||
for ( h = m[i][j], k = i+1; k < n; k++ ) | |||
if ( k != j && m[i][k] && dp_redble(m[i][k],h) ) m[i][k] = 0; | |||
} | |||
for ( j = i+1; j < n; j++ ) { | |||
if ( m[i][j] ) { | |||
dpm_sp(ps[i],ps[j],&sp,&t1,&t2); | |||
// get_eg(&eg0); | |||
quo = dpm_nf_and_quotient(0,sp,psv,&nf,&dn); | |||
// get_eg(&eg1); add_eg(&eg_nf,&eg0,&eg1); | |||
if ( nf ) | |||
error("dpm_schreyer_base : cannot happen"); | |||
NEWDMM(r0); r = r0; | |||
mulp(CO,(P)BDY(t1)->c,dn,(P *)&r->c); r->pos = i+1; r->dl = BDY(t1)->dl; | |||
NEWDMM(NEXT(r)); r=NEXT(r); | |||
mulp(CO,(P)BDY(t2)->c,dn,&c); chsgnp(c,(P *)&r->c); r->pos = j+1; r->dl = BDY(t2)->dl; | |||
if ( quo ) { | |||
for ( k = 0; k < n; k++ ) { | |||
if ( !quo[k] ) continue; | |||
for ( d = BDY(quo[k]); d; d = NEXT(d) ) { | |||
NEXTDMM(r0,r); chsgnp((P)d->c,(P *)&r->c); r->pos = k+1; r->dl = d->dl; | |||
} | |||
} | |||
} | |||
NEXT(r) = 0; | |||
MKDPM(nv,r0,dpm); // XXX : sugar is not set | |||
NEXTNODE(b0,b); | |||
BDY(b) = (pointer)dpm; | |||
} | |||
} | |||
if ( b0 ) NEXT(b) = 0; | |||
} | |||
push_schreyer_order(g); | |||
for ( t = b0; t; t = NEXT(t) ) { | |||
dpm_sort((DPM)BDY(t),&dpm); | |||
BDY(t) = (pointer)dpm; | |||
} | |||
b0 = dpm_sort_list(b0); | |||
// b0 = dpm_reduceall(b0); | |||
MKLIST(*s,b0); | |||
// print_eg("nf",&eg_nf); printf("\n"); | |||
// print_eg("coef",&egc); printf("\n"); | |||
} | |||
int compdmm_schreyer(int n,DMM m1,DMM m2) | |||
{ | |||
int pos1,pos2,t; | |||
DMM *in; | |||
DMMstack s; | |||
static DL d1=0,d2=0; | |||
static int dlen=0; | |||
pos1 = m1->pos; pos2 = m2->pos; | |||
if ( pos1 == pos2 ) return (*cmpdl)(n,m1->dl,m2->dl); | |||
if ( n > dlen ) { | |||
NEWDL(d1,n); NEWDL(d2,n); dlen = n; | |||
} | |||
_copydl(n,m1->dl,d1); | |||
_copydl(n,m2->dl,d2); | |||
for ( s = dmm_stack; s; s = NEXT(s) ) { | |||
in = s->in; | |||
_addtodl(n,in[pos1]->dl,d1); | |||
_addtodl(n,in[pos2]->dl,d2); | |||
if ( in[pos1]->pos == in[pos2]->pos && _eqdl(n,d1,d2)) { | |||
if ( pos1 < pos2 ) return 1; | |||
else if ( pos1 > pos2 ) return -1; | |||
else return 0; | |||
} | |||
pos1 = in[pos1]->pos; | |||
pos2 = in[pos2]->pos; | |||
if ( pos1 == pos2 ) return (*cmpdl)(n,d1,d2); | |||
} | |||
// comparison by the bottom order | |||
LAST: | |||
if ( dpm_ordtype == 1 ) { | |||
if ( pos1 < pos2 ) return 1; | |||
else if ( pos1 > pos2 ) return -1; | |||
else return (*cmpdl)(n,d1,d2); | |||
} else { | |||
t = (*cmpdl)(n,d1,d2); | |||
if ( t ) return t; | |||
else if ( pos1 < pos2 ) return 1; | |||
else if ( pos1 > pos2 ) return -1; | |||
else return 0; | |||
} | |||
} | |||
#if 1 | |||
int compdmm(int n,DMM m1,DMM m2) | int compdmm(int n,DMM m1,DMM m2) | ||
{ | { | ||
int t; | int t; | ||
if ( dpm_ispot ) { | switch ( dpm_ordtype ) { | ||
case 0: | |||
t = (*cmpdl)(n,m1->dl,m2->dl); | |||
if ( t ) return t; | |||
else if ( m1->pos < m2->pos ) return 1; | |||
else if ( m1->pos > m2->pos ) return -1; | |||
else return 0; | |||
case 1: | |||
if ( m1->pos < m2->pos ) return 1; | if ( m1->pos < m2->pos ) return 1; | ||
else if ( m1->pos > m2->pos ) return -1; | else if ( m1->pos > m2->pos ) return -1; | ||
else return (*cmpdl)(n,m1->dl,m2->dl); | else return (*cmpdl)(n,m1->dl,m2->dl); | ||
} else { | case 2: | ||
return compdmm_schreyer(n,m1,m2); | |||
default: | |||
error("compdmm : invalid dpm_ordtype"); | |||
} | |||
} | |||
#else | |||
int compdmm(int n,DMM m1,DMM m2) | |||
{ | |||
int t; | |||
if ( dpm_ordtype == 1 ) { | |||
if ( m1->pos < m2->pos ) return 1; | |||
else if ( m1->pos > m2->pos ) return -1; | |||
else return (*cmpdl)(n,m1->dl,m2->dl); | |||
} else if ( dpm_ordtype == 0 ) { | |||
t = (*cmpdl)(n,m1->dl,m2->dl); | t = (*cmpdl)(n,m1->dl,m2->dl); | ||
if ( t ) return t; | if ( t ) return t; | ||
else if ( m1->pos < m2->pos ) return 1; | else if ( m1->pos < m2->pos ) return 1; | ||
else if ( m1->pos > m2->pos ) return -1; | else if ( m1->pos > m2->pos ) return -1; | ||
else return 0; | else return 0; | ||
} else if ( dpm_ordtype == 2 ) { | |||
return compdmm_schreyer(n,m1,m2); | |||
} | } | ||
} | } | ||
#endif | |||
void adddpm(VL vl,DPM p1,DPM p2,DPM *pr) | void adddpm(VL vl,DPM p1,DPM p2,DPM *pr) | ||
{ | { | ||
int n; | int n,s; | ||
DMM m1,m2,mr=0,mr0; | DMM m1,m2,mr=0,mr0; | ||
Obj t; | Obj t; | ||
DL d; | DL d; | ||
|
|
||
else if ( !p2 ) | else if ( !p2 ) | ||
*pr = p1; | *pr = p1; | ||
else { | else { | ||
for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) | for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) { | ||
switch ( compdmm(n,m1,m2) ) { | s = compdmm(n,m1,m2); | ||
switch ( s ) { | |||
case 0: | case 0: | ||
arf_add(vl,C(m1),C(m2),&t); | arf_add(vl,C(m1),C(m2),&t); | ||
if ( t ) { | if ( t ) { | ||
|
|
||
NEXTDMM(mr0,mr); mr->pos = m2->pos; mr->dl = m2->dl; C(mr) = C(m2); | NEXTDMM(mr0,mr); mr->pos = m2->pos; mr->dl = m2->dl; C(mr) = C(m2); | ||
m2 = NEXT(m2); break; | m2 = NEXT(m2); break; | ||
} | } | ||
} | |||
if ( !mr0 ) | if ( !mr0 ) | ||
if ( m1 ) | if ( m1 ) | ||
mr0 = m1; | mr0 = m1; | ||
|
|
||
} | } | ||
} | } | ||
// p = ...+c*<<0,...0:pos>>+... | |||
DPM dpm_eliminate_term(DPM a,DPM p,Obj c,int pos) | |||
{ | |||
MP d0,d; | |||
DMM m; | |||
DP f; | |||
DPM a1,p1,r; | |||
if ( !a ) return 0; | |||
d0 = 0; | |||
for ( m = BDY(a); m; m = NEXT(m) ) | |||
if ( m->pos == pos ) { | |||
NEXTMP(d0,d); d->dl = m->dl; arf_chsgn(m->c,&d->c); | |||
} | |||
if ( d0 ) { | |||
NEXT(d) = 0; MKDP(NV(a),d0,f); | |||
mulcdpm(CO,c,a,&a1); | |||
mulobjdpm(CO,(Obj)f,p,&p1); | |||
adddpm(CO,a1,p1,&r); | |||
return r; | |||
} else | |||
return a; | |||
} | |||
// <<...:i>> -> <<...:tab[i]>> | |||
DPM dpm_compress(DPM p,int *tab) | |||
{ | |||
DMM m,mr0,mr; | |||
DPM t; | |||
if ( !p ) return 0; | |||
else { | |||
for ( m = BDY(p), mr0 = 0; m; m = NEXT(m) ) { | |||
NEXTDMM(mr0,mr); | |||
mr->dl = m->dl; mr->c = m->c; mr->pos = tab[m->pos]; | |||
if ( mr->pos <= 0 ) | |||
error("dpm_compress : invalid position"); | |||
} | |||
NEXT(mr) = 0; | |||
MKDPM(p->nv,mr0,t); t->sugar = p->sugar; | |||
return t; | |||
} | |||
} | |||
// input : s, s = syz(m) output simplified s, m | |||
void dpm_simplify_syz(LIST s,LIST m,LIST *s1,LIST *m1) | |||
{ | |||
int lm,ls,i,j,pos; | |||
DPM *am,*as; | |||
DPM p; | |||
DMM d; | |||
Obj c; | |||
int *tab; | |||
NODE t,t1; | |||
lm = length(BDY(m)); | |||
am = (DPM *)MALLOC((lm+1)*sizeof(DPM)); | |||
ls = length(BDY(s)); | |||
as = (DPM *)MALLOC(ls*sizeof(DPM)); | |||
for ( i = 1, t = BDY(m); i <= lm; i++, t = NEXT(t) ) am[i] = (DPM)BDY(t); | |||
for ( i = 0, t = BDY(s); i < ls; i++, t = NEXT(t) ) as[i] = (DPM)BDY(t); | |||
for ( i = 0; i < ls; i++ ) { | |||
p = as[i]; | |||
if ( p == 0 ) continue; | |||
for ( d = BDY(p); d; d = NEXT(d) ) if ( d->dl->td == 0 ) break; | |||
if ( d ) { | |||
c = d->c; pos = d->pos; | |||
for ( j = 0; j < ls; j++ ) | |||
if ( j != i ) { | |||
as[j] = dpm_eliminate_term(as[j],p,c,pos); | |||
} | |||
// remove m[i] | |||
am[pos] = 0; | |||
as[i] = 0; | |||
} | |||
} | |||
// compress s | |||
// create index table from am[] | |||
// (0 0 * 0 * ...) -> (0 0 1 0 2 ... ) which means 2->1, 4->2, ... | |||
tab = (int *)MALLOC((lm+1)*sizeof(int)); | |||
for ( j = 0, i = 1; i <= lm; i++ ) { | |||
if ( am[i] ) { j++; tab[i] = j; } | |||
else tab[i] = 0; | |||
} | |||
t = 0; | |||
for ( i = ls-1; i >= 0; i-- ) | |||
if ( as[i] ) { | |||
p = dpm_compress(as[i],tab); | |||
MKNODE(t1,(pointer)p,t); t = t1; | |||
} | |||
MKLIST(*s1,t); | |||
t = 0; | |||
for ( i = lm; i >= 1; i-- ) | |||
if ( am[i] ) { | |||
MKNODE(t1,(pointer)am[i],t); t = t1; | |||
} | |||
MKLIST(*m1,t); | |||
} |