version 1.1, 2018/09/19 05:45:05 |
version 1.21, 2019/12/27 08:13: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: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.20 2019/12/12 04:44:59 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; |
|
|
|
int do_weyl; |
int do_weyl; |
|
|
|
void Pdp_monomial_hilbert_poincare(); |
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 78 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 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 88 void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), P |
|
Line 90 void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), P |
|
void Pdp_cont(); |
void Pdp_cont(); |
void Pdp_gr_checklist(); |
void Pdp_gr_checklist(); |
void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc(); |
void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc(); |
void Pdpm_ltod(),Pdpm_dtol(),Pdpm_ord(),Pdpm_nf(),Pdpm_weyl_nf(),Pdpm_sp(),Pdpm_weyl_sp(); |
void Pdpm_ltod(),Pdpm_dtol(),Pdpm_set_schreyer(),Pdpm_nf(),Pdpm_weyl_nf(),Pdpm_sp(),Pdpm_weyl_sp(),Pdpm_nf_and_quotient(),Pdpm_nf_and_quotient2(); |
void Pdpm_hm(),Pdpm_ht(),Pdpm_hc(); |
void Pdpm_schreyer_frame(),Pdpm_set_schreyer_level(); |
|
void Pdpm_list_to_array(),Pdpm_sp_nf(),Pdpm_insert_to_zlist(); |
|
void Pdpm_hm(),Pdpm_ht(),Pdpm_hc(),Pdpm_hp(),Pdpm_rest(),Pdpm_shift(),Pdpm_split(),Pdpm_extract(),Pdpm_sort(),Pdpm_dptodpm(),Pdpm_redble(); |
|
void Pdpm_schreyer_base(),Pdpm_simplify_syz(),Pdpm_td(); |
|
void Pdpm_remove_cont(); |
|
|
void Pdp_weyl_red(); |
void Pdp_weyl_red(); |
void Pdp_weyl_sp(); |
void Pdp_weyl_sp(); |
Line 138 struct ftab dp_tab[] = { |
|
Line 144 struct ftab dp_tab[] = { |
|
{"dp_prim",Pdp_prim,1}, |
{"dp_prim",Pdp_prim,1}, |
{"dp_red_coef",Pdp_red_coef,2}, |
{"dp_red_coef",Pdp_red_coef,2}, |
{"dp_cont",Pdp_cont,1}, |
{"dp_cont",Pdp_cont,1}, |
|
{"dpm_remove_cont",Pdpm_remove_cont,1}, |
|
|
/* polynomial ring */ |
/* polynomial ring */ |
/* special operations */ |
/* special operations */ |
Line 156 struct ftab dp_tab[] = { |
|
Line 163 struct ftab dp_tab[] = { |
|
{"dp_nf",Pdp_nf,4}, |
{"dp_nf",Pdp_nf,4}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_nf_f",Pdp_nf_f,4}, |
{"dp_nf_f",Pdp_nf_f,4}, |
{"dpm_nf_f",Pdpm_nf_f,4}, |
{"dpm_nf_and_quotient",Pdpm_nf_and_quotient,-3}, |
{"dpm_weyl_nf_f",Pdpm_weyl_nf_f,4}, |
{"dpm_nf_and_quotient2",Pdpm_nf_and_quotient2,-3}, |
{"dpm_nf",Pdpm_nf,4}, |
{"dpm_nf_f",Pdpm_nf_f,-4}, |
|
{"dpm_weyl_nf_f",Pdpm_weyl_nf_f,-4}, |
|
{"dpm_nf",Pdpm_nf,-4}, |
{"dpm_sp",Pdpm_sp,2}, |
{"dpm_sp",Pdpm_sp,2}, |
{"dpm_weyl_sp",Pdpm_weyl_sp,2}, |
{"dpm_weyl_sp",Pdpm_weyl_sp,2}, |
|
|
Line 214 struct ftab dp_tab[] = { |
|
Line 223 struct ftab dp_tab[] = { |
|
|
|
/* normal form */ |
/* normal form */ |
{"dp_weyl_nf",Pdp_weyl_nf,4}, |
{"dp_weyl_nf",Pdp_weyl_nf,4}, |
{"dpm_weyl_nf",Pdpm_weyl_nf,4}, |
{"dpm_weyl_nf",Pdpm_weyl_nf,-4}, |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
|
|
Line 233 struct ftab dp_tab[] = { |
|
Line 242 struct ftab dp_tab[] = { |
|
{"dp_weyl_f4_main",Pdp_weyl_f4_main,3}, |
{"dp_weyl_f4_main",Pdp_weyl_f4_main,3}, |
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
|
|
|
/* Hilbert function */ |
|
{"dp_monomial_hilbert_poincare",Pdp_monomial_hilbert_poincare,2}, |
|
|
/* misc */ |
/* misc */ |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
{"dp_set_weight",Pdp_set_weight,-1}, |
{"dp_set_weight",Pdp_set_weight,-1}, |
Line 248 struct ftab dp_supp_tab[] = { |
|
Line 260 struct ftab dp_supp_tab[] = { |
|
/* setting flags */ |
/* setting flags */ |
{"dp_sort",Pdp_sort,1}, |
{"dp_sort",Pdp_sort,1}, |
{"dp_ord",Pdp_ord,-1}, |
{"dp_ord",Pdp_ord,-1}, |
{"dpm_ord",Pdpm_ord,-1}, |
{"dpm_set_schreyer",Pdpm_set_schreyer,-1}, |
|
{"dpm_set_schreyer_level",Pdpm_set_schreyer_level,1}, |
|
{"dpm_schreyer_frame",Pdpm_schreyer_frame,1}, |
{"dpv_ord",Pdpv_ord,-2}, |
{"dpv_ord",Pdpv_ord,-2}, |
{"dp_set_kara",Pdp_set_kara,-1}, |
{"dp_set_kara",Pdp_set_kara,-1}, |
{"dp_nelim",Pdp_nelim,-1}, |
{"dp_nelim",Pdp_nelim,-1}, |
Line 270 struct ftab dp_supp_tab[] = { |
|
Line 284 struct ftab dp_supp_tab[] = { |
|
{"dp_ltod",Pdp_ltod,-2}, |
{"dp_ltod",Pdp_ltod,-2}, |
|
|
{"dpm_ltod",Pdpm_ltod,2}, |
{"dpm_ltod",Pdpm_ltod,2}, |
{"dpm_dtol",Pdpm_dtol,3}, |
{"dpm_dptodpm",Pdpm_dptodpm,2}, |
|
{"dpm_dtol",Pdpm_dtol,2}, |
|
{"dpm_homo",Pdpm_homo,1}, |
|
{"dpm_dehomo",Pdpm_dehomo,1}, |
|
|
/* criteria */ |
/* criteria */ |
{"dp_cri1",Pdp_cri1,2}, |
{"dp_cri1",Pdp_cri1,2}, |
Line 289 struct ftab dp_supp_tab[] = { |
|
Line 306 struct ftab dp_supp_tab[] = { |
|
{"dpm_hm",Pdpm_hm,1}, |
{"dpm_hm",Pdpm_hm,1}, |
{"dpm_ht",Pdpm_ht,1}, |
{"dpm_ht",Pdpm_ht,1}, |
{"dpm_hc",Pdpm_hc,1}, |
{"dpm_hc",Pdpm_hc,1}, |
|
{"dpm_hp",Pdpm_hp,1}, |
|
{"dpm_rest",Pdpm_rest,1}, |
|
{"dpm_shift",Pdpm_shift,2}, |
|
{"dpm_split",Pdpm_split,2}, |
|
{"dpm_extract",Pdpm_extract,2}, |
|
{"dpm_sort",Pdpm_sort,1}, |
{"dp_rest",Pdp_rest,1}, |
{"dp_rest",Pdp_rest,1}, |
{"dp_initial_term",Pdp_initial_term,1}, |
{"dp_initial_term",Pdp_initial_term,1}, |
{"dp_order",Pdp_order,1}, |
{"dp_order",Pdp_order,1}, |
Line 299 struct ftab dp_supp_tab[] = { |
|
Line 322 struct ftab dp_supp_tab[] = { |
|
{"dp_mag",Pdp_mag,1}, |
{"dp_mag",Pdp_mag,1}, |
{"dp_sugar",Pdp_sugar,1}, |
{"dp_sugar",Pdp_sugar,1}, |
{"dp_set_sugar",Pdp_set_sugar,2}, |
{"dp_set_sugar",Pdp_set_sugar,2}, |
|
{"dpm_td",Pdpm_td,1}, |
|
|
/* misc */ |
/* misc */ |
{"dp_mbase",Pdp_mbase,1}, |
{"dp_mbase",Pdp_mbase,1}, |
{"dp_redble",Pdp_redble,2}, |
{"dp_redble",Pdp_redble,2}, |
|
{"dpm_redble",Pdpm_redble,2}, |
{"dp_sep",Pdp_sep,2}, |
{"dp_sep",Pdp_sep,2}, |
{"dp_idiv",Pdp_idiv,2}, |
{"dp_idiv",Pdp_idiv,2}, |
{"dp_tdiv",Pdp_tdiv,2}, |
{"dp_tdiv",Pdp_tdiv,2}, |
Line 312 struct ftab dp_supp_tab[] = { |
|
Line 337 struct ftab dp_supp_tab[] = { |
|
{"dp_compute_essential_df",Pdp_compute_essential_df,2}, |
{"dp_compute_essential_df",Pdp_compute_essential_df,2}, |
{"dp_mono_raddec",Pdp_mono_raddec,2}, |
{"dp_mono_raddec",Pdp_mono_raddec,2}, |
{"dp_mono_reduce",Pdp_mono_reduce,2}, |
{"dp_mono_reduce",Pdp_mono_reduce,2}, |
|
{"dpm_schreyer_base",Pdpm_schreyer_base,1}, |
|
{"dpm_list_to_array",Pdpm_list_to_array,1}, |
|
{"dpm_sp_nf",Pdpm_sp_nf,4}, |
|
{"dpm_insert_to_zlist",Pdpm_insert_to_zlist,3}, |
|
{"dpm_simplify_syz",Pdpm_simplify_syz,2}, |
|
|
{"dp_rref2",Pdp_rref2,2}, |
{"dp_rref2",Pdp_rref2,2}, |
{"sumi_updatepairs",Psumi_updatepairs,3}, |
{"sumi_updatepairs",Psumi_updatepairs,3}, |
Line 323 struct ftab dp_supp_tab[] = { |
|
Line 353 struct ftab dp_supp_tab[] = { |
|
NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2); |
NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2); |
Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp); |
Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp); |
|
|
|
int comp_by_tdeg(DP *a,DP *b) |
|
{ |
|
int da,db; |
|
|
|
da = BDY(*a)->dl->td; |
|
db = BDY(*b)->dl->td; |
|
if ( da>db ) return 1; |
|
else if ( da<db ) return -1; |
|
else return 0; |
|
} |
|
|
|
void dl_print(DL d,int n) |
|
{ |
|
int i; |
|
|
|
printf("<<"); |
|
for ( i = 0; i < n; i++ ) |
|
printf("%d ",d->d[i]); |
|
printf(">>\n"); |
|
} |
|
|
|
int simple_check(VECT b,int nv) |
|
{ |
|
int n,i,j; |
|
DL *p; |
|
|
|
n = b->len; p = (DL *)b->body; |
|
for ( i = 0; i < n; i++ ) { |
|
for ( j = 0; j < nv; j++ ) { |
|
if ( p[i]->d[j] ) break; |
|
} |
|
if ( p[i]->d[j] != p[i]->td ) return 0; |
|
} |
|
return 1; |
|
} |
|
|
|
void make_reduced(VECT b,int nv) |
|
{ |
|
int n,i,j; |
|
DL *p; |
|
DL pi; |
|
|
|
n = b->len; |
|
p = (DL *)BDY(b); |
|
for ( i = 0; i < n; i++ ) { |
|
pi = p[i]; |
|
if ( !pi ) continue; |
|
for ( j = 0; j < n; j++ ) |
|
if ( i != j && p[j] && _dl_redble(pi,p[j],nv) ) p[j] = 0; |
|
} |
|
for ( i = j = 0; i < n; i++ ) |
|
if ( p[i] ) p[j++] = p[i]; |
|
b->len = j; |
|
} |
|
|
|
void make_reduced2(VECT b,int k,int nv) |
|
{ |
|
int n,i,j,l; |
|
DL *p; |
|
DL pi; |
|
|
|
n = b->len; |
|
p = (DL *)BDY(b); |
|
for ( i = l = k; i < n; i++ ) { |
|
pi = p[i]; |
|
for ( j = 0; j < k; j++ ) |
|
if ( _dl_redble(p[j],pi,nv) ) break; |
|
if ( j == k ) |
|
p[l++] = pi; |
|
} |
|
b->len = l; |
|
} |
|
|
|
int i_all,i_simple; |
|
|
|
P mhp_simple(VECT b,VECT x,P t) |
|
{ |
|
int n,i,j,nv; |
|
DL *p; |
|
P hp,mt,s,w; |
|
Z z; |
|
|
|
n = b->len; nv = x->len; p = (DL *)BDY(b); |
|
hp = (P)ONE; |
|
for ( i = 0; i < n; i++ ) { |
|
for ( j = 0; j < nv; j++ ) |
|
if ( p[i]->d[j] ) break; |
|
STOZ(p[i]->d[j],z); |
|
chsgnp(t,&mt); mt->dc->d =z; |
|
addp(CO,mt,(P)ONE,&s); mulp(CO,hp,s,&w); hp = w; |
|
} |
|
return hp; |
|
} |
|
|
|
struct oEGT eg_comp; |
|
|
|
void mhp_rec(VECT b,VECT x,P t,P *r) |
|
{ |
|
int n,i,j,k,l,i2,nv,len; |
|
int *d; |
|
Z mone,z; |
|
DCP dc,dc1; |
|
P s; |
|
P *r2; |
|
DL *p,*q; |
|
DL pi,xj,d1; |
|
VECT c; |
|
struct oEGT eg0,eg1; |
|
|
|
i_all++; |
|
n = b->len; nv = x->len; p = (DL *)BDY(b); |
|
if ( !n ) { |
|
r[0] = (P)ONE; |
|
return; |
|
} |
|
if ( n == 1 && p[0]->td == 0 ) |
|
return; |
|
for ( i = 0; i < n; i++ ) |
|
if ( p[i]->td > 1 ) break; |
|
if ( i == n ) { |
|
r[n] = (P)ONE; |
|
return; |
|
} |
|
#if 0 |
|
if ( simple_check(b,nv) ) { |
|
i_simple++; |
|
r[0] = mhp_simple(b,x,t); |
|
return; |
|
} |
|
#endif |
|
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); |
|
mhp_rec(b,x,t,r); |
|
/* c = (b[0],...,b[l-1],xj) */ |
|
q[l] = xj; c->len = l+1; |
|
r2 = (P *)CALLOC(nv+1,sizeof(P)); |
|
mhp_rec(c,x,t,r2); |
|
// get_eg(&eg0); |
|
for ( i = 0; i <= nv; i++ ) { |
|
mulp(CO,r[i],t,&s); addp(CO,s,r2[i],&r[i]); |
|
} |
|
// get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1); |
|
} |
|
|
|
/* (n+a)Cb as a polynomial of n; return (n+a)*...*(n+a-b+1) */ |
|
|
|
P binpoly(P n,int a,int b) |
|
{ |
|
Z z; |
|
P s,r,t; |
|
int i; |
|
|
|
STOZ(a,z); addp(CO,n,(P)z,&s); r = (P)ONE; |
|
for ( i = 0; i < b; i++ ) { |
|
mulp(CO,r,s,&t); r = t; |
|
subp(CO,s,(P)ONE,&t); s = t; |
|
} |
|
return r; |
|
} |
|
|
|
void ibin(unsigned long int n,unsigned long int k,Z *r); |
|
|
|
void mhp_to_hf(VL vl,P hp,int n,P *plist,VECT *head,P *hf) |
|
{ |
|
P tv,gcd,q,h,hphead,tt,ai,hpoly,nv,bp,w; |
|
Z d,z; |
|
DCP dc,topdc; |
|
VECT hfhead; |
|
int i,s,qd; |
|
|
|
if ( !hp ) { |
|
MKVECT(hfhead,0); *head = hfhead; |
|
*hf = 0; |
|
} else { |
|
makevar("t",&tv); |
|
ezgcdp(CO,hp,plist[n],&gcd); |
|
if ( NUM(gcd) ) { |
|
s = n; |
|
q = hp; |
|
} else { |
|
s = n-ZTOS(DEG(DC(gcd))); |
|
divsp(CO,hp,plist[n-s],&q); |
|
} |
|
if ( NUM(q) ) qd = 0; |
|
else qd = ZTOS(DEG(DC(q))); |
|
if ( s == 0 ) { |
|
MKVECT(hfhead,qd+1); |
|
for ( i = 0; i <= qd; i++ ) { |
|
coefp(q,i,(P *)&BDY(hfhead)[i]); |
|
} |
|
*head = hfhead; |
|
*hf = 0; |
|
} else { |
|
if ( qd ) { |
|
topdc = 0; |
|
for ( i = 0; i < qd; i++ ) { |
|
NEWDC(dc); NEXT(dc) = topdc; |
|
ibin(i+s-1,s-1,(Z *)&COEF(dc)); |
|
STOZ(i,d); DEG(dc) = d; |
|
topdc = dc; |
|
} |
|
MKP(VR(tv),topdc,h); |
|
mulp(CO,h,q,&hphead); |
|
} |
|
MKVECT(hfhead,qd); |
|
for ( i = 0; i < qd; i++ ) |
|
coefp(hphead,i,(P *)&BDY(hfhead)[i]); |
|
*head = hfhead; |
|
hpoly = 0; |
|
makevar("n",&nv); |
|
for ( i = 0; i <= qd; i++ ) { |
|
coefp(q,i,&ai); |
|
bp = binpoly(nv,s-i-1,s-1); |
|
mulp(CO,ai,bp,&tt); |
|
addp(CO,hpoly,tt,&w); |
|
hpoly = w; |
|
} |
|
if ( s > 2 ) { |
|
factorialz(s-1,&z); |
|
divsp(CO,hpoly,(P)z,&tt); hpoly = tt; |
|
} |
|
*hf = hpoly; |
|
for ( i = qd-1; i >= 0; i-- ) { |
|
UTOZ(i,z); |
|
substp(CO,hpoly,VR(nv),(P)z,&tt); |
|
if ( cmpz((Z)tt,(Z)BDY(hfhead)[i]) ) break; |
|
} |
|
hfhead->len = i+1; |
|
} |
|
} |
|
} |
|
|
|
/* create (1,1-t,...,(1-t)^n) */ |
|
|
|
P *mhp_prep(int n,P *tv) { |
|
P *plist; |
|
P mt,t1; |
|
int i; |
|
|
|
plist = (P *)MALLOC((n+1)*sizeof(P)); |
|
/* t1 = 1-t */ |
|
makevar("t",tv); chsgnp(*tv,&mt); addp(CO,mt,(P)ONE,&t1); |
|
for ( plist[0] = (P)ONE, i = 1; i <= n; i++ ) |
|
mulp(CO,plist[i-1],t1,&plist[i]); |
|
return plist; |
|
} |
|
|
|
P mhp_ctop(P *r,P *plist,int n) |
|
{ |
|
int i; |
|
P hp,u,w; |
|
|
|
for ( hp = 0, i = 0; i <= n; i++ ) { |
|
mulp(CO,plist[i],r[i],&u); addp(CO,u,hp,&w); hp = w; |
|
} |
|
return hp; |
|
} |
|
|
|
void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp) |
|
{ |
|
LIST g,v; |
|
VL vl; |
|
int m,n,i; |
|
VECT b,x,hfhead; |
|
NODE t,nd; |
|
Z z,den; |
|
P hp,tv,mt,t1,u,w,hpoly; |
|
DP a; |
|
DL *p; |
|
P *plist,*r; |
|
Obj val; |
|
|
|
i_simple = i_all = 0; |
|
g = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
|
pltovl(v,&vl); |
|
m = length(BDY(g)); MKVECT(b,m); p = (DL *)BDY(b); |
|
for ( t = BDY(g), i = 0; t; t = NEXT(t), i++ ) { |
|
if ( !BDY(t) ) |
|
p[i] = 0; |
|
else { |
|
ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl; |
|
} |
|
} |
|
n = length(BDY(v)); MKVECT(x,n); p = (DL *)BDY(x); |
|
for ( t = BDY(v), i = 0; t; t = NEXT(t), i++ ) { |
|
ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl; |
|
} |
|
|
|
r = (P *)CALLOC(n+1,sizeof(P)); |
|
plist = mhp_prep(n,&tv); |
|
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); |
|
nd = mknode(4,hp,z,hfhead,hpoly); |
|
MKLIST(*rp,nd); |
|
} |
|
|
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 362 void Pdp_compute_last_w(NODE arg,LIST *rp) |
|
Line 707 void Pdp_compute_last_w(NODE arg,LIST *rp) |
|
row2 = w2->row; |
row2 = w2->row; |
if ( w ) { |
if ( w ) { |
v = W_ALLOC(n); |
v = W_ALLOC(n); |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
for ( i = 0; i < n; i++ ) v[i] = ZTOS((Q)w->body[i]); |
} else v = 0; |
} else v = 0; |
m1 = almat(row1,n); |
m1 = almat(row1,n); |
for ( i = 0; i < row1; i++ ) |
for ( i = 0; i < row1; i++ ) |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
for ( j = 0; j < n; j++ ) m1[i][j] = ZTOS((Q)w1->body[i][j]); |
m2 = almat(row2,n); |
m2 = almat(row2,n); |
for ( i = 0; i < row2; i++ ) |
for ( i = 0; i < row2; i++ ) |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
for ( j = 0; j < n; j++ ) m2[i][j] = ZTOS((Q)w2->body[i][j]); |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
if ( !r ) *rp = 0; |
if ( !r ) *rp = 0; |
else { |
else { |
MKVECT(rv,n); |
MKVECT(rv,n); |
for ( i = 0; i < n; i++ ) { |
for ( i = 0; i < n; i++ ) { |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
STOZ(v[i],q); rv->body[i] = (pointer)q; |
} |
} |
MKLIST(l,r); |
MKLIST(l,r); |
r = mknode(2,rv,l); |
r = mknode(2,rv,l); |
Line 452 void Pdp_sep(NODE arg,VECT *rp) |
|
Line 797 void Pdp_sep(NODE arg,VECT *rp) |
|
pointer *pv; |
pointer *pv; |
|
|
p = (DP)ARG0(arg); m = BDY(p); |
p = (DP)ARG0(arg); m = BDY(p); |
d = QTOS((Q)ARG1(arg)); |
d = ZTOS((Q)ARG1(arg)); |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
if ( d > n ) |
if ( d > n ) |
d = n; |
d = n; |
Line 479 void Pdp_cont(NODE arg,Z *rp) |
|
Line 824 void Pdp_cont(NODE arg,Z *rp) |
|
dp_cont((DP)ARG0(arg),rp); |
dp_cont((DP)ARG0(arg),rp); |
} |
} |
|
|
|
void dpm_ptozp(DPM p,Z *cont,DPM *r); |
|
|
|
void Pdpm_remove_cont(NODE arg,LIST *rp) |
|
{ |
|
NODE nd; |
|
Z cont; |
|
DPM p; |
|
|
|
dpm_ptozp((DPM)ARG0(arg),&cont,&p); |
|
nd = mknode(2,cont,p); |
|
MKLIST(*rp,nd); |
|
} |
|
|
void Pdp_dtov(NODE arg,VECT *rp) |
void Pdp_dtov(NODE arg,VECT *rp) |
{ |
{ |
dp_dtov((DP)ARG0(arg),rp); |
dp_dtov((DP)ARG0(arg),rp); |
Line 506 void Pdp_etov(NODE arg,VECT *rp) |
|
Line 864 void Pdp_etov(NODE arg,VECT *rp) |
|
n = dp->nv; d = BDY(dp)->dl->d; |
n = dp->nv; d = BDY(dp)->dl->d; |
MKVECT(v,n); |
MKVECT(v,n); |
for ( i = 0; i < n; i++ ) { |
for ( i = 0; i < n; i++ ) { |
STOQ(d[i],t); v->body[i] = (pointer)t; |
STOZ(d[i],t); v->body[i] = (pointer)t; |
} |
} |
*rp = v; |
*rp = v; |
} |
} |
Line 525 void Pdp_vtoe(NODE arg,DP *rp) |
|
Line 883 void Pdp_vtoe(NODE arg,DP *rp) |
|
n = v->len; |
n = v->len; |
NEWDL(dl,n); d = dl->d; |
NEWDL(dl,n); d = dl->d; |
for ( i = 0, td = 0; i < n; i++ ) { |
for ( i = 0, td = 0; i < n; i++ ) { |
d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
d[i] = ZTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
} |
} |
dl->td = td; |
dl->td = td; |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
Line 543 void Pdp_lnf_mod(NODE arg,LIST *rp) |
|
Line 901 void Pdp_lnf_mod(NODE arg,LIST *rp) |
|
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
mod = QTOS((Q)ARG2(arg)); |
mod = ZTOS((Q)ARG2(arg)); |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
NEWNODE(n); BDY(n) = (pointer)r1; |
NEWNODE(n); BDY(n) = (pointer)r1; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
Line 570 void Pdp_nf_tab_mod(NODE arg,DP *rp) |
|
Line 928 void Pdp_nf_tab_mod(NODE arg,DP *rp) |
|
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod"); |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod"); |
asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod"); |
asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod"); |
dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)), |
dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)), |
QTOS((Q)ARG2(arg)),rp); |
ZTOS((Q)ARG2(arg)),rp); |
} |
} |
|
|
void Pdp_nf_tab_f(NODE arg,DP *rp) |
void Pdp_nf_tab_f(NODE arg,DP *rp) |
Line 580 void Pdp_nf_tab_f(NODE arg,DP *rp) |
|
Line 938 void Pdp_nf_tab_f(NODE arg,DP *rp) |
|
dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp); |
dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp); |
} |
} |
|
|
|
extern int dpm_ordtype; |
|
|
void Pdp_ord(NODE arg,Obj *rp) |
void Pdp_ord(NODE arg,Obj *rp) |
{ |
{ |
struct order_spec *spec; |
struct order_spec *spec; |
Line 597 void Pdp_ord(NODE arg,Obj *rp) |
|
Line 957 void Pdp_ord(NODE arg,Obj *rp) |
|
else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
error("dp_ord : invalid order specification"); |
error("dp_ord : invalid order specification"); |
initd(spec); *rp = spec->obj; |
initd(spec); *rp = spec->obj; |
|
if ( spec->id >= 256 ) dpm_ordtype = spec->module_ordtype; |
} |
} |
} |
} |
|
|
Line 747 void Pdpm_ltod(NODE arg,DPM *rp) |
|
Line 1108 void Pdpm_ltod(NODE arg,DPM *rp) |
|
|
|
nd = BDY(f); |
nd = BDY(f); |
len = length(nd); |
len = length(nd); |
for ( i = 0, t = nd, s = 0; i < len; i++, t = NEXT(t) ) { |
for ( i = 1, t = nd, s = 0; i <= len; i++, t = NEXT(t) ) { |
ptod(CO,vl,(P)BDY(t),&d); |
ptod(CO,vl,(P)BDY(t),&d); |
dtodpm(d,i,&u); |
dtodpm(d,i,&u); |
adddpm(CO,s,u,&w); s = w; |
adddpm(CO,s,u,&w); s = w; |
Line 755 void Pdpm_ltod(NODE arg,DPM *rp) |
|
Line 1116 void Pdpm_ltod(NODE arg,DPM *rp) |
|
*rp = s; |
*rp = s; |
} |
} |
|
|
|
// c*[monomial,i]+... -> c*<<monomial:i>>+... |
|
|
|
void Pdpm_dptodpm(NODE arg,DPM *rp) |
|
{ |
|
DP p; |
|
MP mp; |
|
int pos,shift; |
|
DMM m0,m; |
|
|
|
p = (DP)ARG0(arg); |
|
pos = ZTOS((Z)ARG1(arg)); |
|
if ( pos <= 0 ) |
|
error("dpm_mtod : position must be positive"); |
|
if ( !p ) *rp = 0; |
|
else { |
|
for ( m0 = 0, mp = BDY(p); mp; mp = NEXT(mp) ) { |
|
NEXTDMM(m0,m); m->dl = mp->dl; m->c = mp->c; m->pos = pos; |
|
} |
|
if ( dp_current_spec->module_top_weight ) { |
|
if ( pos > dp_current_spec->module_rank ) |
|
error("dpm_dptodpm : inconsistent order spec"); |
|
shift = dp_current_spec->module_top_weight[pos-1]; |
|
m->dl->td += shift; |
|
} else |
|
shift = 0; |
|
|
|
MKDPM(p->nv,m0,*rp); (*rp)->sugar = p->sugar+shift; |
|
} |
|
} |
|
|
void Pdpm_dtol(NODE arg,LIST *rp) |
void Pdpm_dtol(NODE arg,LIST *rp) |
{ |
{ |
DPM a; |
DPM a; |
Line 769 void Pdpm_dtol(NODE arg,LIST *rp) |
|
Line 1160 void Pdpm_dtol(NODE arg,LIST *rp) |
|
Obj s; |
Obj s; |
|
|
a = (DPM)ARG0(arg); |
a = (DPM)ARG0(arg); |
|
if ( !a ) { |
|
MKLIST(*rp,0); |
|
return; |
|
} |
for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) { |
for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) { |
if ( !vl ) { |
if ( !vl ) { |
NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
Line 779 void Pdpm_dtol(NODE arg,LIST *rp) |
|
Line 1174 void Pdpm_dtol(NODE arg,LIST *rp) |
|
} |
} |
if ( vl ) |
if ( vl ) |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
n = QTOS((Q)ARG2(arg)); |
for ( t = BDY(a), n = 0; t; t = NEXT(t) ) |
|
if ( t->pos > n ) n = t->pos; |
w = (MP *)CALLOC(n,sizeof(MP)); |
w = (MP *)CALLOC(n,sizeof(MP)); |
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
Line 787 void Pdpm_dtol(NODE arg,LIST *rp) |
|
Line 1183 void Pdpm_dtol(NODE arg,LIST *rp) |
|
for ( i = len-1; i >= 0; i-- ) { |
for ( i = len-1; i >= 0; i-- ) { |
NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]); |
NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]); |
pos = wa[i]->pos; |
pos = wa[i]->pos; |
NEXT(m) = w[pos]; |
NEXT(m) = w[pos-1]; |
w[pos] = m; |
w[pos-1] = m; |
} |
} |
nd = 0; |
nd = 0; |
for ( i = n-1; i >= 0; i-- ) { |
for ( i = n-1; i >= 0; i-- ) { |
Line 891 void Pdp_mod(NODE arg,DP *rp) |
|
Line 1287 void Pdp_mod(NODE arg,DP *rp) |
|
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
asir_assert(ARG1(arg),O_N,"dp_mod"); |
asir_assert(ARG1(arg),O_N,"dp_mod"); |
asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg)); |
p = (DP)ARG0(arg); mod = ZTOS((Q)ARG1(arg)); |
subst = BDY((LIST)ARG2(arg)); |
subst = BDY((LIST)ARG2(arg)); |
dp_mod(p,mod,subst,rp); |
dp_mod(p,mod,subst,rp); |
} |
} |
Line 948 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
Line 1344 void Pdp_weyl_nf(NODE arg,DP *rp) |
|
void Pdpm_nf(NODE arg,DPM *rp) |
void Pdpm_nf(NODE arg,DPM *rp) |
{ |
{ |
NODE b; |
NODE b; |
DPM *ps; |
VECT ps; |
DPM g; |
DPM g; |
int full; |
int ac,full; |
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
if ( !(g = (DPM)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
ac = argc(arg); |
asir_assert(ARG1(arg),O_DPM,"dpm_nf"); |
if ( ac < 3 ) |
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
error("dpm_nf: invalid arguments"); |
asir_assert(ARG3(arg),O_N,"dpm_nf"); |
else if ( ac == 3 ) { |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
asir_assert(ARG1(arg),O_VECT,"dpm_nf"); |
full = (Q)ARG3(arg) ? 1 : 0; |
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
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); |
} |
} |
|
|
|
DP *dpm_nf_and_quotient(NODE b,DPM g,VECT ps,DPM *rp,P *dnp); |
|
DPM dpm_nf_and_quotient2(NODE b,DPM g,VECT ps,DPM *rp,P *dnp); |
|
|
|
void Pdpm_nf_and_quotient(NODE arg,LIST *rp) |
|
{ |
|
NODE b; |
|
VECT ps; |
|
DPM g,nm; |
|
P dn; |
|
VECT quo; |
|
NODE n; |
|
int ac; |
|
|
|
do_weyl = 0; dp_fcoeffs = 0; |
|
ac = argc(arg); |
|
if ( ac < 2 ) |
|
error("dpm_nf_and_quotient : invalid arguments"); |
|
else if ( ac == 2 ) { |
|
asir_assert(ARG1(arg),O_VECT,"dpm_nf_and_quotient"); |
|
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 3 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_nf_and_quotient"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_nf_and_quotient"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
} |
|
NEWVECT(quo); quo->len = ps->len; |
|
if ( g ) { |
|
quo->body = (pointer *)dpm_nf_and_quotient(b,g,ps,&nm,&dn); |
|
} else { |
|
quo->body = (pointer *)MALLOC(quo->len*sizeof(pointer)); |
|
nm = 0; dn = (P)ONE; |
|
} |
|
n = mknode(3,nm,dn,quo); |
|
MKLIST(*rp,n); |
|
} |
|
|
|
void Pdpm_nf_and_quotient2(NODE arg,LIST *rp) |
|
{ |
|
NODE b; |
|
VECT ps; |
|
DPM g,nm,q; |
|
P dn; |
|
NODE n; |
|
int ac; |
|
|
|
do_weyl = 0; dp_fcoeffs = 0; |
|
ac = argc(arg); |
|
if ( ac < 2 ) |
|
error("dpm_nf_and_quotient2 : invalid arguments"); |
|
else if ( ac == 2 ) { |
|
asir_assert(ARG1(arg),O_VECT,"dpm_nf_and_quotient2"); |
|
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 3 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_nf_and_quotient2"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_nf_and_quotient2"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
} |
|
if ( g ) { |
|
q = dpm_nf_and_quotient2(b,g,ps,&nm,&dn); |
|
} else { |
|
q = 0; nm = 0; dn = (P)ONE; |
|
} |
|
n = mknode(3,nm,dn,q); |
|
MKLIST(*rp,n); |
|
} |
|
|
void Pdpm_weyl_nf(NODE arg,DPM *rp) |
void Pdpm_weyl_nf(NODE arg,DPM *rp) |
{ |
{ |
NODE b; |
NODE b; |
DPM *ps; |
VECT ps; |
DPM g; |
DPM g; |
int full; |
int ac,full; |
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
if ( !(g = (DPM)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf"); |
do_weyl = 1; dp_fcoeffs = 0; |
asir_assert(ARG1(arg),O_DPM,"dpm_weyl_nf"); |
ac = argc(arg); |
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf"); |
if ( ac < 3 ) |
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf"); |
error("dpm_weyl_nf: invalid arguments"); |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
else if ( ac == 3 ) { |
full = (Q)ARG3(arg) ? 1 : 0; |
asir_assert(ARG1(arg),O_VECT,"dpm_nf"); |
do_weyl = 1; |
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
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); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
Line 1032 void Pdp_weyl_nf_f(NODE arg,DP *rp) |
|
Line 1506 void Pdp_weyl_nf_f(NODE arg,DP *rp) |
|
void Pdpm_nf_f(NODE arg,DPM *rp) |
void Pdpm_nf_f(NODE arg,DPM *rp) |
{ |
{ |
NODE b; |
NODE b; |
DPM *ps; |
VECT ps; |
DPM g; |
DPM g; |
int full; |
int ac,full; |
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
if ( !(g = (DPM)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
asir_assert(ARG0(arg),O_LIST,"dpm_nf_f"); |
ac = argc(arg); |
asir_assert(ARG1(arg),O_DPM,"dpm_nf_f"); |
if ( ac < 3 ) |
asir_assert(ARG2(arg),O_VECT,"dpm_nf_f"); |
error("dpm_nf_f: invalid arguments"); |
asir_assert(ARG3(arg),O_N,"dpm_nf_f"); |
else if ( ac == 3 ) { |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
asir_assert(ARG1(arg),O_VECT,"dpm_nf_f"); |
full = (Q)ARG3(arg) ? 1 : 0; |
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_nf_f"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_nf_f"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
full = (Q)ARG3(arg) ? 1 : 0; |
|
} |
|
do_weyl = 0; |
dpm_nf_f(b,g,ps,full,rp); |
dpm_nf_f(b,g,ps,full,rp); |
} |
} |
|
|
void Pdpm_weyl_nf_f(NODE arg,DPM *rp) |
void Pdpm_weyl_nf_f(NODE arg,DPM *rp) |
{ |
{ |
NODE b; |
NODE b; |
DPM *ps; |
VECT ps; |
DPM g; |
DPM g; |
int full; |
int ac,full; |
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
if ( !(g = (DPM)ARG1(arg)) ) { |
*rp = 0; return; |
*rp = 0; return; |
} |
} |
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f"); |
ac = argc(arg); |
asir_assert(ARG1(arg),O_DP,"dpm_weyl_nf_f"); |
if ( ac < 3 ) |
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f"); |
error("dpm_weyl_nf_f: invalid arguments"); |
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf_f"); |
else if ( ac == 3 ) { |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
asir_assert(ARG1(arg),O_VECT,"dpm_weyl_nf_f"); |
full = (Q)ARG3(arg) ? 1 : 0; |
b = 0; g = (DPM)ARG0(arg); ps = (VECT)ARG1(arg); |
|
} else if ( ac == 4 ) { |
|
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f"); |
|
b = BDY((LIST)ARG0(arg)); g = (DPM)ARG1(arg); ps = (VECT)ARG2(arg); |
|
full = (Q)ARG3(arg) ? 1 : 0; |
|
} |
do_weyl = 1; |
do_weyl = 1; |
dpm_nf_f(b,g,ps,full,rp); |
dpm_nf_f(b,g,ps,full,rp); |
do_weyl = 0; |
do_weyl = 0; |
Line 1089 void Pdp_nf_mod(NODE arg,DP *rp) |
|
Line 1576 void Pdp_nf_mod(NODE arg,DP *rp) |
|
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
NEXTNODE(n0,n); |
NEXTNODE(n0,n); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
BDY(n) = (pointer)ZTOS((Q)BDY(b)); |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
Line 1186 void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST |
|
Line 1673 void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
Line 1248 void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
|
Line 1735 void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
n = mknode(2,nm,dn); |
n = mknode(2,nm,dn); |
Line 1273 void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
|
Line 1760 void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
|
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
NEXTNODE(n0,n); |
NEXTNODE(n0,n); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
BDY(n) = (pointer)ZTOS((Q)BDY(b)); |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
Line 1304 void Pdp_true_nf_mod(NODE arg,LIST *rp) |
|
Line 1791 void Pdp_true_nf_mod(NODE arg,LIST *rp) |
|
nm = 0; dn = (P)ONEM; |
nm = 0; dn = (P)ONEM; |
} else { |
} else { |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
} |
} |
NEWNODE(n); BDY(n) = (pointer)nm; |
NEWNODE(n); BDY(n) = (pointer)nm; |
Line 1369 void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg |
|
Line 1856 void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
Line 1446 void Pdp_redble(NODE arg,Z *rp) |
|
Line 1933 void Pdp_redble(NODE arg,Z *rp) |
|
*rp = 0; |
*rp = 0; |
} |
} |
|
|
|
void Pdpm_redble(NODE arg,Z *rp) |
|
{ |
|
asir_assert(ARG0(arg),O_DPM,"dpm_redble"); |
|
asir_assert(ARG1(arg),O_DPM,"dpm_redble"); |
|
if ( dpm_redble((DPM)ARG0(arg),(DPM)ARG1(arg)) ) |
|
*rp = ONE; |
|
else |
|
*rp = 0; |
|
} |
|
|
|
void dpm_schreyer_base(LIST g,LIST *s); |
|
void dpm_schreyer_base_zlist(LIST g,LIST *s); |
|
|
|
void Pdpm_schreyer_base(NODE arg,LIST *rp) |
|
{ |
|
asir_assert(ARG0(arg),O_LIST,"dpm_schreyer_base"); |
|
dpm_schreyer_base_zlist((LIST)ARG0(arg),rp); |
|
} |
|
|
|
void dpm_list_to_array(LIST g,VECT *psv,VECT *psiv); |
|
|
|
void Pdpm_list_to_array(NODE arg,LIST *rp) |
|
{ |
|
VECT psv,psiv; |
|
NODE nd; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"dpm_list_to_array"); |
|
dpm_list_to_array((LIST)ARG0(arg),&psv,&psiv); |
|
nd = mknode(2,psv,psiv); |
|
MKLIST(*rp,nd); |
|
} |
|
|
|
/* [quo,nf] = dpm_sp_nf(psv,psiv,i,j,top) */ |
|
DPM dpm_sp_nf_zlist(VECT psv,VECT psiv,int i,int j,int top,DPM *nf); |
|
|
|
void Pdpm_sp_nf(NODE arg,LIST *rp) |
|
{ |
|
VECT psv,psiv; |
|
DPM quo,nf; |
|
Obj val; |
|
int i,j,top; |
|
NODE nd; |
|
|
|
asir_assert(ARG0(arg),O_VECT,"dpm_sp_nf"); psv = (VECT)ARG0(arg); |
|
asir_assert(ARG1(arg),O_VECT,"dpm_sp_nf"); psiv = (VECT)ARG1(arg); |
|
asir_assert(ARG2(arg),O_N,"dpm_sp_nf"); i = ZTOS((Q)ARG2(arg)); |
|
asir_assert(ARG3(arg),O_N,"dpm_sp_nf"); j = ZTOS((Q)ARG3(arg)); |
|
if ( get_opt("top",&val) && val ) |
|
top = 1; |
|
else |
|
top = 0; |
|
quo = dpm_sp_nf_zlist(psv,psiv,i,j,top,&nf); |
|
nd = mknode(2,quo,nf); |
|
MKLIST(*rp,nd); |
|
} |
|
|
|
void dpm_insert_to_zlist(VECT psiv,int pos,int i); |
|
|
|
/* insert_to_zlist(indarray,dpm_hp(f),i) */ |
|
void Pdpm_insert_to_zlist(NODE arg,VECT *rp) |
|
{ |
|
VECT psiv; |
|
int i,pos; |
|
|
|
asir_assert(ARG0(arg),O_VECT,"dpm_insert_to_zlist"); psiv = (VECT)ARG0(arg); |
|
asir_assert(ARG1(arg),O_N,"dpm_insert_to_zlist"); pos = ZTOS((Q)ARG1(arg)); |
|
asir_assert(ARG2(arg),O_N,"dpm_insert_to_zlist"); i = ZTOS((Q)ARG2(arg)); |
|
dpm_insert_to_zlist(psiv,pos,i); |
|
*rp = psiv; |
|
} |
|
|
|
|
|
void dpm_simplify_syz(LIST m,LIST s,LIST *m1,LIST *s1,LIST *w1); |
|
|
|
void Pdpm_simplify_syz(NODE arg,LIST *rp) |
|
{ |
|
LIST s1,m1,w1; |
|
NODE t; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"dpm_simplify_syz"); |
|
asir_assert(ARG1(arg),O_LIST,"dpm_simplify_syz"); |
|
dpm_simplify_syz((LIST)ARG0(arg),(LIST)ARG1(arg),&s1,&m1,&w1); |
|
t = mknode(3,s1,m1,w1); |
|
MKLIST(*rp,t); |
|
} |
|
|
|
|
void Pdp_red_mod(NODE arg,LIST *rp) |
void Pdp_red_mod(NODE arg,LIST *rp) |
{ |
{ |
DP h,r; |
DP h,r; |
Line 1457 void Pdp_red_mod(NODE arg,LIST *rp) |
|
Line 2031 void Pdp_red_mod(NODE arg,LIST *rp) |
|
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)), |
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),ZTOS((Q)ARG3(arg)), |
&h,&r,&dmy); |
&h,&r,&dmy); |
NEWNODE(n); BDY(n) = (pointer)h; |
NEWNODE(n); BDY(n) = (pointer)h; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
Line 1550 void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
|
Line 2124 void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
|
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(m,O_N,"dp_mul_mod"); |
asir_assert(m,O_N,"dp_mul_mod"); |
do_weyl = 1; |
do_weyl = 1; |
mulmd(CO,QTOS(m),p1,p2,rp); |
mulmd(CO,ZTOS(m),p1,p2,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
Line 1608 void Pdp_weyl_sp(NODE arg,DP *rp) |
|
Line 2182 void Pdp_weyl_sp(NODE arg,DP *rp) |
|
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdpm_sp(NODE arg,DPM *rp) |
void Pdpm_sp(NODE arg,Obj *rp) |
{ |
{ |
DPM p1,p2; |
DPM p1,p2,sp; |
|
DP mul1,mul2; |
|
Obj val; |
|
NODE nd; |
|
LIST l; |
|
|
do_weyl = 0; |
do_weyl = 0; |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp"); |
asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp"); |
dpm_sp(p1,p2,rp); |
dpm_sp(p1,p2,&sp,&mul1,&mul2); |
|
if ( get_opt("coef",&val) && val ) { |
|
nd = mknode(3,sp,mul1,mul2); |
|
MKLIST(l,nd); |
|
*rp = (Obj)l; |
|
} else { |
|
*rp = (Obj)sp; |
|
} |
} |
} |
|
|
void Pdpm_weyl_sp(NODE arg,DPM *rp) |
void Pdpm_weyl_sp(NODE arg,Obj *rp) |
{ |
{ |
DPM p1,p2; |
DPM p1,p2,sp; |
|
DP mul1,mul2; |
|
Obj val; |
|
NODE nd; |
|
LIST l; |
|
|
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
asir_assert(p1,O_DPM,"dpm_weyl_sp"); asir_assert(p2,O_DPM,"dpm_weyl_sp"); |
asir_assert(p1,O_DPM,"dpm_weyl_sp"); asir_assert(p2,O_DPM,"dpm_weyl_sp"); |
do_weyl = 1; |
do_weyl = 1; |
dpm_sp(p1,p2,rp); |
dpm_sp(p1,p2,&sp,&mul1,&mul2); |
do_weyl = 0; |
do_weyl = 0; |
|
if ( get_opt("coef",&val) && val ) { |
|
nd = mknode(3,sp,mul1,mul2); |
|
MKLIST(l,nd); |
|
*rp = (Obj)l; |
|
} else { |
|
*rp = (Obj)sp; |
|
} |
} |
} |
|
|
void Pdp_sp_mod(NODE arg,DP *rp) |
void Pdp_sp_mod(NODE arg,DP *rp) |
Line 1638 void Pdp_sp_mod(NODE arg,DP *rp) |
|
Line 2234 void Pdp_sp_mod(NODE arg,DP *rp) |
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
mod = QTOS((Q)ARG2(arg)); |
mod = ZTOS((Q)ARG2(arg)); |
dp_sp_mod(p1,p2,mod,rp); |
dp_sp_mod(p1,p2,mod,rp); |
} |
} |
|
|
Line 1704 void Pdp_td(NODE arg,Z *rp) |
|
Line 2300 void Pdp_td(NODE arg,Z *rp) |
|
if ( !p ) |
if ( !p ) |
*rp = 0; |
*rp = 0; |
else |
else |
STOQ(BDY(p)->dl->td,*rp); |
STOZ(BDY(p)->dl->td,*rp); |
} |
} |
|
|
|
void Pdpm_td(NODE arg,Z *rp) |
|
{ |
|
DPM p; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_td"); |
|
if ( !p ) |
|
*rp = 0; |
|
else |
|
STOZ(BDY(p)->dl->td,*rp); |
|
} |
|
|
void Pdp_sugar(NODE arg,Z *rp) |
void Pdp_sugar(NODE arg,Z *rp) |
{ |
{ |
DP p; |
DP p; |
Line 1715 void Pdp_sugar(NODE arg,Z *rp) |
|
Line 2322 void Pdp_sugar(NODE arg,Z *rp) |
|
if ( !p ) |
if ( !p ) |
*rp = 0; |
*rp = 0; |
else |
else |
STOQ(p->sugar,*rp); |
STOZ(p->sugar,*rp); |
} |
} |
|
|
void Pdp_initial_term(NODE arg,Obj *rp) |
void Pdp_initial_term(NODE arg,Obj *rp) |
Line 1783 void Pdp_set_sugar(NODE arg,Q *rp) |
|
Line 2390 void Pdp_set_sugar(NODE arg,Q *rp) |
|
if ( p && q) { |
if ( p && q) { |
asir_assert(p,O_DP,"dp_set_sugar"); |
asir_assert(p,O_DP,"dp_set_sugar"); |
asir_assert(q,O_N, "dp_set_sugar"); |
asir_assert(q,O_N, "dp_set_sugar"); |
i = QTOS(q); |
i = ZTOS(q); |
if (p->sugar < i) { |
if (p->sugar < i) { |
p->sugar = i; |
p->sugar = i; |
} |
} |
Line 1832 void Pdp_minp(NODE arg,LIST *rp) |
|
Line 2439 void Pdp_minp(NODE arg,LIST *rp) |
|
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
if ( !ARG1(arg) ) { |
if ( !ARG1(arg) ) { |
s = QTOS((Q)BDY(p)); p = NEXT(p); |
s = ZTOS((Q)BDY(p)); p = NEXT(p); |
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
ts = QTOS((Q)BDY(tp)); tp = NEXT(tp); |
ts = ZTOS((Q)BDY(tp)); tp = NEXT(tp); |
NEXTNODE(dd0,dd); |
NEXTNODE(dd0,dd); |
if ( ts < s ) { |
if ( ts < s ) { |
BDY(dd) = (pointer)minp; |
BDY(dd) = (pointer)minp; |
Line 1874 void Pdp_criB(NODE arg,LIST *rp) |
|
Line 2481 void Pdp_criB(NODE arg,LIST *rp) |
|
DL ts,ti,tj,lij,tdl; |
DL ts,ti,tj,lij,tdl; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg)); |
asir_assert(ARG1(arg),O_N,"dp_criB"); s = ZTOS((Q)ARG1(arg)); |
asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
if ( !d ) |
if ( !d ) |
*rp = (LIST)ARG0(arg); |
*rp = (LIST)ARG0(arg); |
Line 1884 void Pdp_criB(NODE arg,LIST *rp) |
|
Line 2491 void Pdp_criB(NODE arg,LIST *rp) |
|
NEWDL(tdl,n); |
NEWDL(tdl,n); |
for ( dd = 0; d; d = NEXT(d) ) { |
for ( dd = 0; d; d = NEXT(d) ) { |
ij = BDY((LIST)BDY(d)); |
ij = BDY((LIST)BDY(d)); |
i = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
i = ZTOS((Q)BDY(ij)); ij = NEXT(ij); |
j = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
j = ZTOS((Q)BDY(ij)); ij = NEXT(ij); |
lij = BDY((DP)BDY(ij))->dl; |
lij = BDY((DP)BDY(ij))->dl; |
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
Line 1906 void Pdp_nelim(NODE arg,Z *rp) |
|
Line 2513 void Pdp_nelim(NODE arg,Z *rp) |
|
{ |
{ |
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
dp_nelim = QTOS((Q)ARG0(arg)); |
dp_nelim = ZTOS((Q)ARG0(arg)); |
} |
} |
STOQ(dp_nelim,*rp); |
STOZ(dp_nelim,*rp); |
} |
} |
|
|
void Pdp_mag(NODE arg,Z *rp) |
void Pdp_mag(NODE arg,Z *rp) |
Line 1924 void Pdp_mag(NODE arg,Z *rp) |
|
Line 2531 void Pdp_mag(NODE arg,Z *rp) |
|
else { |
else { |
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
s += p_mag((P)m->c); |
s += p_mag((P)m->c); |
STOQ(s,*rp); |
STOZ(s,*rp); |
} |
} |
} |
} |
|
|
Line 1947 void Pdp_dehomo(NODE arg,DP *rp) |
|
Line 2554 void Pdp_dehomo(NODE arg,DP *rp) |
|
dp_dehomo((DP)ARG0(arg),rp); |
dp_dehomo((DP)ARG0(arg),rp); |
} |
} |
|
|
|
void dpm_homo(DPM a,DPM *b); |
|
void dpm_dehomo(DPM a,DPM *b); |
|
|
|
void Pdpm_homo(NODE arg,DPM *rp) |
|
{ |
|
asir_assert(ARG0(arg),O_DPM,"dpm_homo"); |
|
dpm_homo((DPM)ARG0(arg),rp); |
|
} |
|
|
|
void Pdpm_dehomo(NODE arg,DPM *rp) |
|
{ |
|
asir_assert(ARG0(arg),O_DPM,"dpm_dehomo"); |
|
dpm_dehomo((DPM)ARG0(arg),rp); |
|
} |
|
|
|
|
void Pdp_gr_flags(NODE arg,LIST *rp) |
void Pdp_gr_flags(NODE arg,LIST *rp) |
{ |
{ |
Obj name,value; |
Obj name,value; |
Line 1978 void Pdp_gr_print(NODE arg,Z *rp) |
|
Line 2601 void Pdp_gr_print(NODE arg,Z *rp) |
|
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
q = (Z)ARG0(arg); |
q = (Z)ARG0(arg); |
s = QTOS(q); |
s = ZTOS(q); |
switch ( s ) { |
switch ( s ) { |
case 0: |
case 0: |
DP_Print = 0; DP_PrintShort = 0; |
DP_Print = 0; DP_PrintShort = 0; |
Line 1995 void Pdp_gr_print(NODE arg,Z *rp) |
|
Line 2618 void Pdp_gr_print(NODE arg,Z *rp) |
|
} |
} |
} else { |
} else { |
if ( DP_Print ) { |
if ( DP_Print ) { |
STOQ(1,q); |
STOZ(1,q); |
} else if ( DP_PrintShort ) { |
} else if ( DP_PrintShort ) { |
STOQ(2,q); |
STOZ(2,q); |
} else |
} else |
q = 0; |
q = 0; |
} |
} |
Line 2091 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
Line 2714 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
homo_is_set = 1; |
homo_is_set = 1; |
} else if ( !strcmp(key,"trace") ) { |
} else if ( !strcmp(key,"trace") ) { |
m = (Z)value; |
m = (Z)value; |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
*modular = 0; |
*modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("parse_gr_option : too large modulus"); |
error("parse_gr_option : too large modulus"); |
else |
else |
*modular = QTOS(m); |
*modular = ZTOS(m); |
modular_is_set = 1; |
modular_is_set = 1; |
} else if ( !strcmp(key,"dp") ) { |
} else if ( !strcmp(key,"dp") ) { |
/* XXX : ignore */ |
/* XXX : ignore */ |
Line 2132 void Pdp_gr_main(NODE arg,LIST *rp) |
|
Line 2755 void Pdp_gr_main(NODE arg,LIST *rp) |
|
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Z)ARG3(arg); |
m = (Z)ARG3(arg); |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("dp_gr_main : too large modulus"); |
error("dp_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = ZTOS(m); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( current_option ) |
} else if ( current_option ) |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
Line 2191 void Pdp_gr_f_main(NODE arg,LIST *rp) |
|
Line 2814 void Pdp_gr_f_main(NODE arg,LIST *rp) |
|
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
#if 0 |
#if 0 |
asir_assert(ARG3(arg),O_N,"dp_gr_f_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_f_main"); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
if ( m ) |
if ( m ) |
error("dp_gr_f_main : trace lifting is not implemented yet"); |
error("dp_gr_f_main : trace lifting is not implemented yet"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2243 void Pdp_gr_checklist(NODE arg,LIST *rp) |
|
Line 2866 void Pdp_gr_checklist(NODE arg,LIST *rp) |
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist"); |
asir_assert(ARG1(arg),O_N,"dp_gr_checklist"); |
asir_assert(ARG1(arg),O_N,"dp_gr_checklist"); |
n = QTOS((Q)ARG1(arg)); |
n = ZTOS((Q)ARG1(arg)); |
gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp); |
gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp); |
r = mknode(2,g,dp); |
r = mknode(2,g,dp); |
MKLIST(*rp,r); |
MKLIST(*rp,r); |
Line 2259 void Pdp_f4_mod_main(NODE arg,LIST *rp) |
|
Line 2882 void Pdp_f4_mod_main(NODE arg,LIST *rp) |
|
asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_mod_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(arg)); |
f = remove_zero_from_list(f); |
f = remove_zero_from_list(f); |
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
Line 2287 void Pdp_gr_mod_main(NODE arg,LIST *rp) |
|
Line 2910 void Pdp_gr_mod_main(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg)); |
if ( !m ) |
if ( !m ) |
error("dp_gr_mod_main : invalid argument"); |
error("dp_gr_mod_main : invalid argument"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2319 void Pnd_f4(NODE arg,LIST *rp) |
|
Line 2942 void Pnd_f4(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ((unsigned long)0x40000000,z); |
STOZ((unsigned long)0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2334 void Pnd_f4(NODE arg,LIST *rp) |
|
Line 2957 void Pnd_f4(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
} else |
} else |
Line 2364 void Pnd_gr(NODE arg,LIST *rp) |
|
Line 2987 void Pnd_gr(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2378 void Pnd_gr(NODE arg,LIST *rp) |
|
Line 3001 void Pnd_gr(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
} else |
} else |
error("nd_gr : invalid argument"); |
error("nd_gr : invalid argument"); |
Line 2404 void Pnd_gr_postproc(NODE arg,LIST *rp) |
|
Line 3027 void Pnd_gr_postproc(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_check = ARG4(arg) ? 1 : 0; |
do_check = ARG4(arg) ? 1 : 0; |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
Line 2427 void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
|
Line 3050 void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
|
asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace"); |
asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace"); |
asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
tlist = (LIST)ARG4(arg); |
tlist = (LIST)ARG4(arg); |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
Line 2451 void Pnd_btog(NODE arg,Obj *rp) |
|
Line 3074 void Pnd_btog(NODE arg,Obj *rp) |
|
asir_assert(ARG2(arg),O_N,"nd_btog"); |
asir_assert(ARG2(arg),O_N,"nd_btog"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,(Obj *)&val); |
Psetmod_ff(node,(Obj *)&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
tlist = (LIST)ARG4(arg); |
tlist = (LIST)ARG4(arg); |
if ( (ac = argc(arg)) == 6 ) { |
if ( (ac = argc(arg)) == 6 ) { |
asir_assert(ARG5(arg),O_N,"nd_btog"); |
asir_assert(ARG5(arg),O_N,"nd_btog"); |
pos = QTOS((Q)ARG5(arg)); |
pos = ZTOS((Q)ARG5(arg)); |
*rp = nd_btog_one(f,v,m,ord,tlist,pos); |
*rp = nd_btog_one(f,v,m,ord,tlist,pos); |
} else if ( ac == 5 ) |
} else if ( ac == 5 ) |
*rp = nd_btog(f,v,m,ord,tlist); |
*rp = nd_btog(f,v,m,ord,tlist); |
Line 2485 void Pnd_weyl_gr_postproc(NODE arg,LIST *rp) |
|
Line 3108 void Pnd_weyl_gr_postproc(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_check = ARG4(arg) ? 1 : 0; |
do_check = ARG4(arg) ? 1 : 0; |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
Line 2496 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
Line 3119 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo,ac; |
int m,homo,ac; |
|
Obj val; |
|
int retdp; |
Num nhomo; |
Num nhomo; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
Line 2510 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
Line 3135 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_gr_trace : invalid argument"); |
error("nd_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
retdp = 0; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
nd_gr_trace(f,v,m,homo,retdp,0,ord,rp); |
} |
} |
|
|
void Pnd_f4_trace(NODE arg,LIST *rp) |
void Pnd_f4_trace(NODE arg,LIST *rp) |
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo,ac; |
int m,homo,ac; |
|
int retdp; |
|
Obj val; |
Num nhomo; |
Num nhomo; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
Line 2540 void Pnd_f4_trace(NODE arg,LIST *rp) |
|
Line 3169 void Pnd_f4_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_gr_trace : invalid argument"); |
error("nd_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
retdp = 0; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
nd_gr_trace(f,v,m,homo,retdp,1,ord,rp); |
} |
} |
|
|
void Pnd_weyl_gr(NODE arg,LIST *rp) |
void Pnd_weyl_gr(NODE arg,LIST *rp) |
Line 2571 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
Line 3202 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2579 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
Line 3210 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
} else |
} else |
error("nd_weyl_gr : invalid argument"); |
error("nd_weyl_gr : invalid argument"); |
Line 2590 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
Line 3221 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo,ac; |
int m,homo,ac,retdp; |
|
Obj val; |
Num nhomo; |
Num nhomo; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
Line 2605 void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
|
Line 3237 void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_weyl_gr_trace : invalid argument"); |
error("nd_weyl_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
retdp = 0; |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
nd_gr_trace(f,v,m,homo,retdp,0,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
Line 2635 void Pnd_nf(NODE arg,Obj *rp) |
|
Line 3269 void Pnd_nf(NODE arg,Obj *rp) |
|
} |
} |
v = (LIST)ARG2(arg); |
v = (LIST)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp); |
} |
} |
|
|
void Pnd_weyl_nf(NODE arg,Obj *rp) |
void Pnd_weyl_nf(NODE arg,Obj *rp) |
Line 2655 void Pnd_weyl_nf(NODE arg,Obj *rp) |
|
Line 3289 void Pnd_weyl_nf(NODE arg,Obj *rp) |
|
} |
} |
v = (LIST)ARG2(arg); |
v = (LIST)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp); |
} |
} |
|
|
/* for Weyl algebra */ |
/* for Weyl algebra */ |
Line 2682 void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
|
Line 3316 void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
|
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Z)ARG3(arg); |
m = (Z)ARG3(arg); |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("dp_weyl_gr_main : too large modulus"); |
error("dp_weyl_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = ZTOS(m); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( current_option ) |
} else if ( current_option ) |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
Line 2750 void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
|
Line 3384 void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(arg)); |
f = remove_zero_from_list(f); |
f = remove_zero_from_list(f); |
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
Line 2779 void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
|
Line 3413 void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg)); |
if ( !m ) |
if ( !m ) |
error("dp_weyl_gr_mod_main : invalid argument"); |
error("dp_weyl_gr_mod_main : invalid argument"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2821 void Pdp_set_weight(NODE arg,VECT *rp) |
|
Line 3455 void Pdp_set_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_dl_weight_vector[i] = QTOS((Q)v->body[i]); |
current_dl_weight_vector[i] = ZTOS((Q)v->body[i]); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
if ( current_dl_weight_vector[i] < 0 ) break; |
if ( current_dl_weight_vector[i] < 0 ) break; |
if ( i < n ) |
if ( i < n ) |
Line 2863 void Pdp_set_module_weight(NODE arg,VECT *rp) |
|
Line 3497 void Pdp_set_module_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_module_weight_vector[i] = QTOS((Q)v->body[i]); |
current_module_weight_vector[i] = ZTOS((Q)v->body[i]); |
*rp = v; |
*rp = v; |
} |
} |
} |
} |
Line 2954 void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
|
Line 3588 void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_weyl_weight_vector[i] = QTOS((Q)v->body[i]); |
current_weyl_weight_vector[i] = ZTOS((Q)v->body[i]); |
*rp = v; |
*rp = v; |
} |
} |
} |
} |
Line 3142 NODE sumi_criB(int nv,NODE d,DP *f,int m) |
|
Line 3776 NODE sumi_criB(int nv,NODE d,DP *f,int m) |
|
r0 = 0; |
r0 = 0; |
for ( ; d; d = NEXT(d) ) { |
for ( ; d; d = NEXT(d) ) { |
p = (LIST)BDY(d); |
p = (LIST)BDY(d); |
p0 = QTOS((Q)ARG0(BDY(p))); |
p0 = ZTOS((Q)ARG0(BDY(p))); |
p1 = QTOS((Q)ARG1(BDY(p))); |
p1 = ZTOS((Q)ARG1(BDY(p))); |
p2 = HDL((DP)ARG2(BDY(p))); |
p2 = HDL((DP)ARG2(BDY(p))); |
if(!_dl_redble(HDL((DP)f[m]),p2,nv) || |
if(!_dl_redble(HDL((DP)f[m]),p2,nv) || |
dl_equal(nv,lcm_of_DL(nv,HDL(f[p0]),HDL(f[m]),lcm),p2) || |
dl_equal(nv,lcm_of_DL(nv,HDL(f[p0]),HDL(f[m]),lcm),p2) || |
Line 3191 NODE sumi_criFMD(int nv,DP *f,int m) |
|
Line 3825 NODE sumi_criFMD(int nv,DP *f,int m) |
|
if ( k2 < nv ) { |
if ( k2 < nv ) { |
NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE; |
NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE; |
NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td; |
NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td; |
STOQ(i,iq); STOQ(m,mq); |
STOZ(i,iq); STOZ(m,mq); |
nd = mknode(3,iq,mq,u); |
nd = mknode(3,iq,mq,u); |
MKLIST(list,nd); |
MKLIST(list,nd); |
MKNODE(r1,list,r); |
MKNODE(r1,list,r); |
Line 3353 void Psumi_symbolic(NODE arg,LIST *rp) |
|
Line 3987 void Psumi_symbolic(NODE arg,LIST *rp) |
|
int q,simp; |
int q,simp; |
|
|
l = BDY((LIST)ARG0(arg)); |
l = BDY((LIST)ARG0(arg)); |
q = QTOS((Q)ARG1(arg)); |
q = ZTOS((Q)ARG1(arg)); |
f2 = BDY((LIST)ARG2(arg)); |
f2 = BDY((LIST)ARG2(arg)); |
g = (DP *)BDY((VECT)ARG3(arg)); |
g = (DP *)BDY((VECT)ARG3(arg)); |
simp = QTOS((Q)ARG4(arg)); |
simp = ZTOS((Q)ARG4(arg)); |
*rp = sumi_symbolic(l,q,f2,g,simp); |
*rp = sumi_symbolic(l,q,f2,g,simp); |
} |
} |
|
|
Line 3368 void Psumi_updatepairs(NODE arg,LIST *rp) |
|
Line 4002 void Psumi_updatepairs(NODE arg,LIST *rp) |
|
|
|
d = (LIST)ARG0(arg); |
d = (LIST)ARG0(arg); |
f = (DP *)BDY((VECT)ARG1(arg)); |
f = (DP *)BDY((VECT)ARG1(arg)); |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
*rp = sumi_updatepairs(d,f,m); |
*rp = sumi_updatepairs(d,f,m); |
} |
} |
|
|
Line 3423 void Pdpv_ord(NODE arg,Obj *rp) |
|
Line 4057 void Pdpv_ord(NODE arg,Obj *rp) |
|
|
|
ac = argc(arg); |
ac = argc(arg); |
if ( ac ) { |
if ( ac ) { |
id = QTOS((Q)ARG0(arg)); |
id = ZTOS((Q)ARG0(arg)); |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
shift = (LIST)ARG1(arg); |
shift = (LIST)ARG1(arg); |
else |
else |
Line 3433 void Pdpv_ord(NODE arg,Obj *rp) |
|
Line 4067 void Pdpv_ord(NODE arg,Obj *rp) |
|
*rp = dp_current_modspec->obj; |
*rp = dp_current_modspec->obj; |
} |
} |
|
|
extern int dpm_ispot; |
extern int dpm_ordtype; |
|
extern DMMstack dmm_stack; |
|
|
void Pdpm_ord(NODE arg,LIST *rp) |
void set_schreyer_order(LIST n); |
|
|
|
void Pdpm_set_schreyer(NODE arg,LIST *rp) |
{ |
{ |
Z q; |
if ( argc(arg) ) { |
NODE nd; |
set_schreyer_order(ARG0(arg)?(LIST)ARG0(arg):0); |
struct order_spec *spec; |
|
|
|
if ( arg ) { |
|
nd = BDY((LIST)ARG0(arg)); |
|
if ( !create_order_spec(0,(Obj)ARG1(nd),&spec) ) |
|
error("dpm_ord : invalid order specification"); |
|
initdpm(spec,QTOS((Q)ARG0(nd))); |
|
} |
} |
STOQ(dpm_ispot,q); |
if ( dmm_stack ) |
nd = mknode(2,q,dp_current_spec->obj); |
*rp = dmm_stack->obj; |
MKLIST(*rp,nd); |
else |
|
*rp = 0; |
} |
} |
|
|
|
DMMstack_array Schreyer_Frame; |
|
DMMstack_array dpm_schreyer_frame(NODE n); |
|
void set_schreyer_level(DMMstack_array array,int level); |
|
|
|
void Pdpm_set_schreyer_level(NODE arg,Q *rp) |
|
{ |
|
set_schreyer_level(Schreyer_Frame,ZTOS((Q)ARG0(arg))); |
|
*rp = (Q)ARG0(arg); |
|
} |
|
|
|
DPM dmmtodpm(DMM d) |
|
{ |
|
} |
|
|
|
void Pdpm_schreyer_frame(NODE arg,LIST *rp) |
|
{ |
|
DMMstack_array a; |
|
DMMstack *body; |
|
DMM *in,*sum; |
|
DPM f,s; |
|
NODE b,b1,nd; |
|
LIST l; |
|
VECT v; |
|
Z lev,deg,ind; |
|
int len,i,nv,rank,j; |
|
|
|
Schreyer_Frame = a = dpm_schreyer_frame(BDY((LIST)ARG0(arg))); |
|
len = a->len; |
|
body = a->body; |
|
/* XXX */ |
|
nv = ((DPM)BDY(BDY((LIST)body[0]->obj)))->nv; |
|
b = 0; |
|
for ( i = 0; i < len; i++ ) { |
|
rank = body[i]->rank; |
|
in = body[i]->in; |
|
sum = body[i]->sum; |
|
MKVECT(v,rank+1); |
|
STOZ(i+1,lev); |
|
for ( j = 1; j <= rank; j++ ) { |
|
MKDPM(nv,in[j],f); f->sugar = in[j]->dl->td; |
|
MKDPM(nv,sum[j],s);s->sugar = sum[j]->dl->td; |
|
STOZ(s->sugar,deg); |
|
STOZ(j,ind); |
|
nd = mknode(5,f,s,ind,lev,deg); |
|
MKLIST(l,nd); |
|
BDY(v)[j] = (pointer)l; |
|
} |
|
MKNODE(b1,(pointer)v,b); |
|
b = b1; |
|
} |
|
MKLIST(l,b); |
|
*rp = l; |
|
} |
|
|
|
|
void Pdpm_hm(NODE arg,DPM *rp) |
void Pdpm_hm(NODE arg,DPM *rp) |
{ |
{ |
DPM p; |
DPM p; |
Line 3464 void Pdpm_ht(NODE arg,DPM *rp) |
|
Line 4150 void Pdpm_ht(NODE arg,DPM *rp) |
|
{ |
{ |
DPM p; |
DPM p; |
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dp_ht"); |
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_ht"); |
dpm_ht(p,rp); |
dpm_ht(p,rp); |
} |
} |
|
|
void Pdpm_hc(NODE arg,Obj *rp) |
void dpm_rest(DPM p,DPM *r); |
|
|
|
void Pdpm_rest(NODE arg,DPM *rp) |
{ |
{ |
|
DPM p; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_ht"); |
|
dpm_rest(p,rp); |
|
} |
|
|
|
|
|
void Pdpm_hp(NODE arg,Z *rp) |
|
{ |
|
DPM p; |
|
int pos; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_ht"); |
|
pos = BDY(p)->pos; |
|
STOZ(pos,*rp); |
|
} |
|
|
|
void dpm_shift(DPM p,int s,DPM *rp); |
|
|
|
void Pdpm_shift(NODE arg,DPM *rp) |
|
{ |
|
DPM p; |
|
int s; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_shift"); |
|
s = ZTOS((Z)ARG1(arg)); |
|
dpm_shift(p,s,rp); |
|
} |
|
|
|
void dpm_sort(DPM p,DPM *rp); |
|
|
|
void Pdpm_sort(NODE arg,DPM *rp) |
|
{ |
|
DPM p; |
|
int s; |
|
|
|
p = (DPM)ARG0(arg); |
|
if ( !p ) *rp = 0; |
|
else dpm_sort(p,rp); |
|
} |
|
|
|
void dpm_split(DPM p,int s,DPM *up,DPM *lo); |
|
void dpm_extract(DPM p,int s,DP *r); |
|
|
|
void Pdpm_split(NODE arg,LIST *rp) |
|
{ |
|
DPM p,up,lo; |
|
int s; |
|
NODE nd; |
|
|
|
p = (DPM)ARG0(arg); |
|
s = ZTOS((Z)ARG1(arg)); |
|
dpm_split(p,s,&up,&lo); |
|
nd = mknode(2,up,lo); |
|
MKLIST(*rp,nd); |
|
} |
|
|
|
void Pdpm_extract(NODE arg,DP *rp) |
|
{ |
|
DPM p; |
|
int s; |
|
|
|
p = (DPM)ARG0(arg); |
|
s = ZTOS((Z)ARG1(arg)); |
|
dpm_extract(p,s,rp); |
|
} |
|
|
|
|
|
void Pdpm_hc(NODE arg,DP *rp) |
|
{ |
|
DPM p; |
|
DP d; |
|
MP m; |
|
|
asir_assert(ARG0(arg),O_DPM,"dpm_hc"); |
asir_assert(ARG0(arg),O_DPM,"dpm_hc"); |
if ( !ARG0(arg) ) |
if ( !ARG0(arg) ) |
*rp = 0; |
*rp = 0; |
else |
else { |
*rp = BDY((DPM)ARG0(arg))->c; |
p = (DPM)ARG0(arg); |
|
NEWMP(m); |
|
m->dl = BDY(p)->dl; |
|
m->c = BDY(p)->c; |
|
NEXT(m) = 0; |
|
MKDP(NV(p),m,d); d->sugar = p->sugar; |
|
*rp = d; |
|
} |
} |
} |
|
|
|
|
void Pdpv_ht(NODE arg,LIST *rp) |
void Pdpv_ht(NODE arg,LIST *rp) |
{ |
{ |
NODE n; |
NODE n; |
Line 3493 void Pdpv_ht(NODE arg,LIST *rp) |
|
Line 4261 void Pdpv_ht(NODE arg,LIST *rp) |
|
ht = 0; |
ht = 0; |
else |
else |
dp_ht(BDY(p)[pos],&ht); |
dp_ht(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
Line 3513 void Pdpv_hm(NODE arg,LIST *rp) |
|
Line 4281 void Pdpv_hm(NODE arg,LIST *rp) |
|
ht = 0; |
ht = 0; |
else |
else |
dp_hm(BDY(p)[pos],&ht); |
dp_hm(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
Line 3533 void Pdpv_hc(NODE arg,LIST *rp) |
|
Line 4301 void Pdpv_hc(NODE arg,LIST *rp) |
|
hc = 0; |
hc = 0; |
else |
else |
hc = (P)BDY(BDY(p)[pos])->c; |
hc = (P)BDY(BDY(p)[pos])->c; |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,hc); |
n = mknode(2,q,hc); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
Line 3577 int dpv_hp(DPV p) |
|
Line 4345 int dpv_hp(DPV p) |
|
case ORD_LEX: |
case ORD_LEX: |
for ( i = 0; i < len; i++ ) |
for ( i = 0; i < len; i++ ) |
if ( e[i] ) return i; |
if ( e[i] ) return i; |
|
return -1; |
|
break; |
|
default: |
|
error("dpv_hp : unsupported term ordering"); |
return -1; |
return -1; |
break; |
break; |
} |
} |