version 1.27, 2021/01/25 00:39:51 |
version 1.29, 2021/02/28 02:33:15 |
|
|
* 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/builtin/dp.c,v 1.26 2020/10/26 02:41:05 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.28 2021/02/18 05:35:01 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 61 extern int nd_rref2; |
|
Line 61 extern int nd_rref2; |
|
|
|
extern int do_weyl; |
extern int do_weyl; |
|
|
void Pdp_monomial_hilbert_poincare(); |
void Pdp_monomial_hilbert_poincare(),Pdp_monomial_hilbert_poincare_incremental(); |
void Pdp_sort(); |
void Pdp_sort(); |
void Pdp_mul_trunc(),Pdp_quo(); |
void Pdp_mul_trunc(),Pdp_quo(); |
void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize(); |
void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize(); |
Line 249 struct ftab dp_tab[] = { |
|
Line 249 struct ftab dp_tab[] = { |
|
|
|
/* Hilbert function */ |
/* Hilbert function */ |
{"dp_monomial_hilbert_poincare",Pdp_monomial_hilbert_poincare,2}, |
{"dp_monomial_hilbert_poincare",Pdp_monomial_hilbert_poincare,2}, |
|
{"dp_monomial_hilbert_poincare_incremental",Pdp_monomial_hilbert_poincare_incremental,3}, |
|
|
/* misc */ |
/* misc */ |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
Line 466 void mhp_rec(VECT b,VECT x,P t,P *r) |
|
Line 467 void mhp_rec(VECT b,VECT x,P t,P *r) |
|
DL *p,*q; |
DL *p,*q; |
DL pi,xj,d1; |
DL pi,xj,d1; |
VECT c; |
VECT c; |
struct oEGT eg0,eg1; |
struct oEGT eg0,eg1; |
|
|
i_all++; |
i_all++; |
n = b->len; nv = x->len; p = (DL *)BDY(b); |
n = b->len; nv = x->len; p = (DL *)BDY(b); |
Line 613 P *mhp_prep(int n,P *tv) { |
|
Line 614 P *mhp_prep(int n,P *tv) { |
|
P *plist; |
P *plist; |
P mt,t1; |
P mt,t1; |
int i; |
int i; |
|
VECT list; |
|
|
plist = (P *)MALLOC((n+1)*sizeof(P)); |
plist = (P *)MALLOC((n+1)*sizeof(P)); |
/* t1 = 1-t */ |
/* t1 = 1-t */ |
Line 633 P mhp_ctop(P *r,P *plist,int n) |
|
Line 635 P mhp_ctop(P *r,P *plist,int n) |
|
return hp; |
return hp; |
} |
} |
|
|
|
LIST dp_monomial_hilbert_poincare(VECT b,VECT x,P *plist) |
|
{ |
|
int n; |
|
P *r; |
|
P tv; |
|
P hp,hpoly; |
|
VECT hfhead; |
|
Z z; |
|
NODE nd; |
|
VECT vect; |
|
LIST list; |
|
|
|
n = x->len; |
|
r = (P *)CALLOC(n+1,sizeof(P)); |
|
make_reduced(b,n); |
|
makevar("t",&tv); |
|
mhp_rec(b,x,tv,r); |
|
hp = mhp_ctop(r,plist,n); |
|
mhp_to_hf(CO,hp,n,plist,&hfhead,&hpoly); |
|
UTOZ(n,z); |
|
NEWVECT(vect); vect->len = n+1; BDY(vect) = (pointer)plist; |
|
nd = mknode(5,hp,z,hfhead,hpoly,vect); |
|
MKLIST(list,nd); |
|
return list; |
|
} |
|
|
void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
{ |
{ |
LIST g,v; |
LIST g,v; |
VL vl; |
VL vl; |
int m,n,i; |
int m,n,i; |
VECT b,x,hfhead; |
VECT b,x,hfhead,prep; |
NODE t,nd; |
NODE t,nd; |
Z z,den; |
Z z,den; |
P hp,tv,mt,t1,u,w,hpoly; |
P hp,tv,mt,t1,u,w,hpoly; |
DP a; |
DP a; |
DL *p; |
DL *p; |
P *plist,*r; |
P *plist; |
Obj val; |
Obj val; |
|
|
i_simple = i_all = 0; |
i_simple = i_all = 0; |
Line 662 void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
|
Line 690 void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
|
for ( t = BDY(v), i = 0; t; t = NEXT(t), i++ ) { |
for ( t = BDY(v), i = 0; t; t = NEXT(t), i++ ) { |
ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl; |
ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl; |
} |
} |
|
|
r = (P *)CALLOC(n+1,sizeof(P)); |
|
plist = mhp_prep(n,&tv); |
plist = mhp_prep(n,&tv); |
make_reduced(b,n); |
*rp = dp_monomial_hilbert_poincare(b,x,plist); |
mhp_rec(b,x,tv,r); |
|
hp = mhp_ctop(r,plist,n); |
|
mhp_to_hf(CO,hp,n,plist,&hfhead,&hpoly); |
|
UTOZ(n,z); |
|
nd = mknode(4,hp,z,hfhead,hpoly); |
|
MKLIST(*rp,nd); |
|
} |
} |
|
|
|
DL monomial_colon(DL a,DL b,int n) |
|
{ |
|
int i,d,td; |
|
DL r; |
|
|
|
NEWDL(r,n); |
|
td = 0; |
|
for ( i = 0; i < n; i++ ) { |
|
d = a->d[i]-b->d[i]; |
|
r->d[i] = MAX(d,0); |
|
td += r->d[i]; |
|
} |
|
r->td = td; |
|
return r; |
|
} |
|
|
|
// arguments : DPlist, Xlist, Mono, [HN(t),NV,Head,HP(n),Plist] |
|
void Pdp_monomial_hilbert_poincare_incremental(NODE arg,LIST *rp) |
|
{ |
|
NODE g,data,data1,nd,t; |
|
LIST list,list1; |
|
DL new,dl; |
|
int len,i,n; |
|
Z dz; |
|
DL *p; |
|
P hn,hn1,newhn,tv,newhpoly,td,s; |
|
VECT b,x,newhfhead; |
|
P *plist; |
|
|
|
g = BDY((LIST)ARG0(arg)); new = BDY((DP)ARG1(arg))->dl; |
|
data = BDY((LIST)ARG2(arg)); |
|
hn = (P)ARG0(data); n = ZTOS((Z)ARG1(data)); |
|
plist = (P *)BDY((VECT)ARG4(data)); |
|
len = length(g); MKVECT(b,len); p = (DL *)BDY(b); |
|
for ( t = g, i = 0; t; t = NEXT(t), i++ ) |
|
p[i] = monomial_colon(BDY((DP)BDY(t))->dl,new,n); |
|
MKVECT(x,n); |
|
for ( i = 0; i < n; i++ ) { |
|
NEWDL(dl,n); dl->d[i] = 1; dl->td = 1; BDY(x)[i] = dl; |
|
} |
|
// compute HP(I:new) |
|
list1 = dp_monomial_hilbert_poincare(b,x,plist); |
|
data1 = BDY((LIST)list1); |
|
hn1 = (P)ARG0(data1); |
|
// HP(I+<new>) = H(I)-t^d*H(I:new), d=tdeg(new) |
|
makevar("t",&tv); UTOZ(new->td,dz); |
|
pwrp(CO,tv,dz,&td); |
|
mulp(CO,hn1,td,&s); |
|
subp(CO,hn,s,&newhn); |
|
mhp_to_hf(CO,newhn,n,plist,&newhfhead,&newhpoly); |
|
nd = mknode(5,newhn,ARG1(data),newhfhead,newhpoly,(VECT)ARG4(data)); |
|
MKLIST(list,nd); |
|
*rp = list; |
|
} |
|
|
void Pdp_compute_last_t(NODE arg,LIST *rp) |
void Pdp_compute_last_t(NODE arg,LIST *rp) |
{ |
{ |
NODE g,gh,homo,n; |
NODE g,gh,homo,n; |
Line 3039 void Pnd_sba(NODE arg,LIST *rp) |
|
Line 3114 void Pnd_sba(NODE arg,LIST *rp) |
|
Z mq,z; |
Z mq,z; |
Num nhomo; |
Num nhomo; |
NODE node; |
NODE node; |
struct order_spec *ord; |
struct order_spec *ord,*current_spec; |
|
|
|
current_spec = dp_current_spec; |
do_weyl = 0; |
do_weyl = 0; |
retdp = 0; |
retdp = 0; |
if ( (ac=argc(arg)) == 4 ) { |
if ( (ac=argc(arg)) == 4 ) { |
Line 3072 void Pnd_sba(NODE arg,LIST *rp) |
|
Line 3148 void Pnd_sba(NODE arg,LIST *rp) |
|
} else |
} else |
error("nd_gr : invalid argument"); |
error("nd_gr : invalid argument"); |
nd_sba(f,v,m,homo,retdp,0,ord,rp); |
nd_sba(f,v,m,homo,retdp,0,ord,rp); |
|
initd(current_spec); |
} |
} |
|
|
void Pnd_weyl_sba(NODE arg,LIST *rp) |
void Pnd_weyl_sba(NODE arg,LIST *rp) |