| version 1.61, 2005/11/12 09:43:01 |
version 1.69, 2007/09/07 00:45:50 |
|
|
| * non-exclusive and royalty-free license to use, copy, modify and |
* non-exclusive and royalty-free license to use, copy, modify and |
| * redistribute, solely for non-commercial and non-profit purposes, the |
* redistribute, solely for non-commercial and non-profit purposes, the |
| * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and |
* computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and |
| * conditions of this Agreement. For the avoidance of doubt, you acquire |
* conditions of this Agreement. For the avoidance of doubt, you acquire * only a limited right to use the SOFTWARE hereunder, and FLL or any |
| * only a limited right to use the SOFTWARE hereunder, and FLL or any |
|
| * third party developer retains all rights, including but not limited to |
* third party developer retains all rights, including but not limited to |
| * copyrights, in and to the SOFTWARE. |
* copyrights, in and to the SOFTWARE. |
| * |
* |
|
|
| * 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/asir2000/builtin/dp.c,v 1.60 2005/08/25 18:59:11 ohara Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.68 2007/09/06 02:23:40 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "base.h" |
#include "base.h" |
|
|
| |
|
| 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(); |
void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize(); |
| void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble(); |
void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble(); |
| void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar(); |
void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar(); |
| void Pdp_set_sugar(); |
void Pdp_set_sugar(); |
| void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv(); |
void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv(); |
| void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat(); |
void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat(); |
| void Pdp_nf(),Pdp_true_nf(); |
void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(); |
| void Pdp_nf_mod(),Pdp_true_nf_mod(); |
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 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_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main(); |
void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main(); |
| void Pdp_gr_print(); |
void Pdp_gr_print(); |
| void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f(); |
void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f(); |
| Line 93 void Pdp_weyl_set_weight(); |
|
| Line 93 void Pdp_weyl_set_weight(); |
|
| void Pdp_set_weight(); |
void Pdp_set_weight(); |
| void Pdp_nf_f(),Pdp_weyl_nf_f(); |
void Pdp_nf_f(),Pdp_weyl_nf_f(); |
| void Pdp_lnf_f(); |
void Pdp_lnf_f(); |
| void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(); |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); |
| void Pnd_gr_postproc(); |
void Pnd_gr_postproc(); |
| void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
| void Pnd_nf(); |
void Pnd_nf(); |
| void Pdp_initial_term(); |
void Pdp_initial_term(); |
| void Pdp_order(); |
void Pdp_order(); |
| |
void Pdp_inv_or_split(); |
| |
void Pdp_compute_last_w(); |
| |
|
| LIST dp_initial_term(); |
LIST dp_initial_term(); |
| LIST dp_order(); |
LIST dp_order(); |
| Line 132 struct ftab dp_tab[] = { |
|
| Line 134 struct ftab dp_tab[] = { |
|
| {"dp_nf",Pdp_nf,4}, |
{"dp_nf",Pdp_nf,4}, |
| {"dp_nf_f",Pdp_nf_f,4}, |
{"dp_nf_f",Pdp_nf_f,4}, |
| {"dp_true_nf",Pdp_true_nf,4}, |
{"dp_true_nf",Pdp_true_nf,4}, |
| |
{"dp_true_nf_marked",Pdp_true_nf_marked,4}, |
| {"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
| {"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
| {"dp_lnf_mod",Pdp_lnf_mod,3}, |
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
| Line 141 struct ftab dp_tab[] = { |
|
| Line 144 struct ftab dp_tab[] = { |
|
| |
|
| /* Buchberger algorithm */ |
/* Buchberger algorithm */ |
| {"dp_gr_main",Pdp_gr_main,-5}, |
{"dp_gr_main",Pdp_gr_main,-5}, |
| |
{"dp_interreduce",Pdp_interreduce,3}, |
| {"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
{"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
| {"dp_gr_f_main",Pdp_gr_f_main,4}, |
{"dp_gr_f_main",Pdp_gr_f_main,4}, |
| {"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_gr_trace",Pnd_gr_trace,5}, |
{"nd_gr_trace",Pnd_gr_trace,5}, |
| |
{"nd_f4_trace",Pnd_f4_trace,5}, |
| {"nd_gr_postproc",Pnd_gr_postproc,5}, |
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
| {"nd_weyl_gr",Pnd_weyl_gr,4}, |
{"nd_weyl_gr",Pnd_weyl_gr,4}, |
| {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, |
{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, |
| Line 182 struct ftab dp_tab[] = { |
|
| Line 187 struct ftab dp_tab[] = { |
|
| {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
| |
|
| /* misc */ |
/* misc */ |
| |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
| {"dp_set_weight",Pdp_set_weight,-1}, |
{"dp_set_weight",Pdp_set_weight,-1}, |
| {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
| {0,0,0}, |
{0,0,0}, |
| Line 198 struct ftab dp_supp_tab[] = { |
|
| Line 204 struct ftab dp_supp_tab[] = { |
|
| {"dp_gr_print",Pdp_gr_print,-1}, |
{"dp_gr_print",Pdp_gr_print,-1}, |
| |
|
| /* converters */ |
/* converters */ |
| |
{"homogenize",Phomogenize,3}, |
| {"dp_ptod",Pdp_ptod,-2}, |
{"dp_ptod",Pdp_ptod,-2}, |
| {"dp_dtop",Pdp_dtop,2}, |
{"dp_dtop",Pdp_dtop,2}, |
| {"dp_homo",Pdp_homo,1}, |
{"dp_homo",Pdp_homo,1}, |
| Line 241 struct ftab dp_supp_tab[] = { |
|
| Line 248 struct ftab dp_supp_tab[] = { |
|
| {"dp_idiv",Pdp_idiv,2}, |
{"dp_idiv",Pdp_idiv,2}, |
| {"dp_tdiv",Pdp_tdiv,2}, |
{"dp_tdiv",Pdp_tdiv,2}, |
| {"dp_minp",Pdp_minp,2}, |
{"dp_minp",Pdp_minp,2}, |
| |
{"dp_compute_last_w",Pdp_compute_last_w,5}, |
| |
|
| {0,0,0} |
{0,0,0} |
| }; |
}; |
| |
|
| |
NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2); |
| |
|
| |
void Pdp_compute_last_w(NODE arg,LIST *rp) |
| |
{ |
| |
NODE g,gh,r; |
| |
VECT w,rv; |
| |
LIST l; |
| |
MAT w1,w2; |
| |
int row1,row2,i,j,n; |
| |
int *v; |
| |
int **m1,**m2; |
| |
Q q; |
| |
|
| |
g = (NODE)BDY((LIST)ARG0(arg)); |
| |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| |
w = (VECT)ARG2(arg); |
| |
w1 = (MAT)ARG3(arg); |
| |
w2 = (MAT)ARG4(arg); |
| |
n = w1->col; |
| |
row1 = w1->row; |
| |
row2 = w2->row; |
| |
if ( w ) { |
| |
v = W_ALLOC(n); |
| |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
| |
} else v = 0; |
| |
m1 = almat(row1,n); |
| |
for ( i = 0; i < row1; i++ ) |
| |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
| |
m2 = almat(row2,n); |
| |
for ( i = 0; i < row2; i++ ) |
| |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
| |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
| |
if ( !r ) *rp = 0; |
| |
else { |
| |
MKVECT(rv,n); |
| |
for ( i = 0; i < n; i++ ) { |
| |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
| |
} |
| |
MKLIST(l,r); |
| |
r = mknode(2,rv,l); |
| |
MKLIST(*rp,r); |
| |
} |
| |
} |
| |
|
| |
void Pdp_inv_or_split(arg,rp) |
| |
NODE arg; |
| |
Obj *rp; |
| |
{ |
| |
NODE gb,newgb; |
| |
DP f,inv; |
| |
struct order_spec *spec; |
| |
LIST list; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
| |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
| |
error("dp_inv_or_split : invalid order specification"); |
| |
gb = BDY((LIST)ARG0(arg)); |
| |
f = (DP)ARG1(arg); |
| |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
| |
if ( !newgb ) { |
| |
/* invertible */ |
| |
*rp = (Obj)inv; |
| |
} else { |
| |
MKLIST(list,newgb); |
| |
*rp = (Obj)list; |
| |
} |
| |
} |
| |
|
| void Pdp_sort(arg,rp) |
void Pdp_sort(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| ptod(CO,vl,p,rp); |
ptod(CO,vl,p,rp); |
| } |
} |
| |
|
| |
void Phomogenize(arg,rp) |
| |
NODE arg; |
| |
P *rp; |
| |
{ |
| |
P p; |
| |
DP d,h; |
| |
NODE n; |
| |
V hv; |
| |
VL vl,tvl,last; |
| |
struct oLIST f; |
| |
LIST v; |
| |
|
| |
asir_assert(ARG0(arg),O_P,"homogenize"); |
| |
p = (P)ARG0(arg); |
| |
asir_assert(ARG1(arg),O_LIST,"homogenize"); |
| |
v = (LIST)ARG1(arg); |
| |
asir_assert(ARG2(arg),O_P,"homogenize"); |
| |
hv = VR((P)ARG2(arg)); |
| |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| |
if ( !vl ) { |
| |
NEWVL(vl); tvl = vl; |
| |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) { |
| |
last = tvl; |
| |
NEXT(tvl) = 0; |
| |
} |
| |
ptod(CO,vl,p,&d); |
| |
dp_homo(d,&h); |
| |
NEWVL(NEXT(last)); last = NEXT(last); |
| |
VR(last) = hv; NEXT(last) = 0; |
| |
dtop(CO,vl,h,rp); |
| |
} |
| |
|
| void Pdp_ltod(arg,rp) |
void Pdp_ltod(arg,rp) |
| NODE arg; |
NODE arg; |
| DPV *rp; |
DPV *rp; |
|
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| |
void Pdp_true_nf_marked(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
NODE b,n; |
| |
DP *ps,*hps; |
| |
DP g; |
| |
DP nm; |
| |
Q cont; |
| |
P dn; |
| |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
| |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
nm = 0; dn = (P)ONE; |
| |
} else { |
| |
b = BDY((LIST)ARG0(arg)); |
| |
ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
hps = (DP *)BDY((VECT)ARG3(arg)); |
| |
dp_true_nf_marked(b,g,ps,hps,&nm,&cont,&dn); |
| |
} |
| |
n = mknode(3,nm,cont,dn); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| void Pdp_weyl_nf_mod(arg,rp) |
void Pdp_weyl_nf_mod(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| dp_gr_main(f,v,homo,modular,0,ord,rp); |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
| } |
} |
| |
|
| |
void Pdp_interreduce(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
VL vl; |
| |
int ac; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_interreduce"); |
| |
f = (LIST)ARG0(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( (ac = argc(arg)) == 3 ) { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_interreduce"); |
| |
v = (LIST)ARG1(arg); |
| |
create_order_spec(0,ARG2(arg),&ord); |
| |
} |
| |
dp_interreduce(f,v,0,ord,rp); |
| |
} |
| |
|
| void Pdp_gr_f_main(arg,rp) |
void Pdp_gr_f_main(arg,rp) |
| NODE arg; |
NODE arg; |
| LIST *rp; |
LIST *rp; |
|
|
| homo = QTOS((Q)ARG2(arg)); |
homo = QTOS((Q)ARG2(arg)); |
| m = QTOS((Q)ARG3(arg)); |
m = QTOS((Q)ARG3(arg)); |
| create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
| nd_gr_trace(f,v,m,homo,ord,rp); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
| } |
} |
| |
|
| |
void Pnd_f4_trace(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
| |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = QTOS((Q)ARG2(arg)); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
| |
} |
| |
|
| void Pnd_weyl_gr(arg,rp) |
void Pnd_weyl_gr(arg,rp) |
| NODE arg; |
NODE arg; |
| LIST *rp; |
LIST *rp; |
|
|
| homo = QTOS((Q)ARG2(arg)); |
homo = QTOS((Q)ARG2(arg)); |
| m = QTOS((Q)ARG3(arg)); |
m = QTOS((Q)ARG3(arg)); |
| create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
| nd_gr_trace(f,v,m,homo,ord,rp); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
| } |
} |
| |
|
| void Pnd_nf(arg,rp) |
void Pnd_nf(arg,rp) |