version 1.23, 2020/02/11 01:43:57 |
version 1.32, 2022/09/10 04:04:50 |
|
|
* 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.22 2020/01/09 01:47:40 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.31 2021/12/05 22:41:03 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 79 void Pdp_nf_mod(),Pdp_true_nf_mod(); |
|
Line 79 void Pdp_nf_mod(),Pdp_true_nf_mod(); |
|
void Pdp_criB(),Pdp_nelim(); |
void Pdp_criB(),Pdp_nelim(); |
void Pdp_minp(),Pdp_sp_mod(); |
void Pdp_minp(),Pdp_sp_mod(); |
void Pdp_homo(),Pdp_dehomo(); |
void Pdp_homo(),Pdp_dehomo(); |
void Pdpm_homo(),Pdpm_dehomo(); |
void Pdpm_homo(),Pdpm_dehomo(),Pdpm_mod(); |
void Pdp_gr_mod_main(),Pdp_gr_f_main(); |
void Pdp_gr_mod_main(),Pdp_gr_f_main(); |
void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags(); |
void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags(); |
void Pdp_interreduce(); |
void Pdp_interreduce(); |
Line 113 void Pdp_nf_f(),Pdp_weyl_nf_f(); |
|
Line 113 void Pdp_nf_f(),Pdp_weyl_nf_f(); |
|
void Pdpm_nf_f(),Pdpm_weyl_nf_f(); |
void Pdpm_nf_f(),Pdpm_weyl_nf_f(); |
void Pdp_lnf_f(); |
void Pdp_lnf_f(); |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); |
|
void Pnd_sba(),Pnd_sba_f4(); |
|
void Pnd_weyl_sba(); |
void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); |
void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); |
void Pnd_gr_recompute_trace(), Pnd_btog(); |
void Pnd_gr_recompute_trace(), Pnd_btog(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
Line 131 void Pdp_rref2(),Psumi_updatepairs(),Psumi_symbolic(); |
|
Line 133 void Pdp_rref2(),Psumi_updatepairs(),Psumi_symbolic(); |
|
|
|
LIST dp_initial_term(); |
LIST dp_initial_term(); |
LIST dp_order(); |
LIST dp_order(); |
|
int peek_option(NODE opt,char *find,Obj *ret); |
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
int *modular,struct order_spec **ord); |
int *modular,struct order_spec **ord); |
NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *spec, DP *inv); |
NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *spec, DP *inv); |
Line 194 struct ftab dp_tab[] = { |
|
Line 197 struct ftab dp_tab[] = { |
|
{"dp_gr_checklist",Pdp_gr_checklist,2}, |
{"dp_gr_checklist",Pdp_gr_checklist,2}, |
{"nd_f4",Pnd_f4,-4}, |
{"nd_f4",Pnd_f4,-4}, |
{"nd_gr",Pnd_gr,-4}, |
{"nd_gr",Pnd_gr,-4}, |
|
{"nd_sba",Pnd_sba,-4}, |
|
{"nd_weyl_sba",Pnd_weyl_sba,-4}, |
|
{"nd_sba_f4",Pnd_sba_f4,-4}, |
{"nd_gr_trace",Pnd_gr_trace,-5}, |
{"nd_gr_trace",Pnd_gr_trace,-5}, |
{"nd_f4_trace",Pnd_f4_trace,-5}, |
{"nd_f4_trace",Pnd_f4_trace,-5}, |
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
Line 244 struct ftab dp_tab[] = { |
|
Line 250 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 288 struct ftab dp_supp_tab[] = { |
|
Line 295 struct ftab dp_supp_tab[] = { |
|
{"dpm_dtol",Pdpm_dtol,2}, |
{"dpm_dtol",Pdpm_dtol,2}, |
{"dpm_homo",Pdpm_homo,1}, |
{"dpm_homo",Pdpm_homo,1}, |
{"dpm_dehomo",Pdpm_dehomo,1}, |
{"dpm_dehomo",Pdpm_dehomo,1}, |
|
{"dpm_mod",Pdpm_mod,2}, |
|
|
/* criteria */ |
/* criteria */ |
{"dp_cri1",Pdp_cri1,2}, |
{"dp_cri1",Pdp_cri1,2}, |
Line 460 void mhp_rec(VECT b,VECT x,P t,P *r) |
|
Line 468 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 513 struct oEGT eg0,eg1; |
|
Line 521 struct oEGT eg0,eg1; |
|
// get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1); |
// get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1); |
} |
} |
|
|
|
P mhp_rec_weight(VECT b,VECT x,P t,int *w) |
|
{ |
|
int n,i,j,k,l,i2,nv,len,td; |
|
int *d; |
|
Z wj; |
|
P twj,tmp,tmp2,ret,qadd,qcolon; |
|
DL *p,*q; |
|
DL pi,xj,d1; |
|
VECT c; |
|
|
|
i_all++; |
|
n = b->len; nv = x->len; p = (DL *)BDY(b); |
|
if ( !n ) { |
|
// I=<0> => HP(t)=1/(1-t^w1)...(1-t^wn) => Q(t)=1 |
|
return (P)ONE; |
|
} |
|
if ( n == 1 && p[0]->td == 0 ) { |
|
// I=<1> => HP(t)=0 => Q(t)=0 |
|
return 0; |
|
} |
|
for ( i = 0; i < n; i++ ) { |
|
d = p[i]->d; |
|
for ( td = 0, j = 0; j < nv; j++ ) td += d[j]; |
|
if (td > 1 ) break; |
|
} |
|
if ( i == n ) { |
|
// I=<xi1,...,xin> => Q(t)=(1-t^wi1)...(1-t^win) |
|
for ( ret = (P)ONE, i = 0; i < n; i++ ) { |
|
d = p[i]->d; |
|
for ( j = 0; j < nv; j++ ) if ( d[j] ) break; |
|
STOZ(w[j],wj); pwrp(CO,t,wj,&tmp); |
|
subp(CO,(P)ONE,tmp,&tmp2); mulp(CO,ret,tmp2,&tmp); ret = tmp; |
|
} |
|
return ret; |
|
} |
|
for ( j = 0, d = p[i]->d; j < nv; j++ ) |
|
if ( d[j] ) break; |
|
xj = BDY(x)[j]; |
|
MKVECT(c,n); q = (DL *)BDY(c); |
|
for ( i = k = l = 0; i < n; i++ ) |
|
if ( p[i]->d[j] ) { |
|
pi = p[i]; |
|
NEWDL(d1,nv); d1->td =pi->td - 1; |
|
memcpy(d1->d,pi->d,nv*sizeof(int)); |
|
d1->d[j]--; |
|
p[k++] = d1; |
|
} else |
|
q[l++] = p[i]; |
|
for ( i = k, i2 = 0; i2 < l; i++, i2++ ) |
|
p[i] = q[i2]; |
|
/* b=(b[0]/xj,...,b[k-1]/xj,b[k],...b[n-1]) where |
|
b[0],...,b[k-1] are divisible by k */ |
|
make_reduced2(b,k,nv); |
|
qcolon = mhp_rec_weight(b,x,t,w); |
|
/* c = (b[0],...,b[l-1],xj) */ |
|
q[l] = xj; c->len = l+1; |
|
qadd = mhp_rec_weight(c,x,t,w); |
|
// Q(t)=Qadd+t^wj*Qcolon |
|
STOZ(w[j],wj); pwrp(CO,t,wj,&twj); |
|
mulp(CO,twj,qcolon,&tmp); addp(CO,qadd,tmp,&ret); |
|
return ret; |
|
} |
|
|
/* (n+a)Cb as a polynomial of n; return (n+a)*...*(n+a-b+1) */ |
/* (n+a)Cb as a polynomial of n; return (n+a)*...*(n+a-b+1) */ |
|
|
P binpoly(P n,int a,int b) |
P binpoly(P n,int a,int b) |
Line 607 P *mhp_prep(int n,P *tv) { |
|
Line 678 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 627 P mhp_ctop(P *r,P *plist,int n) |
|
Line 699 P mhp_ctop(P *r,P *plist,int n) |
|
return hp; |
return hp; |
} |
} |
|
|
|
LIST dp_monomial_hilbert_poincare(VECT b,VECT x) |
|
{ |
|
int n; |
|
P *r,*plist; |
|
P tv; |
|
P hp,hpoly; |
|
VECT hfhead; |
|
Z z; |
|
NODE nd; |
|
VECT vect; |
|
LIST list; |
|
|
|
n = x->len; |
|
plist = mhp_prep(n,&tv); |
|
r = (P *)CALLOC(n+1,sizeof(P)); |
|
make_reduced(b,n); |
|
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; |
|
} |
|
|
|
LIST dp_monomial_hilbert_poincare_weight(VECT b,VECT x,int *w) |
|
{ |
|
int n,i; |
|
NODE nd; |
|
LIST list; |
|
P tv,ret; |
|
|
|
n = x->len; |
|
make_reduced(b,n); |
|
makevar("t",&tv); |
|
ret = mhp_rec_weight(b,x,tv,w); |
|
nd = mknode(1,ret); |
|
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,wlen; |
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,hpoly; |
DP a; |
DP a; |
DL *p; |
DL *p; |
P *plist,*r; |
Obj val,ord,weight; |
Obj val; |
int *w; |
|
struct order_spec *current_spec=0,*spec; |
|
|
|
weight = 0; |
|
if ( current_option ) { |
|
if ( peek_option(current_option,"ord",&ord) ) { |
|
current_spec = dp_current_spec; |
|
create_order_spec(0,ord,&spec); |
|
initd(spec); |
|
} |
|
peek_option(current_option,"weight",&weight); |
|
} |
i_simple = i_all = 0; |
i_simple = i_all = 0; |
g = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
g = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
pltovl(v,&vl); |
pltovl(v,&vl); |
Line 656 void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
|
Line 780 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; |
} |
} |
|
if ( weight ) { |
|
wlen = length(BDY((LIST)weight)); |
|
if ( n != wlen ) |
|
error("dp_monomial_hilbert_poincare: inconsistent weight length"); |
|
w = (int *)MALLOC(n*sizeof(int)); |
|
for ( i = 0, nd = BDY((LIST)weight); i < n; i++, nd = NEXT(nd) ) |
|
w[i] = ZTOS((Z)BDY(nd)); |
|
} else if ( current_dl_weight_vector ) |
|
w = current_dl_weight_vector; |
|
else |
|
w = 0; |
|
if ( w ) { |
|
*rp = dp_monomial_hilbert_poincare_weight(b,x,w); |
|
} else { |
|
*rp = dp_monomial_hilbert_poincare(b,x); |
|
} |
|
if ( current_spec ) |
|
initd(current_spec); |
|
} |
|
|
|
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; |
|
Obj ord; |
|
struct order_spec *current_spec=0,*spec; |
|
|
r = (P *)CALLOC(n+1,sizeof(P)); |
if ( current_option ) { |
|
if ( peek_option(current_option,"ord",&ord) ) { |
|
current_spec = dp_current_spec; |
|
create_order_spec(0,ord,&spec); |
|
initd(spec); |
|
} |
|
} |
|
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)); |
|
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); |
|
data1 = BDY((LIST)list1); |
|
hn1 = (P)ARG0(data1); |
|
// HP(I+<new>) = H(I)-t^d*H(I:new), d=tdeg(new) |
plist = mhp_prep(n,&tv); |
plist = mhp_prep(n,&tv); |
make_reduced(b,n); |
UTOZ(new->td,dz); |
mhp_rec(b,x,tv,r); |
pwrp(CO,tv,dz,&td); |
hp = mhp_ctop(r,plist,n); |
mulp(CO,hn1,td,&s); |
mhp_to_hf(CO,hp,n,plist,&hfhead,&hpoly); |
subp(CO,hn,s,&newhn); |
UTOZ(n,z); |
mhp_to_hf(CO,newhn,n,plist,&newhfhead,&newhpoly); |
nd = mknode(4,hp,z,hfhead,hpoly); |
nd = mknode(5,newhn,ARG1(data),newhfhead,newhpoly,(VECT)ARG4(data)); |
MKLIST(*rp,nd); |
MKLIST(list,nd); |
|
*rp = list; |
|
if ( current_spec ) |
|
initd(current_spec); |
} |
} |
|
|
void Pdp_compute_last_t(NODE arg,LIST *rp) |
void Pdp_compute_last_t(NODE arg,LIST *rp) |
Line 1292 void Pdp_mod(NODE arg,DP *rp) |
|
Line 1490 void Pdp_mod(NODE arg,DP *rp) |
|
dp_mod(p,mod,subst,rp); |
dp_mod(p,mod,subst,rp); |
} |
} |
|
|
|
void dpm_mod(DPM,int,DPM *); |
|
|
|
void Pdpm_mod(NODE arg,DPM *rp) |
|
{ |
|
DPM p; |
|
int mod; |
|
NODE subst; |
|
|
|
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
|
asir_assert(ARG1(arg),O_N,"dp_mod"); |
|
p = (DPM)ARG0(arg); mod = ZTOS((Q)ARG1(arg)); |
|
dpm_mod(p,mod,rp); |
|
} |
|
|
|
|
void Pdp_rat(NODE arg,DP *rp) |
void Pdp_rat(NODE arg,DP *rp) |
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_rat"); |
asir_assert(ARG0(arg),O_DP,"dp_rat"); |
Line 1300 void Pdp_rat(NODE arg,DP *rp) |
|
Line 1513 void Pdp_rat(NODE arg,DP *rp) |
|
|
|
extern int DP_Multiple; |
extern int DP_Multiple; |
|
|
|
int dp_iszp(DP); |
|
int dpm_iszp(DPM); |
|
|
|
DP dptozdp(DP g) |
|
{ |
|
DP gz; |
|
|
|
if ( dp_iszp(g) ) |
|
gz = g; |
|
else |
|
dp_ptozp(g,&gz); |
|
return gz; |
|
} |
|
|
|
VECT dpvtozdpv(VECT v) |
|
{ |
|
DP *ps,*psz; |
|
int len,i; |
|
VECT r; |
|
|
|
ps = (DP *)BDY(v); |
|
len = v->len; |
|
for ( i = 0; i < len; i++ ) |
|
if ( !dp_iszp(ps[i]) ) break; |
|
if ( i == len ) return v; |
|
MKVECT(r,len); |
|
psz = (DP *)BDY(r); |
|
for ( i = 0; i < len; i++ ) |
|
psz[i] = dptozdp(ps[i]); |
|
return r; |
|
} |
|
|
|
DPM dpmtozdpm(DPM g) |
|
{ |
|
DPM gz; |
|
Z cont; |
|
|
|
if ( dpm_iszp(g) ) |
|
gz = g; |
|
else |
|
dpm_ptozp(g,&cont,&gz); |
|
return gz; |
|
} |
|
|
|
VECT dpmvtozdpmv(VECT v) |
|
{ |
|
DPM *ps,*psz; |
|
int len,i; |
|
VECT r; |
|
|
|
ps = (DPM *)BDY(v); |
|
len = v->len; |
|
for ( i = 0; i < len; i++ ) |
|
if ( !dpm_iszp(ps[i]) ) break; |
|
if ( i == len ) return v; |
|
MKVECT(r,len); |
|
psz = (DPM *)BDY(r); |
|
for ( i = 0; i < len; i++ ) |
|
psz[i] = dpmtozdpm(ps[i]); |
|
return r; |
|
} |
|
|
void Pdp_nf(NODE arg,DP *rp) |
void Pdp_nf(NODE arg,DP *rp) |
{ |
{ |
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
|
VECT zv; |
int full; |
int full; |
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
Line 1315 void Pdp_nf(NODE arg,DP *rp) |
|
Line 1591 void Pdp_nf(NODE arg,DP *rp) |
|
if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); |
|
zv = dpvtozdpv((VECT)ARG2(arg)); |
|
g = dptozdp(g); |
|
ps = (DP *)BDY(zv); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
} |
} |
Line 1325 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
Line 1604 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
|
VECT zv; |
int full; |
int full; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
Line 1334 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
Line 1614 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); |
|
zv = dpvtozdpv((VECT)ARG2(arg)); |
|
g = dptozdp(g); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
do_weyl = 1; |
do_weyl = 1; |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
Line 1357 void Pdpm_nf(NODE arg,DPM *rp) |
|
Line 1639 void Pdpm_nf(NODE arg,DPM *rp) |
|
error("dpm_nf: invalid arguments"); |
error("dpm_nf: invalid arguments"); |
else if ( ac == 3 ) { |
else if ( ac == 3 ) { |
asir_assert(ARG1(arg),O_VECT,"dpm_nf"); |
asir_assert(ARG1(arg),O_VECT,"dpm_nf"); |
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
b = 0; |
|
g = dpmtozdpm((DPM)ARG0(arg)); |
|
ps = dpmvtozdpmv((VECT)ARG1(arg)); |
|
full = (Q)ARG2(arg) ? 1 : 0; |
} else if ( ac == 4 ) { |
} else if ( ac == 4 ) { |
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
b = BDY((LIST)ARG0(arg)); |
|
g = dpmtozdpm((DPM)ARG1(arg)); |
|
ps = dpmvtozdpmv((VECT)ARG2(arg)); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
} |
} |
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
Line 1590 void Pdp_true_nf(NODE arg,LIST *rp) |
|
Line 1877 void Pdp_true_nf(NODE arg,LIST *rp) |
|
{ |
{ |
NODE b,n; |
NODE b,n; |
DP *ps; |
DP *ps; |
DP g; |
DP g,gz; |
DP nm; |
DP nm,nm1; |
P dn; |
P dn,dn1; |
|
Z cont,cnm,cdn; |
|
VECT zv; |
int full; |
int full; |
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
Line 1603 void Pdp_true_nf(NODE arg,LIST *rp) |
|
Line 1892 void Pdp_true_nf(NODE arg,LIST *rp) |
|
if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
nm = 0; dn = (P)ONE; |
nm = 0; dn = (P)ONE; |
} else { |
} else { |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); |
|
zv = dpvtozdpv((VECT)ARG2(arg)); |
|
ps = (DP *)BDY(zv); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
dp_true_nf(b,g,ps,full,&nm,&dn); |
if ( dp_iszp(g) ) { |
|
dp_true_nf(b,g,ps,full,&nm,&dn); |
|
} else { |
|
dp_ptozp3(g,&cont,&gz); |
|
dp_true_nf(b,gz,ps,full,&nm1,&dn1); |
|
if ( INT(cont) ) { |
|
muldc(CO,nm1,(Obj)cont,&nm); |
|
dn = dn1; |
|
} else { |
|
nmq((Q)cont,&cnm); |
|
muldc(CO,nm1,(Obj)cnm,&nm); |
|
dnq((Q)cont,&cdn); |
|
mulp(CO,dn1,(P)cdn,&dn); |
|
} |
|
} |
} |
} |
NEWNODE(n); BDY(n) = (pointer)nm; |
NEWNODE(n); BDY(n) = (pointer)nm; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
Line 2732 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
Line 3037 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
if ( !homo_is_set ) *homo = 0; |
if ( !homo_is_set ) *homo = 0; |
} |
} |
|
|
|
int peek_option(NODE opt,char *find,Obj *retp) |
|
{ |
|
NODE t,p; |
|
char *key; |
|
Obj value; |
|
|
|
for ( t = opt; t; t = NEXT(t) ) { |
|
p = BDY((LIST)BDY(t)); |
|
key = BDY((STRING)BDY(p)); |
|
value = (Obj)BDY(NEXT(p)); |
|
if ( !strcmp(key,find) ) { |
|
*retp = value; |
|
return 1; |
|
} |
|
} |
|
return 0; |
|
} |
|
|
void Pdp_gr_main(NODE arg,LIST *rp) |
void Pdp_gr_main(NODE arg,LIST *rp) |
{ |
{ |
LIST f,v; |
LIST f,v; |
Line 3006 void Pnd_gr(NODE arg,LIST *rp) |
|
Line 3329 void Pnd_gr(NODE arg,LIST *rp) |
|
} else |
} else |
error("nd_gr : invalid argument"); |
error("nd_gr : invalid argument"); |
nd_gr(f,v,m,homo,retdp,0,ord,rp); |
nd_gr(f,v,m,homo,retdp,0,ord,rp); |
|
} |
|
|
|
void nd_sba(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp); |
|
|
|
void Pnd_sba(NODE arg,LIST *rp) |
|
{ |
|
LIST f,v; |
|
int m,homo,retdp,ac; |
|
Obj val; |
|
Z mq,z; |
|
Num nhomo; |
|
NODE node; |
|
struct order_spec *ord,*current_spec; |
|
|
|
current_spec = dp_current_spec; |
|
do_weyl = 0; |
|
retdp = 0; |
|
if ( (ac=argc(arg)) == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG1(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG2(arg),O_N,"nd_sba"); |
|
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
|
f = remove_zero_from_list(f); |
|
if ( !BDY(f) ) { |
|
*rp = f; return; |
|
} |
|
mq = (Z)ARG2(arg); |
|
STOZ(0x40000000,z); |
|
if ( cmpz(mq,z) >= 0 ) { |
|
node = mknode(1,mq); |
|
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = ZTOS(mq); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
homo = 0; |
|
if ( get_opt("homo",&val) && val ) homo = 1; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = ZTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else |
|
error("nd_gr : invalid argument"); |
|
nd_sba(f,v,m,homo,retdp,0,ord,rp); |
|
initd(current_spec); |
|
} |
|
|
|
void Pnd_weyl_sba(NODE arg,LIST *rp) |
|
{ |
|
LIST f,v; |
|
int m,homo,retdp,ac; |
|
Obj val; |
|
Z mq,z; |
|
Num nhomo; |
|
NODE node; |
|
struct order_spec *ord; |
|
|
|
do_weyl = 1; |
|
retdp = 0; |
|
if ( (ac=argc(arg)) == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG1(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG2(arg),O_N,"nd_sba"); |
|
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
|
f = remove_zero_from_list(f); |
|
if ( !BDY(f) ) { |
|
*rp = f; do_weyl = 0; return; |
|
} |
|
mq = (Z)ARG2(arg); |
|
STOZ(0x40000000,z); |
|
if ( cmpz(mq,z) >= 0 ) { |
|
node = mknode(1,mq); |
|
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = ZTOS(mq); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
homo = 0; |
|
if ( get_opt("homo",&val) && val ) homo = 1; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = ZTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else |
|
error("nd_gr : invalid argument"); |
|
nd_sba(f,v,m,homo,retdp,0,ord,rp); |
|
do_weyl = 0; |
|
} |
|
|
|
void Pnd_sba_f4(NODE arg,LIST *rp) |
|
{ |
|
LIST f,v; |
|
int m,homo,retdp,ac; |
|
Obj val; |
|
Z mq,z; |
|
Num nhomo; |
|
NODE node; |
|
struct order_spec *ord; |
|
|
|
do_weyl = 0; |
|
retdp = 0; |
|
if ( (ac=argc(arg)) == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG1(arg),O_LIST,"nd_sba"); |
|
asir_assert(ARG2(arg),O_N,"nd_sba"); |
|
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
|
f = remove_zero_from_list(f); |
|
if ( !BDY(f) ) { |
|
*rp = f; return; |
|
} |
|
mq = (Z)ARG2(arg); |
|
STOZ(0x40000000,z); |
|
if ( cmpz(mq,z) >= 0 ) { |
|
node = mknode(1,mq); |
|
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = ZTOS(mq); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
homo = 0; |
|
if ( get_opt("homo",&val) && val ) homo = 1; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = ZTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else |
|
error("nd_gr : invalid argument"); |
|
nd_sba(f,v,m,homo,retdp,1,ord,rp); |
} |
} |
|
|
void Pnd_gr_postproc(NODE arg,LIST *rp) |
void Pnd_gr_postproc(NODE arg,LIST *rp) |