version 1.76, 2009/01/04 05:44:51 |
version 1.111, 2021/03/24 18:28:07 |
|
|
* 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 * only a limited right to use the SOFTWARE hereunder, and FLL or any |
* conditions of this Agreement. For the avoidance of doubt, you acquire |
|
* 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.75 2008/01/06 00:36:32 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.110 2020/10/04 03:14:07 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 56 extern int dp_order_pair_length; |
|
Line 57 extern int dp_order_pair_length; |
|
extern struct order_pair *dp_order_pair; |
extern struct order_pair *dp_order_pair; |
extern struct order_spec *dp_current_spec; |
extern struct order_spec *dp_current_spec; |
extern struct modorder_spec *dp_current_modspec; |
extern struct modorder_spec *dp_current_modspec; |
|
extern int nd_rref2; |
|
|
int do_weyl; |
extern int do_weyl; |
|
|
void Pdp_sort(); |
void Pdp_sort(); |
void Pdp_mul_trunc(),Pdp_quo(); |
void Pdp_mul_trunc(),Pdp_quo(); |
Line 68 void Pdp_set_sugar(); |
|
Line 70 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(),Pdp_true_nf_marked(),Pdp_true_nf_marked_mod(); |
void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(),Pdp_true_nf_marked_mod(); |
void Pdp_true_nf_and_quotient_marked(); |
|
|
void Pdp_true_nf_and_quotient(),Pdp_true_nf_and_quotient_mod(); |
|
void Pdp_true_nf_and_quotient_marked(),Pdp_true_nf_and_quotient_marked_mod(); |
|
|
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(); |
Line 83 void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), P |
|
Line 88 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_hm(),Pdpm_ht(),Pdpm_hc(); |
|
|
void Pdp_weyl_red(); |
void Pdp_weyl_red(); |
void Pdp_weyl_sp(); |
void Pdp_weyl_sp(); |
|
|
void Pdp_weyl_nf(),Pdp_weyl_nf_mod(); |
void Pdp_weyl_nf(),Pdp_weyl_nf_mod(); |
|
void Pdp_weyl_true_nf_and_quotient(),Pdp_weyl_true_nf_and_quotient_mod(); |
|
void Pdp_weyl_true_nf_and_quotient_marked(),Pdp_weyl_true_nf_and_quotient_marked_mod(); |
|
|
void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main(); |
void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main(); |
void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main(); |
void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main(); |
void Pdp_weyl_mul(),Pdp_weyl_mul_mod(); |
void Pdp_weyl_mul(),Pdp_weyl_mul_mod(),Pdp_weyl_act(); |
void Pdp_weyl_set_weight(); |
void Pdp_weyl_set_weight(); |
void Pdp_set_weight(),Pdp_set_top_weight(); |
void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight(); |
void Pdp_nf_f(),Pdp_weyl_nf_f(); |
void Pdp_nf_f(),Pdp_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_gr_postproc(), Pnd_weyl_gr_postproc(); |
void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); |
|
void Pnd_gr_recompute_trace(), Pnd_btog(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_nf(); |
void Pnd_nf(),Pnd_weyl_nf(); |
void Pdp_initial_term(); |
void Pdp_initial_term(); |
void Pdp_order(); |
void Pdp_order(); |
void Pdp_inv_or_split(); |
void Pdp_inv_or_split(); |
Line 105 void Pdp_compute_last_t(); |
|
Line 118 void Pdp_compute_last_t(); |
|
void Pdp_compute_last_w(); |
void Pdp_compute_last_w(); |
void Pdp_compute_essential_df(); |
void Pdp_compute_essential_df(); |
void Pdp_get_denomlist(); |
void Pdp_get_denomlist(); |
|
void Pdp_symb_add(); |
|
void Pdp_mono_raddec(); |
|
void Pdp_mono_reduce(); |
|
void Pdp_rref2(),Psumi_updatepairs(),Psumi_symbolic(); |
|
|
LIST dp_initial_term(); |
LIST dp_initial_term(); |
LIST dp_order(); |
LIST dp_order(); |
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); |
|
|
LIST remove_zero_from_list(LIST); |
LIST remove_zero_from_list(LIST); |
|
void dtodpm(DP d,int pos,DPM *dp); |
|
void dpm_nf_z(NODE b,DPM g,DPM *ps,int full,int multiple,DPM *rp); |
|
void dpm_nf_f(NODE b,DPM g,DPM *ps,int full,DPM *rp); |
|
void weyl_actd(VL vl,DP p1,DP p2,DP *pr); |
|
void dpm_sp(DPM p1,DPM p2,DPM *rp); |
|
void Psetmod_ff(); |
|
int get_opt(char *key0,Obj *r); |
|
void initdpm(struct order_spec *spec,int type); |
|
void dpm_hm(DPM p,DPM *rp); |
|
void dpm_ht(DPM p,DPM *rp); |
|
|
struct ftab dp_tab[] = { |
struct ftab dp_tab[] = { |
/* content reduction */ |
/* content reduction */ |
{"dp_ptozp",Pdp_ptozp,1}, |
{"dp_ptozp",Pdp_ptozp,1}, |
{"dp_ptozp2",Pdp_ptozp2,2}, |
{"dp_ptozp2",Pdp_ptozp2,2}, |
{"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}, |
|
|
/* polynomial ring */ |
/* polynomial ring */ |
/* special operations */ |
/* special operations */ |
{"dp_mul_trunc",Pdp_mul_trunc,3}, |
{"dp_mul_trunc",Pdp_mul_trunc,3}, |
{"dp_quo",Pdp_quo,2}, |
{"dp_quo",Pdp_quo,2}, |
|
|
/* s-poly */ |
/* s-poly */ |
{"dp_sp",Pdp_sp,2}, |
{"dp_sp",Pdp_sp,2}, |
{"dp_sp_mod",Pdp_sp_mod,3}, |
{"dp_sp_mod",Pdp_sp_mod,3}, |
|
|
/* m-reduction */ |
/* m-reduction */ |
{"dp_red",Pdp_red,3}, |
{"dp_red",Pdp_red,3}, |
{"dp_red_mod",Pdp_red_mod,4}, |
{"dp_red_mod",Pdp_red_mod,4}, |
|
|
/* normal form */ |
/* normal form */ |
{"dp_nf",Pdp_nf,4}, |
{"dp_nf",Pdp_nf,4}, |
{"dp_nf_f",Pdp_nf_f,4}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_true_nf",Pdp_true_nf,4}, |
{"dp_nf_f",Pdp_nf_f,4}, |
{"dp_true_nf_marked",Pdp_true_nf_marked,4}, |
{"dpm_nf_f",Pdpm_nf_f,4}, |
{"dp_true_nf_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4}, |
{"dpm_weyl_nf_f",Pdpm_weyl_nf_f,4}, |
{"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5}, |
{"dpm_nf",Pdpm_nf,4}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
{"dpm_sp",Pdpm_sp,2}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dpm_weyl_sp",Pdpm_weyl_sp,2}, |
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
|
{"dp_nf_tab_f",Pdp_nf_tab_f,2}, |
|
{"dp_nf_tab_mod",Pdp_nf_tab_mod,3}, |
|
{"dp_lnf_f",Pdp_lnf_f,2}, |
|
|
|
/* Buchberger algorithm */ |
{"dp_true_nf",Pdp_true_nf,4}, |
{"dp_gr_main",Pdp_gr_main,-5}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dp_interreduce",Pdp_interreduce,3}, |
{"dp_true_nf_marked",Pdp_true_nf_marked,4}, |
{"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
{"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5}, |
{"dp_gr_f_main",Pdp_gr_f_main,4}, |
|
{"dp_gr_checklist",Pdp_gr_checklist,2}, |
|
{"nd_f4",Pnd_f4,4}, |
|
{"nd_gr",Pnd_gr,4}, |
|
{"nd_gr_trace",Pnd_gr_trace,5}, |
|
{"nd_f4_trace",Pnd_f4_trace,5}, |
|
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
|
{"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, |
|
{"nd_weyl_gr",Pnd_weyl_gr,4}, |
|
{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, |
|
{"nd_nf",Pnd_nf,5}, |
|
|
|
/* F4 algorithm */ |
{"dp_true_nf_and_quotient",Pdp_true_nf_and_quotient,3}, |
{"dp_f4_main",Pdp_f4_main,3}, |
{"dp_true_nf_and_quotient_mod",Pdp_true_nf_and_quotient_mod,4}, |
{"dp_f4_mod_main",Pdp_f4_mod_main,4}, |
{"dp_true_nf_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4}, |
|
{"dp_true_nf_and_quotient_marked_mod",Pdp_true_nf_and_quotient_marked_mod,5}, |
|
|
|
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
|
{"dp_nf_tab_f",Pdp_nf_tab_f,2}, |
|
{"dp_nf_tab_mod",Pdp_nf_tab_mod,3}, |
|
{"dp_lnf_f",Pdp_lnf_f,2}, |
|
|
|
/* Buchberger algorithm */ |
|
{"dp_gr_main",Pdp_gr_main,-5}, |
|
{"dp_interreduce",Pdp_interreduce,3}, |
|
{"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
|
{"dp_gr_f_main",Pdp_gr_f_main,4}, |
|
{"dp_gr_checklist",Pdp_gr_checklist,2}, |
|
{"nd_f4",Pnd_f4,-4}, |
|
{"nd_gr",Pnd_gr,-4}, |
|
{"nd_gr_trace",Pnd_gr_trace,-5}, |
|
{"nd_f4_trace",Pnd_f4_trace,-5}, |
|
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
|
{"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5}, |
|
{"nd_btog",Pnd_btog,-6}, |
|
{"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, |
|
{"nd_weyl_gr",Pnd_weyl_gr,-4}, |
|
{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,-5}, |
|
{"nd_nf",Pnd_nf,5}, |
|
{"nd_weyl_nf",Pnd_weyl_nf,5}, |
|
|
|
/* F4 algorithm */ |
|
{"dp_f4_main",Pdp_f4_main,3}, |
|
{"dp_f4_mod_main",Pdp_f4_mod_main,4}, |
|
|
/* weyl algebra */ |
/* weyl algebra */ |
/* multiplication */ |
/* multiplication */ |
{"dp_weyl_mul",Pdp_weyl_mul,2}, |
{"dp_weyl_mul",Pdp_weyl_mul,2}, |
{"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3}, |
{"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3}, |
|
{"dp_weyl_act",Pdp_weyl_act,2}, |
|
|
/* s-poly */ |
/* s-poly */ |
{"dp_weyl_sp",Pdp_weyl_sp,2}, |
{"dp_weyl_sp",Pdp_weyl_sp,2}, |
|
|
/* m-reduction */ |
/* m-reduction */ |
{"dp_weyl_red",Pdp_weyl_red,3}, |
{"dp_weyl_red",Pdp_weyl_red,3}, |
|
|
/* normal form */ |
/* normal form */ |
{"dp_weyl_nf",Pdp_weyl_nf,4}, |
{"dp_weyl_nf",Pdp_weyl_nf,4}, |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
{"dpm_weyl_nf",Pdpm_weyl_nf,4}, |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
|
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
|
|
/* Buchberger algorithm */ |
{"dp_weyl_true_nf_and_quotient",Pdp_weyl_true_nf_and_quotient,3}, |
{"dp_weyl_gr_main",Pdp_weyl_gr_main,-5}, |
{"dp_weyl_true_nf_and_quotient_mod",Pdp_weyl_true_nf_and_quotient_mod,4}, |
{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5}, |
{"dp_weyl_true_nf_and_quotient_marked",Pdp_weyl_true_nf_and_quotient_marked,4}, |
{"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4}, |
{"dp_weyl_true_nf_and_quotient_marked_mod",Pdp_weyl_true_nf_and_quotient_marked_mod,5}, |
|
|
/* F4 algorithm */ |
|
{"dp_weyl_f4_main",Pdp_weyl_f4_main,3}, |
|
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
|
|
|
/* misc */ |
/* Buchberger algorithm */ |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
{"dp_weyl_gr_main",Pdp_weyl_gr_main,-5}, |
{"dp_set_weight",Pdp_set_weight,-1}, |
{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5}, |
{"dp_set_top_weight",Pdp_set_top_weight,-1}, |
{"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4}, |
{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
|
|
|
{"dp_get_denomlist",Pdp_get_denomlist,0}, |
/* F4 algorithm */ |
{0,0,0}, |
{"dp_weyl_f4_main",Pdp_weyl_f4_main,3}, |
|
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
|
|
|
/* misc */ |
|
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
|
{"dp_set_weight",Pdp_set_weight,-1}, |
|
{"dp_set_module_weight",Pdp_set_module_weight,-1}, |
|
{"dp_set_top_weight",Pdp_set_top_weight,-1}, |
|
{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
|
|
|
{"dp_get_denomlist",Pdp_get_denomlist,0}, |
|
{0,0,0}, |
}; |
}; |
|
|
struct ftab dp_supp_tab[] = { |
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}, |
{"dpv_ord",Pdpv_ord,-2}, |
{"dpm_ord",Pdpm_ord,-1}, |
{"dp_set_kara",Pdp_set_kara,-1}, |
{"dpv_ord",Pdpv_ord,-2}, |
{"dp_nelim",Pdp_nelim,-1}, |
{"dp_set_kara",Pdp_set_kara,-1}, |
{"dp_gr_flags",Pdp_gr_flags,-1}, |
{"dp_nelim",Pdp_nelim,-1}, |
{"dp_gr_print",Pdp_gr_print,-1}, |
{"dp_gr_flags",Pdp_gr_flags,-1}, |
|
{"dp_gr_print",Pdp_gr_print,-1}, |
|
|
/* converters */ |
/* converters */ |
{"homogenize",Phomogenize,3}, |
{"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}, |
{"dp_dehomo",Pdp_dehomo,1}, |
{"dp_dehomo",Pdp_dehomo,1}, |
{"dp_etov",Pdp_etov,1}, |
{"dp_etov",Pdp_etov,1}, |
{"dp_vtoe",Pdp_vtoe,1}, |
{"dp_vtoe",Pdp_vtoe,1}, |
{"dp_dtov",Pdp_dtov,1}, |
{"dp_dtov",Pdp_dtov,1}, |
{"dp_mdtod",Pdp_mdtod,1}, |
{"dp_mdtod",Pdp_mdtod,1}, |
{"dp_mod",Pdp_mod,3}, |
{"dp_mod",Pdp_mod,3}, |
{"dp_rat",Pdp_rat,1}, |
{"dp_rat",Pdp_rat,1}, |
{"dp_ltod",Pdp_ltod,-2}, |
{"dp_ltod",Pdp_ltod,-2}, |
|
|
/* criteria */ |
{"dpm_ltod",Pdpm_ltod,2}, |
{"dp_cri1",Pdp_cri1,2}, |
{"dpm_dtol",Pdpm_dtol,3}, |
{"dp_cri2",Pdp_cri2,2}, |
|
{"dp_criB",Pdp_criB,3}, |
|
|
|
/* simple operation */ |
/* criteria */ |
{"dp_subd",Pdp_subd,2}, |
{"dp_cri1",Pdp_cri1,2}, |
{"dp_lcm",Pdp_lcm,2}, |
{"dp_cri2",Pdp_cri2,2}, |
{"dp_hm",Pdp_hm,1}, |
{"dp_criB",Pdp_criB,3}, |
{"dp_ht",Pdp_ht,1}, |
|
{"dp_hc",Pdp_hc,1}, |
|
{"dpv_hm",Pdpv_hm,1}, |
|
{"dpv_ht",Pdpv_ht,1}, |
|
{"dpv_hc",Pdpv_hc,1}, |
|
{"dp_rest",Pdp_rest,1}, |
|
{"dp_initial_term",Pdp_initial_term,1}, |
|
{"dp_order",Pdp_order,1}, |
|
|
|
/* degree and size */ |
/* simple operation */ |
{"dp_td",Pdp_td,1}, |
{"dp_subd",Pdp_subd,2}, |
{"dp_mag",Pdp_mag,1}, |
{"dp_lcm",Pdp_lcm,2}, |
{"dp_sugar",Pdp_sugar,1}, |
{"dp_hm",Pdp_hm,1}, |
{"dp_set_sugar",Pdp_set_sugar,2}, |
{"dp_ht",Pdp_ht,1}, |
|
{"dp_hc",Pdp_hc,1}, |
|
{"dpv_hm",Pdpv_hm,1}, |
|
{"dpv_ht",Pdpv_ht,1}, |
|
{"dpv_hc",Pdpv_hc,1}, |
|
{"dpm_hm",Pdpm_hm,1}, |
|
{"dpm_ht",Pdpm_ht,1}, |
|
{"dpm_hc",Pdpm_hc,1}, |
|
{"dp_rest",Pdp_rest,1}, |
|
{"dp_initial_term",Pdp_initial_term,1}, |
|
{"dp_order",Pdp_order,1}, |
|
{"dp_symb_add",Pdp_symb_add,2}, |
|
|
/* misc */ |
/* degree and size */ |
{"dp_mbase",Pdp_mbase,1}, |
{"dp_td",Pdp_td,1}, |
{"dp_redble",Pdp_redble,2}, |
{"dp_mag",Pdp_mag,1}, |
{"dp_sep",Pdp_sep,2}, |
{"dp_sugar",Pdp_sugar,1}, |
{"dp_idiv",Pdp_idiv,2}, |
{"dp_set_sugar",Pdp_set_sugar,2}, |
{"dp_tdiv",Pdp_tdiv,2}, |
|
{"dp_minp",Pdp_minp,2}, |
|
{"dp_compute_last_w",Pdp_compute_last_w,5}, |
|
{"dp_compute_last_t",Pdp_compute_last_t,5}, |
|
{"dp_compute_essential_df",Pdp_compute_essential_df,2}, |
|
|
|
{0,0,0} |
/* misc */ |
|
{"dp_mbase",Pdp_mbase,1}, |
|
{"dp_redble",Pdp_redble,2}, |
|
{"dp_sep",Pdp_sep,2}, |
|
{"dp_idiv",Pdp_idiv,2}, |
|
{"dp_tdiv",Pdp_tdiv,2}, |
|
{"dp_minp",Pdp_minp,2}, |
|
{"dp_compute_last_w",Pdp_compute_last_w,5}, |
|
{"dp_compute_last_t",Pdp_compute_last_t,5}, |
|
{"dp_compute_essential_df",Pdp_compute_essential_df,2}, |
|
{"dp_mono_raddec",Pdp_mono_raddec,2}, |
|
{"dp_mono_reduce",Pdp_mono_reduce,2}, |
|
|
|
{"dp_rref2",Pdp_rref2,2}, |
|
{"sumi_updatepairs",Psumi_updatepairs,3}, |
|
{"sumi_symbolic",Psumi_symbolic,5}, |
|
|
|
{0,0,0} |
}; |
}; |
|
|
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); |
Line 270 Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NO |
|
Line 335 Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NO |
|
|
|
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; |
LIST hlist; |
LIST hlist; |
VECT v1,v2,w; |
VECT v1,v2,w; |
Q t; |
Q t; |
|
|
g = (NODE)BDY((LIST)ARG0(arg)); |
g = (NODE)BDY((LIST)ARG0(arg)); |
gh = (NODE)BDY((LIST)ARG1(arg)); |
gh = (NODE)BDY((LIST)ARG1(arg)); |
t = (Q)ARG2(arg); |
t = (Q)ARG2(arg); |
v1 = (VECT)ARG3(arg); |
v1 = (VECT)ARG3(arg); |
v2 = (VECT)ARG4(arg); |
v2 = (VECT)ARG4(arg); |
t = compute_last_t(g,gh,t,v1,v2,&homo,&w); |
t = compute_last_t(g,gh,t,v1,v2,&homo,&w); |
MKLIST(hlist,homo); |
MKLIST(hlist,homo); |
n = mknode(3,t,w,hlist); |
n = mknode(3,t,w,hlist); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_compute_last_w(NODE arg,LIST *rp) |
void Pdp_compute_last_w(NODE arg,LIST *rp) |
{ |
{ |
NODE g,gh,r; |
NODE g,gh,r; |
VECT w,rv; |
VECT w,rv; |
LIST l; |
LIST l; |
MAT w1,w2; |
MAT w1,w2; |
int row1,row2,i,j,n; |
int row1,row2,i,j,n; |
int *v; |
int *v; |
int **m1,**m2; |
int **m1,**m2; |
Q q; |
Q q; |
|
|
g = (NODE)BDY((LIST)ARG0(arg)); |
g = (NODE)BDY((LIST)ARG0(arg)); |
gh = (NODE)BDY((LIST)ARG1(arg)); |
gh = (NODE)BDY((LIST)ARG1(arg)); |
w = (VECT)ARG2(arg); |
w = (VECT)ARG2(arg); |
w1 = (MAT)ARG3(arg); |
w1 = (MAT)ARG3(arg); |
w2 = (MAT)ARG4(arg); |
w2 = (MAT)ARG4(arg); |
n = w1->col; |
n = w1->col; |
row1 = w1->row; |
row1 = w1->row; |
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] = QTOS((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] = QTOS((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] = QTOS((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; |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
} |
} |
MKLIST(l,r); |
MKLIST(l,r); |
r = mknode(2,rv,l); |
r = mknode(2,rv,l); |
MKLIST(*rp,r); |
MKLIST(*rp,r); |
} |
} |
} |
} |
|
|
NODE compute_essential_df(DP *g,DP *gh,int n); |
NODE compute_essential_df(DP *g,DP *gh,int n); |
|
|
void Pdp_compute_essential_df(NODE arg,LIST *rp) |
void Pdp_compute_essential_df(NODE arg,LIST *rp) |
{ |
{ |
VECT g,gh; |
VECT g,gh; |
NODE r; |
NODE r; |
|
|
g = (VECT)ARG0(arg); |
g = (VECT)ARG0(arg); |
gh = (VECT)ARG1(arg); |
gh = (VECT)ARG1(arg); |
r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len); |
r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len); |
MKLIST(*rp,r); |
MKLIST(*rp,r); |
} |
} |
|
|
void Pdp_inv_or_split(arg,rp) |
void Pdp_inv_or_split(NODE arg,Obj *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
NODE gb,newgb; |
NODE gb,newgb; |
DP f,inv; |
DP f,inv; |
struct order_spec *spec; |
struct order_spec *spec; |
LIST list; |
LIST list; |
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
error("dp_inv_or_split : invalid order specification"); |
error("dp_inv_or_split : invalid order specification"); |
gb = BDY((LIST)ARG0(arg)); |
gb = BDY((LIST)ARG0(arg)); |
f = (DP)ARG1(arg); |
f = (DP)ARG1(arg); |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
if ( !newgb ) { |
if ( !newgb ) { |
/* invertible */ |
/* invertible */ |
*rp = (Obj)inv; |
*rp = (Obj)inv; |
} else { |
} else { |
MKLIST(list,newgb); |
MKLIST(list,newgb); |
*rp = (Obj)list; |
*rp = (Obj)list; |
} |
} |
} |
} |
|
|
void Pdp_sort(arg,rp) |
void Pdp_sort(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
dp_sort((DP)ARG0(arg),rp); |
dp_sort((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_mdtod(arg,rp) |
void Pdp_mdtod(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
MP m,mr,mr0; |
MP m,mr,mr0; |
DP p; |
DP p; |
P t; |
P t; |
|
|
p = (DP)ARG0(arg); |
p = (DP)ARG0(arg); |
if ( !p ) |
if ( !p ) |
*rp = 0; |
*rp = 0; |
else { |
else { |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl; |
mptop((P)m->c,&t); NEXTMP(mr0,mr); mr->c = (Obj)t; mr->dl = m->dl; |
} |
} |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
} |
} |
} |
} |
|
|
void Pdp_sep(arg,rp) |
void Pdp_sep(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
DP p,r; |
DP p,r; |
MP m,t; |
MP m,t; |
MP *w0,*w; |
MP *w0,*w; |
int i,n,d,nv,sugar; |
int i,n,d,nv,sugar; |
VECT v; |
VECT v; |
pointer *pv; |
pointer *pv; |
|
|
p = (DP)ARG0(arg); m = BDY(p); |
p = (DP)ARG0(arg); m = BDY(p); |
d = QTOS((Q)ARG1(arg)); |
d = QTOS((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; |
MKVECT(v,d); *rp = v; |
MKVECT(v,d); *rp = v; |
pv = BDY(v); nv = p->nv; sugar = p->sugar; |
pv = BDY(v); nv = p->nv; sugar = p->sugar; |
w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP)); |
w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP)); |
w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP)); |
w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP)); |
for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) { |
for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) { |
NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl; |
NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl; |
} |
} |
for ( i = 0; i < d; i++ ) { |
for ( i = 0; i < d; i++ ) { |
NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar; |
NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar; |
pv[i] = (pointer)r; |
pv[i] = (pointer)r; |
} |
} |
} |
} |
|
|
void Pdp_idiv(arg,rp) |
void Pdp_idiv(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp); |
dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp); |
} |
} |
|
|
void Pdp_cont(arg,rp) |
void Pdp_cont(NODE arg,Q *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
dp_cont((DP)ARG0(arg),rp); |
dp_cont((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_dtov(arg,rp) |
void Pdp_dtov(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
dp_dtov((DP)ARG0(arg),rp); |
dp_dtov((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_mbase(arg,rp) |
void Pdp_mbase(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE mb; |
NODE mb; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_mbase"); |
asir_assert(ARG0(arg),O_LIST,"dp_mbase"); |
dp_mbase(BDY((LIST)ARG0(arg)),&mb); |
dp_mbase(BDY((LIST)ARG0(arg)),&mb); |
MKLIST(*rp,mb); |
MKLIST(*rp,mb); |
} |
} |
|
|
void Pdp_etov(arg,rp) |
void Pdp_etov(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
DP dp; |
DP dp; |
int n,i; |
int n,i; |
int *d; |
int *d; |
VECT v; |
VECT v; |
Q t; |
Q t; |
|
|
dp = (DP)ARG0(arg); |
dp = (DP)ARG0(arg); |
asir_assert(dp,O_DP,"dp_etov"); |
asir_assert(dp,O_DP,"dp_etov"); |
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; |
STOQ(d[i],t); v->body[i] = (pointer)t; |
} |
} |
*rp = v; |
*rp = v; |
} |
} |
|
|
void Pdp_vtoe(arg,rp) |
void Pdp_vtoe(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP dp; |
DP dp; |
DL dl; |
DL dl; |
MP m; |
MP m; |
int n,i,td; |
int n,i,td; |
int *d; |
int *d; |
VECT v; |
VECT v; |
|
|
v = (VECT)ARG0(arg); |
v = (VECT)ARG0(arg); |
asir_assert(v,O_VECT,"dp_vtoe"); |
asir_assert(v,O_VECT,"dp_vtoe"); |
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] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
} |
} |
dl->td = td; |
dl->td = td; |
NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0; |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
MKDP(n,m,dp); dp->sugar = td; |
MKDP(n,m,dp); dp->sugar = td; |
*rp = dp; |
*rp = dp; |
} |
} |
|
|
void Pdp_lnf_mod(arg,rp) |
void Pdp_lnf_mod(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
DP r1,r2; |
DP r1,r2; |
NODE b,g,n; |
NODE b,g,n; |
int mod; |
int mod; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod"); |
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 = QTOS((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; |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_lnf_f(arg,rp) |
void Pdp_lnf_f(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
DP r1,r2; |
DP r1,r2; |
NODE b,g,n; |
NODE b,g,n; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_lnf_f"); |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_f"); |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_f"); |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_f"); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2); |
dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&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; |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_nf_tab_mod(arg,rp) |
void Pdp_nf_tab_mod(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod"); |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod"); |
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); |
QTOS((Q)ARG2(arg)),rp); |
} |
} |
|
|
void Pdp_nf_tab_f(arg,rp) |
void Pdp_nf_tab_f(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f"); |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f"); |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f"); |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f"); |
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); |
} |
} |
|
|
void Pdp_ord(arg,rp) |
void Pdp_ord(NODE arg,Obj *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
struct order_spec *spec; |
struct order_spec *spec; |
LIST v; |
LIST v; |
struct oLIST f; |
struct oLIST f; |
Num homo; |
Num homo; |
int modular; |
int modular; |
|
|
f.id = O_LIST; f.body = 0; |
f.id = O_LIST; f.body = 0; |
if ( !arg && !current_option ) |
if ( !arg && !current_option ) |
*rp = dp_current_spec->obj; |
*rp = dp_current_spec->obj; |
else { |
else { |
if ( current_option ) |
if ( current_option ) |
parse_gr_option(&f,current_option,&v,&homo,&modular,&spec); |
parse_gr_option(&f,current_option,&v,&homo,&modular,&spec); |
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; |
} |
} |
} |
} |
|
|
void Pdp_ptod(arg,rp) |
void Pdp_ptod(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
P p; |
P p; |
NODE n; |
NODE n; |
VL vl,tvl; |
VL vl,tvl; |
struct oLIST f; |
struct oLIST f; |
int ac; |
int ac; |
LIST v; |
LIST v; |
Num homo; |
Num homo; |
int modular; |
int modular; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
asir_assert(ARG0(arg),O_P,"dp_ptod"); |
asir_assert(ARG0(arg),O_P,"dp_ptod"); |
p = (P)ARG0(arg); |
p = (P)ARG0(arg); |
ac = argc(arg); |
ac = argc(arg); |
if ( ac == 1 ) { |
if ( ac == 1 ) { |
if ( current_option ) { |
if ( current_option ) { |
f.id = O_LIST; f.body = mknode(1,p); |
f.id = O_LIST; f.body = mknode(1,p); |
parse_gr_option(&f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(&f,current_option,&v,&homo,&modular,&ord); |
initd(ord); |
initd(ord); |
} else |
} else |
error("dp_ptod : invalid argument"); |
error("dp_ptod : invalid argument"); |
} else { |
} else { |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
} |
} |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
if ( !vl ) { |
if ( !vl ) { |
NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
} else { |
} else { |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
} |
} |
VR(tvl) = VR((P)BDY(n)); |
VR(tvl) = VR((P)BDY(n)); |
} |
} |
if ( vl ) |
if ( vl ) |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
ptod(CO,vl,p,rp); |
ptod(CO,vl,p,rp); |
} |
} |
|
|
void Phomogenize(arg,rp) |
void Phomogenize(NODE arg,Obj *rp) |
NODE arg; |
|
P *rp; |
|
{ |
{ |
P p; |
P p; |
DP d,h; |
DP d,h; |
NODE n; |
NODE n; |
V hv; |
V hv; |
VL vl,tvl,last; |
VL vl,tvl,last; |
struct oLIST f; |
struct oLIST f; |
LIST v; |
LIST v; |
|
|
asir_assert(ARG0(arg),O_P,"homogenize"); |
asir_assert(ARG0(arg),O_P,"homogenize"); |
p = (P)ARG0(arg); |
p = (P)ARG0(arg); |
asir_assert(ARG1(arg),O_LIST,"homogenize"); |
asir_assert(ARG1(arg),O_LIST,"homogenize"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
asir_assert(ARG2(arg),O_P,"homogenize"); |
asir_assert(ARG2(arg),O_P,"homogenize"); |
hv = VR((P)ARG2(arg)); |
hv = VR((P)ARG2(arg)); |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
if ( !vl ) { |
if ( !vl ) { |
NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
} else { |
} else { |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
} |
} |
VR(tvl) = VR((P)BDY(n)); |
VR(tvl) = VR((P)BDY(n)); |
} |
} |
if ( vl ) { |
if ( vl ) { |
last = tvl; |
last = tvl; |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
} |
} |
ptod(CO,vl,p,&d); |
ptod(CO,vl,p,&d); |
dp_homo(d,&h); |
dp_homo(d,&h); |
NEWVL(NEXT(last)); last = NEXT(last); |
NEWVL(NEXT(last)); last = NEXT(last); |
VR(last) = hv; NEXT(last) = 0; |
VR(last) = hv; NEXT(last) = 0; |
dtop(CO,vl,h,rp); |
dtop(CO,vl,h,rp); |
} |
} |
|
|
void Pdp_ltod(arg,rp) |
void Pdp_ltod(NODE arg,DPV *rp) |
NODE arg; |
|
DPV *rp; |
|
{ |
{ |
NODE n; |
NODE n; |
VL vl,tvl; |
VL vl,tvl; |
LIST f,v; |
LIST f,v; |
int sugar,i,len,ac,modular; |
int sugar,i,len,ac,modular; |
Num homo; |
Num homo; |
struct order_spec *ord; |
struct order_spec *ord; |
DP *e; |
DP *e; |
NODE nd,t; |
NODE nd,t; |
|
|
ac = argc(arg); |
ac = argc(arg); |
asir_assert(ARG0(arg),O_LIST,"dp_ptod"); |
asir_assert(ARG0(arg),O_LIST,"dp_ptod"); |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
if ( ac == 1 ) { |
if ( ac == 1 ) { |
if ( current_option ) { |
if ( current_option ) { |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
initd(ord); |
initd(ord); |
} else |
} else |
error("dp_ltod : invalid argument"); |
error("dp_ltod : invalid argument"); |
} else { |
} else { |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
} |
} |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
if ( !vl ) { |
if ( !vl ) { |
NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
} else { |
} else { |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
} |
} |
VR(tvl) = VR((P)BDY(n)); |
VR(tvl) = VR((P)BDY(n)); |
} |
} |
if ( vl ) |
if ( vl ) |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
|
|
nd = BDY(f); |
nd = BDY(f); |
len = length(nd); |
len = length(nd); |
e = (DP *)MALLOC(len*sizeof(DP)); |
e = (DP *)MALLOC(len*sizeof(DP)); |
sugar = 0; |
sugar = 0; |
for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) { |
for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) { |
ptod(CO,vl,(P)BDY(t),&e[i]); |
ptod(CO,vl,(P)BDY(t),&e[i]); |
if ( e[i] ) |
if ( e[i] ) |
sugar = MAX(sugar,e[i]->sugar); |
sugar = MAX(sugar,e[i]->sugar); |
} |
} |
MKDPV(len,e,*rp); |
MKDPV(len,e,*rp); |
} |
} |
|
|
void Pdp_dtop(arg,rp) |
void Pdpm_ltod(NODE arg,DPM *rp) |
NODE arg; |
|
P *rp; |
|
{ |
{ |
NODE n; |
NODE n; |
VL vl,tvl; |
VL vl,tvl; |
|
LIST f,v; |
|
int i,len; |
|
NODE nd; |
|
NODE t; |
|
DP d; |
|
DPM s,u,w; |
|
|
asir_assert(ARG0(arg),O_DP,"dp_dtop"); |
f = (LIST)ARG0(arg); |
asir_assert(ARG1(arg),O_LIST,"dp_dtop"); |
v = (LIST)ARG1(arg); |
for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) { |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
if ( !vl ) { |
if ( !vl ) { |
NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
} else { |
} else { |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
} |
} |
VR(tvl) = VR((P)BDY(n)); |
VR(tvl) = VR((P)BDY(n)); |
} |
} |
if ( vl ) |
if ( vl ) |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
dtop(CO,vl,(DP)ARG0(arg),rp); |
|
|
nd = BDY(f); |
|
len = length(nd); |
|
for ( i = 0, t = nd, s = 0; i < len; i++, t = NEXT(t) ) { |
|
ptod(CO,vl,(P)BDY(t),&d); |
|
dtodpm(d,i,&u); |
|
adddpm(CO,s,u,&w); s = w; |
|
} |
|
*rp = s; |
} |
} |
|
|
|
void Pdpm_dtol(NODE arg,LIST *rp) |
|
{ |
|
DPM a; |
|
NODE nd,nd1; |
|
VL vl,tvl; |
|
int n,len,i,pos,nv; |
|
MP *w; |
|
DMM t; |
|
DMM *wa; |
|
MP m; |
|
DP u; |
|
Obj s; |
|
|
|
a = (DPM)ARG0(arg); |
|
for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) { |
|
if ( !vl ) { |
|
NEWVL(vl); tvl = vl; |
|
} else { |
|
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
|
} |
|
VR(tvl) = VR((P)BDY(nd)); |
|
} |
|
if ( vl ) |
|
NEXT(tvl) = 0; |
|
n = QTOS((Q)ARG2(arg)); |
|
w = (MP *)CALLOC(n,sizeof(MP)); |
|
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
|
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
|
for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) wa[i] = t; |
|
for ( i = len-1; i >= 0; i-- ) { |
|
NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]); |
|
pos = wa[i]->pos; |
|
NEXT(m) = w[pos]; |
|
w[pos] = m; |
|
} |
|
nd = 0; |
|
for ( i = n-1; i >= 0; i-- ) { |
|
MKDP(nv,w[i],u); u->sugar = a->sugar; /* XXX */ |
|
dtop(CO,vl,u,&s); |
|
MKNODE(nd1,s,nd); nd = nd1; |
|
} |
|
MKLIST(*rp,nd); |
|
} |
|
|
|
void Pdp_dtop(NODE arg,Obj *rp) |
|
{ |
|
NODE n; |
|
VL vl,tvl; |
|
|
|
asir_assert(ARG0(arg),O_DP,"dp_dtop"); |
|
asir_assert(ARG1(arg),O_LIST,"dp_dtop"); |
|
for ( vl = 0, n = BDY((LIST)ARG1(arg)); 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 ) |
|
NEXT(tvl) = 0; |
|
dtop(CO,vl,(DP)ARG0(arg),rp); |
|
} |
|
|
extern LIST Dist; |
extern LIST Dist; |
|
|
void Pdp_ptozp(arg,rp) |
void Pdp_ptozp(NODE arg,Obj *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
Q t; |
Q t; |
NODE tt,p; |
NODE tt,p; |
NODE n,n0; |
NODE n,n0; |
char *key; |
char *key; |
DP pp; |
DP pp; |
LIST list; |
LIST list; |
int get_factor=0; |
int get_factor=0; |
|
|
asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
|
|
/* analyze the option */ |
/* analyze the option */ |
if ( current_option ) { |
if ( current_option ) { |
|
|
} |
} |
} |
} |
|
|
dp_ptozp3((DP)ARG0(arg),&t,&pp); |
dp_ptozp3((DP)ARG0(arg),&t,&pp); |
|
|
/* printexpr(NULL,t); */ |
/* printexpr(NULL,t); */ |
/* if the option factor is given, then it returns the answer |
/* if the option factor is given, then it returns the answer |
in the format [zpoly, num] where num*zpoly is equal to the argument.*/ |
in the format [zpoly, num] where num*zpoly is equal to the argument.*/ |
if (get_factor) { |
if (get_factor) { |
n0 = mknode(2,pp,t); |
n0 = mknode(2,pp,t); |
MKLIST(list,n0); |
MKLIST(list,n0); |
*rp = (Obj)list; |
*rp = (Obj)list; |
} else |
} else |
*rp = (Obj)pp; |
*rp = (Obj)pp; |
} |
} |
|
|
void Pdp_ptozp2(arg,rp) |
void Pdp_ptozp2(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
DP p0,p1,h,r; |
DP p0,p1,h,r; |
NODE n0; |
NODE n0; |
|
|
p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
asir_assert(p0,O_DP,"dp_ptozp2"); |
asir_assert(p0,O_DP,"dp_ptozp2"); |
asir_assert(p1,O_DP,"dp_ptozp2"); |
asir_assert(p1,O_DP,"dp_ptozp2"); |
dp_ptozp2(p0,p1,&h,&r); |
dp_ptozp2(p0,p1,&h,&r); |
NEWNODE(n0); BDY(n0) = (pointer)h; |
NEWNODE(n0); BDY(n0) = (pointer)h; |
NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
NEXT(NEXT(n0)) = 0; |
NEXT(NEXT(n0)) = 0; |
MKLIST(*rp,n0); |
MKLIST(*rp,n0); |
} |
} |
|
|
void Pdp_prim(arg,rp) |
void Pdp_prim(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP t; |
DP t; |
|
|
asir_assert(ARG0(arg),O_DP,"dp_prim"); |
asir_assert(ARG0(arg),O_DP,"dp_prim"); |
dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
} |
} |
|
|
void Pdp_mod(arg,rp) |
void Pdp_mod(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p; |
DP p; |
int mod; |
int mod; |
NODE subst; |
NODE subst; |
|
|
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 = QTOS((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); |
} |
} |
|
|
void Pdp_rat(arg,rp) |
void Pdp_rat(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_rat"); |
asir_assert(ARG0(arg),O_DP,"dp_rat"); |
dp_rat((DP)ARG0(arg),rp); |
dp_rat((DP)ARG0(arg),rp); |
} |
} |
|
|
extern int DP_Multiple; |
extern int DP_Multiple; |
|
|
void Pdp_nf(arg,rp) |
void Pdp_nf(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
int full; |
int full; |
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
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)); ps = (DP *)BDY((VECT)ARG2(arg)); |
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); |
} |
} |
|
|
void Pdp_weyl_nf(arg,rp) |
void Pdp_weyl_nf(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
int full; |
int full; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf"); |
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)); ps = (DP *)BDY((VECT)ARG2(arg)); |
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); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
|
void Pdpm_nf(NODE arg,DP *rp) |
|
{ |
|
NODE b; |
|
DPM *ps; |
|
DPM g; |
|
int full; |
|
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
|
*rp = 0; return; |
|
} |
|
do_weyl = 0; dp_fcoeffs = 0; |
|
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
|
asir_assert(ARG1(arg),O_DPM,"dpm_nf"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
|
asir_assert(ARG3(arg),O_N,"dpm_nf"); |
|
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
|
full = (Q)ARG3(arg) ? 1 : 0; |
|
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
|
} |
|
|
|
void Pdpm_weyl_nf(NODE arg,DPM *rp) |
|
{ |
|
NODE b; |
|
DPM *ps; |
|
DPM g; |
|
int full; |
|
|
|
if ( !(g = (DPM)ARG1(arg)) ) { |
|
*rp = 0; return; |
|
} |
|
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf"); |
|
asir_assert(ARG1(arg),O_DPM,"dpm_weyl_nf"); |
|
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf"); |
|
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf"); |
|
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
|
full = (Q)ARG3(arg) ? 1 : 0; |
|
do_weyl = 1; |
|
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
|
do_weyl = 0; |
|
} |
|
|
/* nf computation using field operations */ |
/* nf computation using field operations */ |
|
|
void Pdp_nf_f(arg,rp) |
void Pdp_nf_f(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
int full; |
int full; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_f"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf_f"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_f"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_f"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_f"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_nf_f"); |
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)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
dp_nf_f(b,g,ps,full,rp); |
dp_nf_f(b,g,ps,full,rp); |
} |
} |
|
|
void Pdp_weyl_nf_f(arg,rp) |
void Pdp_weyl_nf_f(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE b; |
DP *ps; |
DP *ps; |
DP g; |
DP g; |
int full; |
int full; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f"); |
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)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
do_weyl = 1; |
do_weyl = 1; |
dp_nf_f(b,g,ps,full,rp); |
dp_nf_f(b,g,ps,full,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdp_nf_mod(arg,rp) |
void Pdpm_nf_f(NODE arg,DPM *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE b; |
DP g; |
DPM *ps; |
DP *ps; |
DPM g; |
int mod,full,ac; |
int full; |
NODE n,n0; |
|
|
|
do_weyl = 0; |
if ( !(g = (DPM)ARG1(arg)) ) { |
ac = argc(arg); |
*rp = 0; return; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
} |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dpm_nf_f"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
asir_assert(ARG1(arg),O_DPM,"dpm_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dpm_nf_f"); |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG3(arg),O_N,"dpm_nf_f"); |
if ( !(g = (DP)ARG1(arg)) ) { |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
*rp = 0; return; |
full = (Q)ARG3(arg) ? 1 : 0; |
} |
dpm_nf_f(b,g,ps,full,rp); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
|
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
|
for ( n0 = n = 0; b; b = NEXT(b) ) { |
|
NEXTNODE(n0,n); |
|
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
|
} |
|
if ( n0 ) |
|
NEXT(n) = 0; |
|
dp_nf_mod(n0,g,ps,mod,full,rp); |
|
} |
} |
|
|
void Pdp_true_nf(arg,rp) |
void Pdpm_weyl_nf_f(NODE arg,DPM *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE b,n; |
NODE b; |
DP *ps; |
DPM *ps; |
DP g; |
DPM g; |
DP nm; |
int full; |
P dn; |
|
int full; |
|
|
|
do_weyl = 0; dp_fcoeffs = 0; |
if ( !(g = (DPM)ARG1(arg)) ) { |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
*rp = 0; return; |
asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
} |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f"); |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
asir_assert(ARG1(arg),O_DP,"dpm_weyl_nf_f"); |
if ( !(g = (DP)ARG1(arg)) ) { |
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f"); |
nm = 0; dn = (P)ONE; |
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf_f"); |
} else { |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
do_weyl = 1; |
dp_true_nf(b,g,ps,full,&nm,&dn); |
dpm_nf_f(b,g,ps,full,rp); |
} |
do_weyl = 0; |
NEWNODE(n); BDY(n) = (pointer)nm; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
|
} |
} |
|
|
void Pdp_true_nf_marked(arg,rp) |
|
NODE arg; |
void Pdp_nf_mod(NODE arg,DP *rp) |
LIST *rp; |
|
{ |
{ |
NODE b,n; |
NODE b; |
DP *ps,*hps; |
DP g; |
DP g; |
DP *ps; |
DP nm; |
int mod,full,ac; |
Q cont; |
NODE n,n0; |
P dn; |
|
int full; |
|
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
ac = argc(arg); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
if ( !(g = (DP)ARG1(arg)) ) { |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
nm = 0; dn = (P)ONE; |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
} else { |
if ( !(g = (DP)ARG1(arg)) ) { |
b = BDY((LIST)ARG0(arg)); |
*rp = 0; return; |
ps = (DP *)BDY((VECT)ARG2(arg)); |
} |
hps = (DP *)BDY((VECT)ARG3(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
dp_true_nf_marked(b,g,ps,hps,&nm,&cont,&dn); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
} |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
n = mknode(3,nm,cont,dn); |
NEXTNODE(n0,n); |
MKLIST(*rp,n); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
|
} |
|
if ( n0 ) |
|
NEXT(n) = 0; |
|
dp_nf_mod(n0,g,ps,mod,full,rp); |
} |
} |
|
|
DP *dp_true_nf_and_quotient_marked (NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp); |
void Pdp_true_nf(NODE arg,LIST *rp) |
|
{ |
|
NODE b,n; |
|
DP *ps; |
|
DP g; |
|
DP nm; |
|
P dn; |
|
int full; |
|
|
void Pdp_true_nf_and_quotient_marked(arg,rp) |
do_weyl = 0; dp_fcoeffs = 0; |
NODE arg; |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
LIST *rp; |
asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
|
asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
|
asir_assert(ARG3(arg),O_N,"dp_nf"); |
|
if ( !(g = (DP)ARG1(arg)) ) { |
|
nm = 0; dn = (P)ONE; |
|
} else { |
|
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
|
full = (Q)ARG3(arg) ? 1 : 0; |
|
dp_true_nf(b,g,ps,full,&nm,&dn); |
|
} |
|
NEWNODE(n); BDY(n) = (pointer)nm; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
|
} |
|
|
|
DP *dp_true_nf_and_quotient_marked(NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp); |
|
|
|
void Pdp_true_nf_and_quotient_marked(NODE arg,LIST *rp) |
{ |
{ |
NODE b,n; |
NODE b,n; |
DP *ps,*hps; |
DP *ps,*hps; |
DP g; |
DP g; |
DP nm; |
DP nm; |
VECT quo; |
VECT quo; |
P dn; |
P dn; |
int full; |
int full; |
|
|
do_weyl = 0; dp_fcoeffs = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked"); |
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)); |
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)); |
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(b,g,ps,hps,&nm,&dn); |
quo->body = (pointer *)dp_true_nf_and_quotient_marked(b,g,ps,hps,&nm,&dn); |
} |
} |
n = mknode(3,nm,dn,quo); |
n = mknode(3,nm,dn,quo); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_true_nf_marked_mod(arg,rp) |
void Pdp_true_nf_and_quotient(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE b,n; |
NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg)); |
DP *ps,*hps; |
Pdp_true_nf_and_quotient_marked(narg,rp); |
DP g; |
} |
DP nm; |
|
P dn; |
|
int mod; |
|
|
|
do_weyl = 0; dp_fcoeffs = 0; |
|
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod"); |
DP *dp_true_nf_and_quotient_marked_mod (NODE b,DP g,DP *ps,DP *hps,int mod,DP *rp,P *dnp); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod"); |
|
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod"); |
void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp) |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod"); |
{ |
asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod"); |
NODE b,n; |
if ( !(g = (DP)ARG1(arg)) ) { |
DP *ps,*hps; |
nm = 0; dn = (P)ONE; |
DP g; |
} else { |
DP nm; |
b = BDY((LIST)ARG0(arg)); |
VECT quo; |
ps = (DP *)BDY((VECT)ARG2(arg)); |
P dn; |
hps = (DP *)BDY((VECT)ARG3(arg)); |
int full,mod; |
mod = QTOS((Q)ARG4(arg)); |
|
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
do_weyl = 0; dp_fcoeffs = 0; |
} |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked_mod"); |
n = mknode(2,nm,dn); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked_mod"); |
MKLIST(*rp,n); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG4(arg),O_N,"dp_true_nf_and_quotient_marked_mod"); |
|
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)); |
|
mod = QTOS((Q)ARG4(arg)); |
|
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); |
|
} |
|
n = mknode(3,nm,dn,quo); |
|
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_weyl_nf_mod(arg,rp) |
void Pdp_true_nf_and_quotient_mod(NODE arg,LIST *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
NODE b; |
NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg)); |
DP g; |
Pdp_true_nf_and_quotient_marked_mod(narg,rp); |
DP *ps; |
} |
int mod,full,ac; |
|
NODE n,n0; |
|
|
|
ac = argc(arg); |
void Pdp_true_nf_marked(NODE arg,LIST *rp) |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod"); |
{ |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod"); |
NODE b,n; |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod"); |
DP *ps,*hps; |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod"); |
DP g; |
asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod"); |
DP nm; |
if ( !(g = (DP)ARG1(arg)) ) { |
Q cont; |
*rp = 0; return; |
P dn; |
} |
int full; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
|
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
do_weyl = 0; dp_fcoeffs = 0; |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
NEXTNODE(n0,n); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
} |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
if ( n0 ) |
if ( !(g = (DP)ARG1(arg)) ) { |
NEXT(n) = 0; |
nm = 0; dn = (P)ONE; |
do_weyl = 1; |
} else { |
dp_nf_mod(n0,g,ps,mod,full,rp); |
b = BDY((LIST)ARG0(arg)); |
do_weyl = 0; |
ps = (DP *)BDY((VECT)ARG2(arg)); |
|
hps = (DP *)BDY((VECT)ARG3(arg)); |
|
dp_true_nf_marked(b,g,ps,hps,&nm,(P *)&cont,(P *)&dn); |
|
} |
|
n = mknode(3,nm,cont,dn); |
|
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_true_nf_mod(arg,rp) |
void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE b; |
NODE b,n; |
DP g,nm; |
DP *ps,*hps; |
P dn; |
DP g; |
DP *ps; |
DP nm; |
int mod,full; |
P dn; |
NODE n; |
int mod; |
|
|
do_weyl = 0; |
do_weyl = 0; dp_fcoeffs = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod"); |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod"); |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod"); |
if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
nm = 0; dn = (P)ONEM; |
nm = 0; dn = (P)ONE; |
} else { |
} else { |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
} |
mod = QTOS((Q)ARG4(arg)); |
NEWNODE(n); BDY(n) = (pointer)nm; |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
} |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
n = mknode(2,nm,dn); |
|
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_tdiv(arg,rp) |
void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
MP m,mr,mr0; |
NODE b; |
DP p; |
DP g; |
Q c; |
DP *ps; |
N d,q,r; |
int mod,full,ac; |
int sgn; |
NODE n,n0; |
|
|
asir_assert(ARG0(arg),O_DP,"dp_tdiv"); |
ac = argc(arg); |
asir_assert(ARG1(arg),O_N,"dp_tdiv"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod"); |
p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg)); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod"); |
if ( !p ) |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod"); |
*rp = 0; |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod"); |
else { |
asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod"); |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
divn(NM((Q)m->c),d,&q,&r); |
*rp = 0; return; |
if ( r ) { |
} |
*rp = 0; return; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
} else { |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c); |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
mr->c = (P)c; mr->dl = m->dl; |
NEXTNODE(n0,n); |
} |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
} |
} |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
if ( n0 ) |
} |
NEXT(n) = 0; |
|
do_weyl = 1; |
|
dp_nf_mod(n0,g,ps,mod,full,rp); |
|
do_weyl = 0; |
} |
} |
|
|
void Pdp_red_coef(arg,rp) |
void Pdp_true_nf_mod(NODE arg,LIST *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
MP m,mr,mr0; |
NODE b; |
P q,r; |
DP g,nm; |
DP p; |
P dn; |
P mod; |
DP *ps; |
|
int mod,full; |
|
NODE n; |
|
|
p = (DP)ARG0(arg); mod = (P)ARG1(arg); |
do_weyl = 0; |
asir_assert(p,O_DP,"dp_red_coef"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(mod,O_P,"dp_red_coef"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
if ( !p ) |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
*rp = 0; |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
else { |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
divsrp(CO,m->c,mod,&q,&r); |
nm = 0; dn = (P)ONEM; |
if ( r ) { |
} else { |
NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
} |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
} |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
if ( mr0 ) { |
} |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
NEWNODE(n); BDY(n) = (pointer)nm; |
} else |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
*rp = 0; |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} |
|
} |
} |
|
|
void Pdp_redble(arg,rp) |
void Pdp_weyl_true_nf_and_quotient_marked(NODE arg,LIST *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_redble"); |
NODE b,n; |
asir_assert(ARG1(arg),O_DP,"dp_redble"); |
DP *ps,*hps; |
if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) ) |
DP g; |
*rp = ONE; |
DP nm; |
else |
VECT quo; |
*rp = 0; |
P dn; |
|
int full; |
|
|
|
do_weyl = 1; dp_fcoeffs = 0; |
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_true_nf_and_quotient_marked"); |
|
asir_assert(ARG1(arg),O_DP,"dp_weyl_true_nf_and_quotient_marked"); |
|
asir_assert(ARG2(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked"); |
|
asir_assert(ARG3(arg),O_VECT,"dp_weyl_true_nf_and_quotient_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)); |
|
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
|
quo->body = (pointer *)dp_true_nf_and_quotient_marked(b,g,ps,hps,&nm,&dn); |
|
} |
|
n = mknode(3,nm,dn,quo); |
|
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_red_mod(arg,rp) |
void Pdp_weyl_true_nf_and_quotient(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
DP h,r; |
NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg)); |
P dmy; |
Pdp_weyl_true_nf_and_quotient_marked(narg,rp); |
NODE n; |
} |
|
|
do_weyl = 0; |
|
asir_assert(ARG0(arg),O_DP,"dp_red_mod"); |
void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp) |
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
{ |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
NODE b,n; |
asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
DP *ps,*hps; |
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)), |
DP g; |
&h,&r,&dmy); |
DP nm; |
NEWNODE(n); BDY(n) = (pointer)h; |
VECT quo; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
P dn; |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
int full,mod; |
|
|
|
do_weyl = 1; dp_fcoeffs = 0; |
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG1(arg),O_DP,"dp_weyl_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG2(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG3(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked_mod"); |
|
asir_assert(ARG4(arg),O_N,"dp_weyl_true_nf_and_quotient_marked_mod"); |
|
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)); |
|
mod = QTOS((Q)ARG4(arg)); |
|
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); |
|
} |
|
n = mknode(3,nm,dn,quo); |
|
MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_subd(arg,rp) |
void Pdp_weyl_true_nf_and_quotient_mod(NODE arg,LIST *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg)); |
|
Pdp_weyl_true_nf_and_quotient_marked_mod(narg,rp); |
|
} |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
|
asir_assert(p1,O_DP,"dp_subd"); |
void Pdp_tdiv(NODE arg,DP *rp) |
asir_assert(p2,O_DP,"dp_subd"); |
{ |
dp_subd(p1,p2,rp); |
MP m,mr,mr0; |
|
DP p; |
|
Q c; |
|
N d,q,r; |
|
int sgn; |
|
|
|
asir_assert(ARG0(arg),O_DP,"dp_tdiv"); |
|
asir_assert(ARG1(arg),O_N,"dp_tdiv"); |
|
p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg)); |
|
if ( !p ) |
|
*rp = 0; |
|
else { |
|
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
divn(NM((Q)m->c),d,&q,&r); |
|
if ( r ) { |
|
*rp = 0; return; |
|
} else { |
|
NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c); |
|
mr->c = (Obj)c; mr->dl = m->dl; |
|
} |
|
} |
|
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
} |
} |
} |
|
|
void Pdp_mul_trunc(arg,rp) |
void Pdp_red_coef(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2,p; |
MP m,mr,mr0; |
|
P q,r; |
|
DP p; |
|
P mod; |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg); |
p = (DP)ARG0(arg); mod = (P)ARG1(arg); |
asir_assert(p1,O_DP,"dp_mul_trunc"); |
asir_assert(p,O_DP,"dp_red_coef"); |
asir_assert(p2,O_DP,"dp_mul_trunc"); |
asir_assert(mod,O_P,"dp_red_coef"); |
asir_assert(p,O_DP,"dp_mul_trunc"); |
if ( !p ) |
comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp); |
*rp = 0; |
|
else { |
|
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
divsrp(CO,(P)m->c,mod,&q,&r); |
|
if ( r ) { |
|
NEXTMP(mr0,mr); mr->c = (Obj)r; mr->dl = m->dl; |
|
} |
|
} |
|
if ( mr0 ) { |
|
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
} else |
|
*rp = 0; |
|
} |
} |
} |
|
|
void Pdp_quo(arg,rp) |
void Pdp_redble(NODE arg,Q *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
asir_assert(ARG0(arg),O_DP,"dp_redble"); |
|
asir_assert(ARG1(arg),O_DP,"dp_redble"); |
|
if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) ) |
|
*rp = ONE; |
|
else |
|
*rp = 0; |
|
} |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
void Pdp_red_mod(NODE arg,LIST *rp) |
asir_assert(p1,O_DP,"dp_quo"); |
{ |
asir_assert(p2,O_DP,"dp_quo"); |
DP h,r; |
comm_quod(CO,p1,p2,rp); |
P dmy; |
|
NODE n; |
|
|
|
do_weyl = 0; |
|
asir_assert(ARG0(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(ARG3(arg),O_N,"dp_red_mod"); |
|
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)), |
|
&h,&r,&dmy); |
|
NEWNODE(n); BDY(n) = (pointer)h; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_weyl_mul(arg,rp) |
void Pdp_subd(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
DP p1,p2; |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul"); |
asir_assert(p1,O_DP,"dp_subd"); |
do_weyl = 1; |
asir_assert(p2,O_DP,"dp_subd"); |
muld(CO,p1,p2,rp); |
dp_subd(p1,p2,rp); |
do_weyl = 0; |
|
} |
} |
|
|
void Pdp_weyl_mul_mod(arg,rp) |
void Pdp_symb_add(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
DP p1,p2,r; |
Q m; |
NODE s0; |
|
MP mp0,mp; |
|
int nv; |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_weyl_mul_mod"); |
asir_assert(p1,O_DP,"dp_symb_add"); |
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(p2,O_DP,"dp_symb_add"); |
asir_assert(m,O_N,"dp_mul_mod"); |
if ( !p1 ) { *rp = p2; return; } |
do_weyl = 1; |
else if ( !p2 ) { *rp = p1; return; } |
mulmd(CO,QTOS(m),p1,p2,rp); |
if ( p1->nv != p2->nv ) |
do_weyl = 0; |
error("dp_sumb_add : invalid input"); |
|
nv = p1->nv; |
|
s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv); |
|
for ( mp0 = 0; s0; s0 = NEXT(s0) ) { |
|
NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (Obj)ONE; |
|
} |
|
NEXT(mp) = 0; |
|
MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar); |
|
*rp = r; |
} |
} |
|
|
void Pdp_red(arg,rp) |
void Pdp_mul_trunc(NODE arg,DP *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE n; |
DP p1,p2,p; |
DP head,rest,dmy1; |
|
P dmy; |
|
|
|
do_weyl = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg); |
asir_assert(ARG0(arg),O_DP,"dp_red"); |
asir_assert(p1,O_DP,"dp_mul_trunc"); |
asir_assert(ARG1(arg),O_DP,"dp_red"); |
asir_assert(p2,O_DP,"dp_mul_trunc"); |
asir_assert(ARG2(arg),O_DP,"dp_red"); |
asir_assert(p,O_DP,"dp_mul_trunc"); |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp); |
NEWNODE(n); BDY(n) = (pointer)head; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
|
} |
} |
|
|
void Pdp_weyl_red(arg,rp) |
void Pdp_quo(NODE arg,DP *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE n; |
DP p1,p2; |
DP head,rest,dmy1; |
|
P dmy; |
|
|
|
asir_assert(ARG0(arg),O_DP,"dp_weyl_red"); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_red"); |
asir_assert(p1,O_DP,"dp_quo"); |
asir_assert(ARG2(arg),O_DP,"dp_weyl_red"); |
asir_assert(p2,O_DP,"dp_quo"); |
do_weyl = 1; |
comm_quod(CO,p1,p2,rp); |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
|
do_weyl = 0; |
|
NEWNODE(n); BDY(n) = (pointer)head; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
|
} |
} |
|
|
void Pdp_sp(arg,rp) |
void Pdp_weyl_mul(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
DP p1,p2; |
|
|
do_weyl = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul"); |
asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
do_weyl = 1; |
dp_sp(p1,p2,rp); |
muld(CO,p1,p2,rp); |
|
do_weyl = 0; |
} |
} |
|
|
void Pdp_weyl_sp(arg,rp) |
void Pdp_weyl_act(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p1,p2; |
DP p1,p2; |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp"); |
asir_assert(p1,O_DP,"dp_weyl_act"); asir_assert(p2,O_DP,"dp_weyl_act"); |
do_weyl = 1; |
weyl_actd(CO,p1,p2,rp); |
dp_sp(p1,p2,rp); |
|
do_weyl = 0; |
|
} |
} |
|
|
void Pdp_sp_mod(arg,rp) |
|
NODE arg; |
void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
DP *rp; |
|
{ |
{ |
DP p1,p2; |
DP p1,p2; |
int mod; |
Q m; |
|
|
do_weyl = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_weyl_mul_mod"); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
asir_assert(m,O_N,"dp_mul_mod"); |
mod = QTOS((Q)ARG2(arg)); |
do_weyl = 1; |
dp_sp_mod(p1,p2,mod,rp); |
mulmd(CO,QTOS(m),p1,p2,rp); |
|
do_weyl = 0; |
} |
} |
|
|
void Pdp_lcm(arg,rp) |
void Pdp_red(NODE arg,LIST *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
int i,n,td; |
NODE n; |
DL d1,d2,d; |
DP head,rest,dmy1; |
MP m; |
P dmy; |
DP p1,p2; |
|
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
do_weyl = 0; |
asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm"); |
asir_assert(ARG0(arg),O_DP,"dp_red"); |
n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
asir_assert(ARG1(arg),O_DP,"dp_red"); |
NEWDL(d,n); |
asir_assert(ARG2(arg),O_DP,"dp_red"); |
for ( i = 0, td = 0; i < n; i++ ) { |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i); |
NEWNODE(n); BDY(n) = (pointer)head; |
} |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
d->td = td; |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
|
MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */ |
|
} |
} |
|
|
void Pdp_hm(arg,rp) |
void Pdp_weyl_red(NODE arg,LIST *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p; |
NODE n; |
|
DP head,rest,dmy1; |
|
P dmy; |
|
|
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm"); |
asir_assert(ARG0(arg),O_DP,"dp_weyl_red"); |
dp_hm(p,rp); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_red"); |
|
asir_assert(ARG2(arg),O_DP,"dp_weyl_red"); |
|
do_weyl = 1; |
|
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
|
do_weyl = 0; |
|
NEWNODE(n); BDY(n) = (pointer)head; |
|
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
|
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} |
} |
|
|
void Pdp_ht(arg,rp) |
void Pdp_sp(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
DP p; |
DP p1,p2; |
MP m,mr; |
|
|
|
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
do_weyl = 0; |
dp_ht(p,rp); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
|
asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
|
dp_sp(p1,p2,rp); |
} |
} |
|
|
void Pdp_hc(arg,rp) |
void Pdp_weyl_sp(NODE arg,DP *rp) |
NODE arg; |
|
P *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_hc"); |
DP p1,p2; |
if ( !ARG0(arg) ) |
|
*rp = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
else |
asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_weyl_sp"); |
*rp = BDY((DP)ARG0(arg))->c; |
do_weyl = 1; |
|
dp_sp(p1,p2,rp); |
|
do_weyl = 0; |
} |
} |
|
|
void Pdp_rest(arg,rp) |
void Pdpm_sp(NODE arg,DPM *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_rest"); |
DPM p1,p2; |
if ( !ARG0(arg) ) |
|
*rp = 0; |
do_weyl = 0; |
else |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
dp_rest((DP)ARG0(arg),rp); |
asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp"); |
|
dpm_sp(p1,p2,rp); |
} |
} |
|
|
void Pdp_td(arg,rp) |
void Pdpm_weyl_sp(NODE arg,DPM *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p; |
DPM p1,p2; |
|
|
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td"); |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
if ( !p ) |
asir_assert(p1,O_DPM,"dpm_weyl_sp"); asir_assert(p2,O_DPM,"dpm_weyl_sp"); |
*rp = 0; |
do_weyl = 1; |
else |
dpm_sp(p1,p2,rp); |
STOQ(BDY(p)->dl->td,*rp); |
do_weyl = 0; |
} |
} |
|
|
void Pdp_sugar(arg,rp) |
void Pdp_sp_mod(NODE arg,DP *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p; |
DP p1,p2; |
|
int mod; |
|
|
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar"); |
do_weyl = 0; |
if ( !p ) |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
*rp = 0; |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
else |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
STOQ(p->sugar,*rp); |
mod = QTOS((Q)ARG2(arg)); |
|
dp_sp_mod(p1,p2,mod,rp); |
} |
} |
|
|
void Pdp_initial_term(arg,rp) |
void Pdp_lcm(NODE arg,DP *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
struct order_spec *ord; |
int i,n,td; |
Num homo; |
DL d1,d2,d; |
int modular,is_list; |
MP m; |
LIST v,f,l,initiallist; |
DP p1,p2; |
NODE n; |
|
|
|
f = (LIST)ARG0(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
if ( f && OID(f) == O_LIST ) |
asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm"); |
is_list = 1; |
n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
else { |
NEWDL(d,n); |
n = mknode(1,f); MKLIST(l,n); f = l; |
for ( i = 0, td = 0; i < n; i++ ) { |
is_list = 0; |
d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i); |
} |
} |
if ( current_option ) { |
d->td = td; |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
NEWMP(m); m->dl = d; m->c = (Obj)ONE; NEXT(m) = 0; |
initd(ord); |
MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */ |
} else |
|
ord = dp_current_spec; |
|
initiallist = dp_initial_term(f,ord); |
|
if ( !is_list ) |
|
*rp = (Obj)BDY(BDY(initiallist)); |
|
else |
|
*rp = (Obj)initiallist; |
|
} |
} |
|
|
void Pdp_order(arg,rp) |
void Pdp_hm(NODE arg,DP *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
struct order_spec *ord; |
DP p; |
Num homo; |
|
int modular,is_list; |
|
LIST v,f,l,ordlist; |
|
NODE n; |
|
|
|
f = (LIST)ARG0(arg); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm"); |
if ( f && OID(f) == O_LIST ) |
dp_hm(p,rp); |
is_list = 1; |
|
else { |
|
n = mknode(1,f); MKLIST(l,n); f = l; |
|
is_list = 0; |
|
} |
|
if ( current_option ) { |
|
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
|
initd(ord); |
|
} else |
|
ord = dp_current_spec; |
|
ordlist = dp_order(f,ord); |
|
if ( !is_list ) |
|
*rp = (Obj)BDY(BDY(ordlist)); |
|
else |
|
*rp = (Obj)ordlist; |
|
} |
} |
|
|
void Pdp_set_sugar(arg,rp) |
void Pdp_ht(NODE arg,DP *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p; |
DP p; |
Q q; |
MP m,mr; |
int i; |
|
|
|
p = (DP)ARG0(arg); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
q = (Q)ARG1(arg); |
dp_ht(p,rp); |
if ( p && q) { |
|
asir_assert(p,O_DP,"dp_set_sugar"); |
|
asir_assert(q,O_N, "dp_set_sugar"); |
|
i = QTOS(q); |
|
if (p->sugar < i) { |
|
p->sugar = i; |
|
} |
|
} |
|
*rp = 0; |
|
} |
} |
|
|
void Pdp_cri1(arg,rp) |
void Pdp_hc(NODE arg,Obj *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p1,p2; |
asir_assert(ARG0(arg),O_DP,"dp_hc"); |
int *d1,*d2; |
if ( !ARG0(arg) ) |
int i,n; |
*rp = 0; |
|
else |
|
*rp = BDY((DP)ARG0(arg))->c; |
|
} |
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
void Pdp_rest(NODE arg,DP *rp) |
asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1"); |
{ |
n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d; |
asir_assert(ARG0(arg),O_DP,"dp_rest"); |
for ( i = 0; i < n; i++ ) |
if ( !ARG0(arg) ) |
if ( d1[i] > d2[i] ) |
*rp = 0; |
break; |
else |
*rp = i == n ? ONE : 0; |
dp_rest((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_cri2(arg,rp) |
void Pdp_td(NODE arg,Q *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p1,p2; |
DP p; |
int *d1,*d2; |
|
int i,n; |
|
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td"); |
asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2"); |
if ( !p ) |
n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d; |
*rp = 0; |
for ( i = 0; i < n; i++ ) |
else |
if ( MIN(d1[i],d2[i]) >= 1 ) |
STOQ(BDY(p)->dl->td,*rp); |
break; |
|
*rp = i == n ? ONE : 0; |
|
} |
} |
|
|
void Pdp_minp(arg,rp) |
void Pdp_sugar(NODE arg,Q *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE tn,tn1,d,dd,dd0,p,tp; |
DP p; |
LIST l,minp; |
|
DP lcm,tlcm; |
|
int s,ts; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"dp_minp"); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar"); |
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
if ( !p ) |
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
*rp = 0; |
if ( !ARG1(arg) ) { |
else |
s = QTOS((Q)BDY(p)); p = NEXT(p); |
STOQ(p->sugar,*rp); |
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
|
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
|
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
|
ts = QTOS((Q)BDY(tp)); tp = NEXT(tp); |
|
NEXTNODE(dd0,dd); |
|
if ( ts < s ) { |
|
BDY(dd) = (pointer)minp; |
|
minp = (LIST)BDY(d); lcm = tlcm; s = ts; |
|
} else if ( ts == s ) { |
|
if ( compd(CO,lcm,tlcm) > 0 ) { |
|
BDY(dd) = (pointer)minp; |
|
minp = (LIST)BDY(d); lcm = tlcm; s = ts; |
|
} else |
|
BDY(dd) = BDY(d); |
|
} else |
|
BDY(dd) = BDY(d); |
|
} |
|
} else { |
|
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
|
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
|
tlcm = (DP)BDY(tp); |
|
NEXTNODE(dd0,dd); |
|
if ( compd(CO,lcm,tlcm) > 0 ) { |
|
BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm; |
|
} else |
|
BDY(dd) = BDY(d); |
|
} |
|
} |
|
if ( dd0 ) |
|
NEXT(dd) = 0; |
|
MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1); |
|
} |
} |
|
|
void Pdp_criB(arg,rp) |
void Pdp_initial_term(NODE arg,Obj *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
NODE d,ij,dd,ddd; |
struct order_spec *ord; |
int i,j,s,n; |
Num homo; |
DP *ps; |
int modular,is_list; |
DL ts,ti,tj,lij,tdl; |
LIST v,f,l,initiallist; |
|
NODE n; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
f = (LIST)ARG0(arg); |
asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg)); |
if ( f && OID(f) == O_LIST ) |
asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
is_list = 1; |
if ( !d ) |
else { |
*rp = (LIST)ARG0(arg); |
n = mknode(1,f); MKLIST(l,n); f = l; |
else { |
is_list = 0; |
ts = BDY(ps[s])->dl; |
} |
n = ps[s]->nv; |
if ( current_option ) { |
NEWDL(tdl,n); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
for ( dd = 0; d; d = NEXT(d) ) { |
initd(ord); |
ij = BDY((LIST)BDY(d)); |
} else |
i = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
ord = dp_current_spec; |
j = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
initiallist = dp_initial_term(f,ord); |
lij = BDY((DP)BDY(ij))->dl; |
if ( !is_list ) |
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
*rp = (Obj)BDY(BDY(initiallist)); |
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
else |
|| !dl_equal(n,lij,tdl) |
*rp = (Obj)initiallist; |
|| (lij->td == lcm_of_DL(n,ti,ts,tdl)->td |
|
&& dl_equal(n,tdl,lij)) |
|
|| (lij->td == lcm_of_DL(n,tj,ts,tdl)->td |
|
&& dl_equal(n,tdl,lij)) ) { |
|
MKNODE(ddd,BDY(d),dd); |
|
dd = ddd; |
|
} |
|
} |
|
MKLIST(*rp,dd); |
|
} |
|
} |
} |
|
|
void Pdp_nelim(arg,rp) |
void Pdp_order(NODE arg,Obj *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
if ( arg ) { |
struct order_spec *ord; |
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
Num homo; |
dp_nelim = QTOS((Q)ARG0(arg)); |
int modular,is_list; |
} |
LIST v,f,l,ordlist; |
STOQ(dp_nelim,*rp); |
NODE n; |
|
|
|
f = (LIST)ARG0(arg); |
|
if ( f && OID(f) == O_LIST ) |
|
is_list = 1; |
|
else { |
|
n = mknode(1,f); MKLIST(l,n); f = l; |
|
is_list = 0; |
|
} |
|
if ( current_option ) { |
|
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
|
initd(ord); |
|
} else |
|
ord = dp_current_spec; |
|
ordlist = dp_order(f,ord); |
|
if ( !is_list ) |
|
*rp = (Obj)BDY(BDY(ordlist)); |
|
else |
|
*rp = (Obj)ordlist; |
} |
} |
|
|
void Pdp_mag(arg,rp) |
void Pdp_set_sugar(NODE arg,Q *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
DP p; |
DP p; |
int s; |
Q q; |
MP m; |
int i; |
|
|
p = (DP)ARG0(arg); |
p = (DP)ARG0(arg); |
asir_assert(p,O_DP,"dp_mag"); |
q = (Q)ARG1(arg); |
if ( !p ) |
if ( p && q) { |
*rp = 0; |
asir_assert(p,O_DP,"dp_set_sugar"); |
else { |
asir_assert(q,O_N, "dp_set_sugar"); |
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
i = QTOS(q); |
s += p_mag(m->c); |
if (p->sugar < i) { |
STOQ(s,*rp); |
p->sugar = i; |
} |
} |
|
} |
|
*rp = 0; |
} |
} |
|
|
|
void Pdp_cri1(NODE arg,Q *rp) |
|
{ |
|
DP p1,p2; |
|
int *d1,*d2; |
|
int i,n; |
|
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
|
asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1"); |
|
n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d; |
|
for ( i = 0; i < n; i++ ) |
|
if ( d1[i] > d2[i] ) |
|
break; |
|
*rp = i == n ? ONE : 0; |
|
} |
|
|
|
void Pdp_cri2(NODE arg,Q *rp) |
|
{ |
|
DP p1,p2; |
|
int *d1,*d2; |
|
int i,n; |
|
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
|
asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2"); |
|
n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d; |
|
for ( i = 0; i < n; i++ ) |
|
if ( MIN(d1[i],d2[i]) >= 1 ) |
|
break; |
|
*rp = i == n ? ONE : 0; |
|
} |
|
|
|
void Pdp_minp(NODE arg,LIST *rp) |
|
{ |
|
NODE tn,tn1,d,dd,dd0,p,tp; |
|
LIST l,minp; |
|
DP lcm,tlcm; |
|
int s,ts; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"dp_minp"); |
|
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
|
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
|
if ( !ARG1(arg) ) { |
|
s = QTOS((Q)BDY(p)); p = NEXT(p); |
|
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
|
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
|
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
|
ts = QTOS((Q)BDY(tp)); tp = NEXT(tp); |
|
NEXTNODE(dd0,dd); |
|
if ( ts < s ) { |
|
BDY(dd) = (pointer)minp; |
|
minp = (LIST)BDY(d); lcm = tlcm; s = ts; |
|
} else if ( ts == s ) { |
|
if ( compd(CO,lcm,tlcm) > 0 ) { |
|
BDY(dd) = (pointer)minp; |
|
minp = (LIST)BDY(d); lcm = tlcm; s = ts; |
|
} else |
|
BDY(dd) = BDY(d); |
|
} else |
|
BDY(dd) = BDY(d); |
|
} |
|
} else { |
|
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
|
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
|
tlcm = (DP)BDY(tp); |
|
NEXTNODE(dd0,dd); |
|
if ( compd(CO,lcm,tlcm) > 0 ) { |
|
BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm; |
|
} else |
|
BDY(dd) = BDY(d); |
|
} |
|
} |
|
if ( dd0 ) |
|
NEXT(dd) = 0; |
|
MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1); |
|
} |
|
|
|
void Pdp_criB(NODE arg,LIST *rp) |
|
{ |
|
NODE d,ij,dd,ddd; |
|
int i,j,s,n; |
|
DP *ps; |
|
DL ts,ti,tj,lij,tdl; |
|
|
|
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(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
|
if ( !d ) |
|
*rp = (LIST)ARG0(arg); |
|
else { |
|
ts = BDY(ps[s])->dl; |
|
n = ps[s]->nv; |
|
NEWDL(tdl,n); |
|
for ( dd = 0; d; d = NEXT(d) ) { |
|
ij = BDY((LIST)BDY(d)); |
|
i = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
|
j = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
|
lij = BDY((DP)BDY(ij))->dl; |
|
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
|
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
|
|| !dl_equal(n,lij,tdl) |
|
|| (lij->td == lcm_of_DL(n,ti,ts,tdl)->td |
|
&& dl_equal(n,tdl,lij)) |
|
|| (lij->td == lcm_of_DL(n,tj,ts,tdl)->td |
|
&& dl_equal(n,tdl,lij)) ) { |
|
MKNODE(ddd,BDY(d),dd); |
|
dd = ddd; |
|
} |
|
} |
|
MKLIST(*rp,dd); |
|
} |
|
} |
|
|
|
void Pdp_nelim(NODE arg,Q *rp) |
|
{ |
|
if ( arg ) { |
|
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
|
dp_nelim = QTOS((Q)ARG0(arg)); |
|
} |
|
STOQ(dp_nelim,*rp); |
|
} |
|
|
|
void Pdp_mag(NODE arg,Q *rp) |
|
{ |
|
DP p; |
|
int s; |
|
MP m; |
|
|
|
p = (DP)ARG0(arg); |
|
asir_assert(p,O_DP,"dp_mag"); |
|
if ( !p ) |
|
*rp = 0; |
|
else { |
|
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
|
s += p_mag((P)m->c); |
|
STOQ(s,*rp); |
|
} |
|
} |
|
|
extern int kara_mag; |
extern int kara_mag; |
|
|
void Pdp_set_kara(arg,rp) |
void Pdp_set_kara(NODE arg,Q *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_set_kara"); |
asir_assert(ARG0(arg),O_N,"dp_set_kara"); |
kara_mag = QTOS((Q)ARG0(arg)); |
kara_mag = QTOS((Q)ARG0(arg)); |
} |
} |
STOQ(kara_mag,*rp); |
STOQ(kara_mag,*rp); |
} |
} |
|
|
void Pdp_homo(arg,rp) |
void Pdp_homo(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_homo"); |
asir_assert(ARG0(arg),O_DP,"dp_homo"); |
dp_homo((DP)ARG0(arg),rp); |
dp_homo((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_dehomo(arg,rp) |
void Pdp_dehomo(NODE arg,DP *rp) |
NODE arg; |
|
DP *rp; |
|
{ |
{ |
asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
dp_dehomo((DP)ARG0(arg),rp); |
dp_dehomo((DP)ARG0(arg),rp); |
} |
} |
|
|
void Pdp_gr_flags(arg,rp) |
void Pdp_gr_flags(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
Obj name,value; |
Obj name,value; |
NODE n; |
NODE n; |
|
|
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_LIST,"dp_gr_flags"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_flags"); |
n = BDY((LIST)ARG0(arg)); |
n = BDY((LIST)ARG0(arg)); |
while ( n ) { |
while ( n ) { |
name = (Obj)BDY(n); n = NEXT(n); |
name = (Obj)BDY(n); n = NEXT(n); |
if ( !n ) |
if ( !n ) |
break; |
break; |
else { |
else { |
value = (Obj)BDY(n); n = NEXT(n); |
value = (Obj)BDY(n); n = NEXT(n); |
} |
} |
dp_set_flag(name,value); |
dp_set_flag(name,value); |
} |
} |
} |
} |
dp_make_flaglist(rp); |
dp_make_flaglist(rp); |
} |
} |
|
|
extern int DP_Print, DP_PrintShort; |
extern int DP_Print, DP_PrintShort; |
|
|
void Pdp_gr_print(arg,rp) |
void Pdp_gr_print(NODE arg,Q *rp) |
NODE arg; |
|
Q *rp; |
|
{ |
{ |
Q q; |
Q q; |
int s; |
int s; |
|
|
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
q = (Q)ARG0(arg); |
q = (Q)ARG0(arg); |
s = QTOS(q); |
s = QTOS(q); |
switch ( s ) { |
switch ( s ) { |
case 0: |
case 0: |
DP_Print = 0; DP_PrintShort = 0; |
DP_Print = 0; DP_PrintShort = 0; |
break; |
break; |
case 1: |
case 1: |
DP_Print = 1; |
DP_Print = 1; |
break; |
break; |
case 2: |
case 2: |
DP_Print = 0; DP_PrintShort = 1; |
DP_Print = 0; DP_PrintShort = 1; |
break; |
break; |
default: |
default: |
DP_Print = s; DP_PrintShort = 0; |
DP_Print = s; DP_PrintShort = 0; |
break; |
break; |
} |
} |
} else { |
} else { |
if ( DP_Print ) { |
if ( DP_Print ) { |
STOQ(1,q); |
STOQ(1,q); |
} else if ( DP_PrintShort ) { |
} else if ( DP_PrintShort ) { |
STOQ(2,q); |
STOQ(2,q); |
} else |
} else |
q = 0; |
q = 0; |
} |
} |
*rp = q; |
*rp = q; |
} |
} |
|
|
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 t,p; |
NODE t,p; |
Q m; |
Q m; |
char *key; |
char *key; |
Obj value,dmy; |
Obj value,dmy; |
int ord_is_set = 0; |
int ord_is_set = 0; |
int modular_is_set = 0; |
int modular_is_set = 0; |
int homo_is_set = 0; |
int homo_is_set = 0; |
VL vl,vl0; |
VL vl,vl0; |
LIST vars; |
LIST vars; |
char xiname[BUFSIZ]; |
char xiname[BUFSIZ]; |
NODE x0,x; |
NODE x0,x; |
DP d; |
DP d; |
P xi; |
P xi; |
int nv,i; |
int nv,i; |
|
|
/* extract vars */ |
/* extract vars */ |
vars = 0; |
vars = 0; |
for ( t = opt; t; t = NEXT(t) ) { |
for ( t = opt; t; t = NEXT(t) ) { |
p = BDY((LIST)BDY(t)); |
p = BDY((LIST)BDY(t)); |
key = BDY((STRING)BDY(p)); |
key = BDY((STRING)BDY(p)); |
value = (Obj)BDY(NEXT(p)); |
value = (Obj)BDY(NEXT(p)); |
if ( !strcmp(key,"v") ) { |
if ( !strcmp(key,"v") ) { |
/* variable list */ |
/* variable list */ |
vars = (LIST)value; |
vars = (LIST)value; |
break; |
break; |
} |
} |
} |
} |
if ( vars ) { |
if ( vars ) { |
*v = vars; pltovl(vars,&vl); |
*v = vars; pltovl(vars,&vl); |
} else { |
} else { |
for ( t = BDY(f); t; t = NEXT(t) ) |
for ( t = BDY(f); t; t = NEXT(t) ) |
if ( BDY(t) && OID((Obj)BDY(t))==O_DP ) |
if ( BDY(t) && OID((Obj)BDY(t))==O_DP ) |
break; |
break; |
if ( t ) { |
if ( t ) { |
/* f is DP list */ |
/* f is DP list */ |
/* create dummy var list */ |
/* create dummy var list */ |
d = (DP)BDY(t); |
d = (DP)BDY(t); |
nv = NV(d); |
nv = NV(d); |
for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) { |
for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) { |
NEXTVL(vl0,vl); |
NEXTVL(vl0,vl); |
NEXTNODE(x0,x); |
NEXTNODE(x0,x); |
sprintf(xiname,"x%d",i); |
sprintf(xiname,"x%d",i); |
makevar(xiname,&xi); |
makevar(xiname,&xi); |
x->body = (pointer)xi; |
x->body = (pointer)xi; |
vl->v = VR((P)xi); |
vl->v = VR((P)xi); |
} |
} |
if ( vl0 ) { |
if ( vl0 ) { |
NEXT(vl) = 0; |
NEXT(vl) = 0; |
NEXT(x) = 0; |
NEXT(x) = 0; |
} |
} |
MKLIST(vars,x0); |
MKLIST(vars,x0); |
*v = vars; |
*v = vars; |
vl = vl0; |
vl = vl0; |
} else { |
} else { |
get_vars((Obj)f,&vl); vltopl(vl,v); |
get_vars((Obj)f,&vl); vltopl(vl,v); |
} |
} |
} |
} |
|
|
for ( t = opt; t; t = NEXT(t) ) { |
for ( t = opt; t; t = NEXT(t) ) { |
p = BDY((LIST)BDY(t)); |
p = BDY((LIST)BDY(t)); |
key = BDY((STRING)BDY(p)); |
key = BDY((STRING)BDY(p)); |
value = (Obj)BDY(NEXT(p)); |
value = (Obj)BDY(NEXT(p)); |
if ( !strcmp(key,"v") ) { |
if ( !strcmp(key,"v") ) { |
/* variable list; ignore */ |
/* variable list; ignore */ |
} else if ( !strcmp(key,"order") ) { |
} else if ( !strcmp(key,"order") ) { |
/* order spec */ |
/* order spec */ |
if ( !vl ) |
if ( !vl ) |
error("parse_gr_option : variables must be specified"); |
error("parse_gr_option : variables must be specified"); |
create_order_spec(vl,value,ord); |
create_order_spec(vl,value,ord); |
ord_is_set = 1; |
ord_is_set = 1; |
} else if ( !strcmp(key,"block") ) { |
} else if ( !strcmp(key,"block") ) { |
create_order_spec(0,value,ord); |
create_order_spec(0,value,ord); |
ord_is_set = 1; |
ord_is_set = 1; |
} else if ( !strcmp(key,"matrix") ) { |
} else if ( !strcmp(key,"matrix") ) { |
create_order_spec(0,value,ord); |
create_order_spec(0,value,ord); |
ord_is_set = 1; |
ord_is_set = 1; |
} else if ( !strcmp(key,"sugarweight") ) { |
} else if ( !strcmp(key,"sugarweight") ) { |
/* weight */ |
/* weight */ |
Pdp_set_weight(NEXT(p),&dmy); |
Pdp_set_weight(NEXT(p),&dmy); |
} else if ( !strcmp(key,"homo") ) { |
} else if ( !strcmp(key,"homo") ) { |
*homo = (Num)value; |
*homo = (Num)value; |
homo_is_set = 1; |
homo_is_set = 1; |
} else if ( !strcmp(key,"trace") ) { |
} else if ( !strcmp(key,"trace") ) { |
m = (Q)value; |
m = (Q)value; |
if ( !m ) |
if ( !m ) |
*modular = 0; |
*modular = 0; |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 |
&& BD(NM(m))[0] >= 0x80000000) ) |
&& BD(NM(m))[0] >= 0x80000000) ) |
error("parse_gr_option : too large modulus"); |
error("parse_gr_option : too large modulus"); |
else |
else |
*modular = QTOS(m); |
*modular = QTOS(m); |
modular_is_set = 1; |
modular_is_set = 1; |
} else |
} else if ( !strcmp(key,"dp") ) { |
error("parse_gr_option : not implemented"); |
/* XXX : ignore */ |
} |
} else |
if ( !ord_is_set ) create_order_spec(0,0,ord); |
error("parse_gr_option : not implemented"); |
if ( !modular_is_set ) *modular = 0; |
} |
if ( !homo_is_set ) *homo = 0; |
if ( !ord_is_set ) create_order_spec(0,0,ord); |
|
if ( !modular_is_set ) *modular = 0; |
|
if ( !homo_is_set ) *homo = 0; |
} |
} |
|
|
void Pdp_gr_main(arg,rp) |
void Pdp_gr_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
VL vl; |
VL vl; |
Num homo; |
Num homo; |
Q m; |
Q m; |
int modular,ac; |
int modular,ac; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_main"); |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(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; |
} |
} |
if ( (ac = argc(arg)) == 5 ) { |
if ( (ac = argc(arg)) == 5 ) { |
asir_assert(ARG1(arg),O_LIST,"dp_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_main"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Q)ARG3(arg); |
m = (Q)ARG3(arg); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
error("dp_gr_main : too large modulus"); |
error("dp_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = QTOS(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); |
else if ( ac == 1 ) |
else if ( ac == 1 ) |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
else |
else |
error("dp_gr_main : invalid argument"); |
error("dp_gr_main : invalid argument"); |
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) |
void Pdp_interreduce(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
VL vl; |
VL vl; |
int ac; |
int ac; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_interreduce"); |
asir_assert(ARG0(arg),O_LIST,"dp_interreduce"); |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(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; |
} |
} |
if ( (ac = argc(arg)) == 3 ) { |
if ( (ac = argc(arg)) == 3 ) { |
asir_assert(ARG1(arg),O_LIST,"dp_interreduce"); |
asir_assert(ARG1(arg),O_LIST,"dp_interreduce"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
create_order_spec(0,ARG2(arg),&ord); |
create_order_spec(0,ARG2(arg),&ord); |
} |
} |
dp_interreduce(f,v,0,ord,rp); |
dp_interreduce(f,v,0,ord,rp); |
} |
} |
|
|
void Pdp_gr_f_main(arg,rp) |
void Pdp_gr_f_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
int m,field,t; |
int m,field,t; |
struct order_spec *ord; |
struct order_spec *ord; |
NODE n; |
NODE n; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_f_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_f_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
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 = QTOS((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); |
#else |
#else |
m = 0; |
m = 0; |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
#endif |
#endif |
field = 0; |
field = 0; |
for ( n = BDY(f); n; n = NEXT(n) ) { |
for ( n = BDY(f); n; n = NEXT(n) ) { |
t = get_field_type(BDY(n)); |
t = get_field_type(BDY(n)); |
if ( !t ) |
if ( !t ) |
continue; |
continue; |
if ( t < 0 ) |
if ( t < 0 ) |
error("dp_gr_f_main : incosistent coefficients"); |
error("dp_gr_f_main : incosistent coefficients"); |
if ( !field ) |
if ( !field ) |
field = t; |
field = t; |
else if ( t != field ) |
else if ( t != field ) |
error("dp_gr_f_main : incosistent coefficients"); |
error("dp_gr_f_main : incosistent coefficients"); |
} |
} |
dp_gr_main(f,v,homo,m?1:0,field,ord,rp); |
dp_gr_main(f,v,homo,m?1:0,field,ord,rp); |
} |
} |
|
|
void Pdp_f4_main(arg,rp) |
void Pdp_f4_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_f4_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
create_order_spec(0,ARG2(arg),&ord); |
create_order_spec(0,ARG2(arg),&ord); |
dp_f4_main(f,v,ord,rp); |
dp_f4_main(f,v,ord,rp); |
} |
} |
|
|
/* dp_gr_checklist(list of dp) */ |
/* dp_gr_checklist(list of dp) */ |
|
|
void Pdp_gr_checklist(arg,rp) |
void Pdp_gr_checklist(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
VECT g; |
VECT g; |
LIST dp; |
LIST dp; |
NODE r; |
NODE r; |
int n; |
int n; |
|
|
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 = QTOS((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); |
} |
} |
|
|
void Pdp_f4_mod_main(arg,rp) |
void Pdp_f4_mod_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m; |
int m; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
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 = QTOS((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; |
} |
} |
if ( !m ) |
if ( !m ) |
error("dp_f4_mod_main : invalid argument"); |
error("dp_f4_mod_main : invalid argument"); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
dp_f4_mod_main(f,v,m,ord,rp); |
dp_f4_mod_main(f,v,m,ord,rp); |
} |
} |
|
|
void Pdp_gr_mod_main(arg,rp) |
void Pdp_gr_mod_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
int m; |
int m; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_mod_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_mod_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_mod_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = QTOS((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); |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
} |
} |
|
|
void Pnd_f4(arg,rp) |
void Pnd_f4(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo; |
int m,homo,retdp,ac; |
struct order_spec *ord; |
Obj val; |
|
Q mq; |
|
Num nhomo; |
|
NODE node; |
|
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_f4"); |
nd_rref2 = 0; |
asir_assert(ARG1(arg),O_LIST,"nd_f4"); |
retdp = 0; |
asir_assert(ARG2(arg),O_N,"nd_f4"); |
if ( (ac = argc(arg)) == 4 ) { |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
asir_assert(ARG0(arg),O_LIST,"nd_f4"); |
f = remove_zero_from_list(f); |
asir_assert(ARG1(arg),O_LIST,"nd_f4"); |
if ( !BDY(f) ) { |
asir_assert(ARG2(arg),O_N,"nd_f4"); |
*rp = f; return; |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
} |
f = remove_zero_from_list(f); |
m = QTOS((Q)ARG2(arg)); |
if ( !BDY(f) ) { |
create_order_spec(0,ARG3(arg),&ord); |
*rp = f; return; |
nd_gr(f,v,m,1,ord,rp); |
} |
|
mq = (Q)ARG2(arg); |
|
if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<31)) ) { |
|
node = mknode(1,mq); |
|
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = QTOS(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; |
|
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = QTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
|
} else |
|
error("nd_f4 : invalid argument"); |
|
nd_gr(f,v,m,homo,retdp,1,ord,rp); |
} |
} |
|
|
void Pnd_gr(arg,rp) |
void Pnd_gr(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo; |
int m,homo,retdp,ac; |
struct order_spec *ord; |
Obj val; |
|
Q mq; |
|
Num nhomo; |
|
NODE node; |
|
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
retdp = 0; |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
if ( (ac=argc(arg)) == 4 ) { |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
f = remove_zero_from_list(f); |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
if ( !BDY(f) ) { |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
*rp = f; return; |
f = remove_zero_from_list(f); |
} |
if ( !BDY(f) ) { |
m = QTOS((Q)ARG2(arg)); |
*rp = f; return; |
create_order_spec(0,ARG3(arg),&ord); |
} |
nd_gr(f,v,m,0,ord,rp); |
mq = (Q)ARG2(arg); |
|
if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<30)) ) { |
|
node = mknode(1,mq); |
|
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = QTOS(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 = QTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else |
|
error("nd_gr : invalid argument"); |
|
nd_gr(f,v,m,homo,retdp,0,ord,rp); |
} |
} |
|
|
void Pnd_gr_postproc(arg,rp) |
void Pnd_gr_postproc(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,do_check; |
int m,do_check; |
struct order_spec *ord; |
Q mq; |
|
Obj val; |
|
NODE node; |
|
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
mq = (Q)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<30)) ) { |
do_check = ARG4(arg) ? 1 : 0; |
node = mknode(1,mq); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
Psetmod_ff(node,&val); |
|
m = -2; |
|
} else |
|
m = QTOS(mq); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
do_check = ARG4(arg) ? 1 : 0; |
|
nd_gr_postproc(f,v,m,ord,do_check,rp); |
} |
} |
|
|
void Pnd_weyl_gr_postproc(arg,rp) |
void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v,tlist; |
int m,do_check; |
int m; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 1; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
asir_assert(ARG0(arg),O_LIST,"nd_gr_recompute_trace"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace"); |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
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); |
f = remove_zero_from_list(f); |
m = QTOS((Q)ARG2(arg)); |
if ( !BDY(f) ) { |
create_order_spec(0,ARG3(arg),&ord); |
*rp = f; return; |
tlist = (LIST)ARG4(arg); |
} |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
m = QTOS((Q)ARG2(arg)); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
do_check = ARG4(arg) ? 1 : 0; |
|
nd_gr_postproc(f,v,m,ord,do_check,rp); |
|
} |
} |
|
|
void Pnd_gr_trace(arg,rp) |
Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos); |
NODE arg; |
Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist); |
LIST *rp; |
|
|
void Pnd_btog(NODE arg,Obj *rp) |
{ |
{ |
LIST f,v; |
LIST f,v,tlist; |
int m,homo; |
Q mq; |
struct order_spec *ord; |
int m,ac,pos; |
|
struct order_spec *ord; |
|
NODE node; |
|
pointer val; |
|
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
asir_assert(ARG0(arg),O_LIST,"nd_btog"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
asir_assert(ARG1(arg),O_LIST,"nd_btog"); |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
asir_assert(ARG2(arg),O_N,"nd_btog"); |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
mq = (Q)ARG2(arg); |
f = remove_zero_from_list(f); |
if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<31)) ) { |
if ( !BDY(f) ) { |
node = mknode(1,mq); |
*rp = f; return; |
Psetmod_ff(node,&val); |
} |
m = -2; |
homo = QTOS((Q)ARG2(arg)); |
} else |
m = QTOS((Q)ARG3(arg)); |
m = QTOS(mq); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
tlist = (LIST)ARG4(arg); |
|
if ( (ac = argc(arg)) == 6 ) { |
|
asir_assert(ARG5(arg),O_N,"nd_btog"); |
|
pos = QTOS((Q)ARG5(arg)); |
|
*rp = nd_btog_one(f,v,m,ord,tlist,pos); |
|
} else if ( ac == 5 ) |
|
*rp = nd_btog(f,v,m,ord,tlist); |
|
else |
|
error("nd_btog : argument mismatch"); |
} |
} |
|
|
void Pnd_f4_trace(arg,rp) |
void Pnd_weyl_gr_postproc(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo; |
int m,do_check; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 1; |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = remove_zero_from_list(f); |
f = remove_zero_from_list(f); |
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; return; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
homo = QTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
m = QTOS((Q)ARG3(arg)); |
do_check = ARG4(arg) ? 1 : 0; |
create_order_spec(0,ARG4(arg),&ord); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
do_weyl = 0; |
} |
} |
|
|
void Pnd_weyl_gr(arg,rp) |
void Pnd_gr_trace(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo; |
int m,homo,ac; |
struct order_spec *ord; |
Num nhomo; |
|
struct order_spec *ord; |
|
|
do_weyl = 1; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr"); |
if ( (ac = argc(arg)) == 5 ) { |
asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr"); |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
asir_assert(ARG2(arg),O_N,"nd_weyl_gr"); |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
f = remove_zero_from_list(f); |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
if ( !BDY(f) ) { |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
*rp = f; return; |
f = remove_zero_from_list(f); |
} |
if ( !BDY(f) ) { |
m = QTOS((Q)ARG2(arg)); |
*rp = f; return; |
create_order_spec(0,ARG3(arg),&ord); |
} |
nd_gr(f,v,m,0,ord,rp); |
homo = QTOS((Q)ARG2(arg)); |
|
m = QTOS((Q)ARG3(arg)); |
|
create_order_spec(0,ARG4(arg),&ord); |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = QTOS((Q)nhomo); |
|
} else |
|
error("nd_gr_trace : invalid argument"); |
|
nd_gr_trace(f,v,m,homo,0,ord,rp); |
} |
} |
|
|
void Pnd_weyl_gr_trace(arg,rp) |
void Pnd_f4_trace(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m,homo; |
int m,homo,ac; |
struct order_spec *ord; |
Num nhomo; |
|
struct order_spec *ord; |
|
|
do_weyl = 1; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace"); |
if ( (ac = argc(arg))==5 ) { |
asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace"); |
asir_assert(ARG0(arg),O_LIST,"nd_f4_trace"); |
asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace"); |
asir_assert(ARG1(arg),O_LIST,"nd_f4_trace"); |
asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace"); |
asir_assert(ARG2(arg),O_N,"nd_f4_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
asir_assert(ARG3(arg),O_N,"nd_f4_trace"); |
f = remove_zero_from_list(f); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
if ( !BDY(f) ) { |
f = remove_zero_from_list(f); |
*rp = f; return; |
if ( !BDY(f) ) { |
} |
*rp = f; return; |
homo = QTOS((Q)ARG2(arg)); |
} |
m = QTOS((Q)ARG3(arg)); |
homo = QTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
m = QTOS((Q)ARG3(arg)); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
create_order_spec(0,ARG4(arg),&ord); |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = QTOS((Q)nhomo); |
|
} else |
|
error("nd_gr_trace : invalid argument"); |
|
nd_gr_trace(f,v,m,homo,1,ord,rp); |
} |
} |
|
|
void Pnd_nf(arg,rp) |
void Pnd_weyl_gr(NODE arg,LIST *rp) |
NODE arg; |
|
P *rp; |
|
{ |
{ |
P f; |
LIST f,v; |
LIST g,v; |
int m,homo,retdp,ac; |
struct order_spec *ord; |
Obj val; |
|
Num nhomo; |
|
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 1; |
asir_assert(ARG0(arg),O_P,"nd_nf"); |
retdp = 0; |
asir_assert(ARG1(arg),O_LIST,"nd_nf"); |
if ( (ac = argc(arg)) == 4 ) { |
asir_assert(ARG2(arg),O_LIST,"nd_nf"); |
asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr"); |
asir_assert(ARG4(arg),O_N,"nd_nf"); |
asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr"); |
f = (P)ARG0(arg); |
asir_assert(ARG2(arg),O_N,"nd_weyl_gr"); |
g = (LIST)ARG1(arg); g = remove_zero_from_list(g); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
if ( !BDY(g) ) { |
f = remove_zero_from_list(f); |
*rp = f; return; |
if ( !BDY(f) ) { |
} |
*rp = f; do_weyl = 0; return; |
v = (LIST)ARG2(arg); |
} |
create_order_spec(0,ARG3(arg),&ord); |
m = QTOS((Q)ARG2(arg)); |
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
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 = QTOS((Q)nhomo); |
|
if ( get_opt("dp",&val) && val ) retdp = 1; |
|
} else |
|
error("nd_weyl_gr : invalid argument"); |
|
nd_gr(f,v,m,homo,retdp,0,ord,rp); |
|
do_weyl = 0; |
} |
} |
|
|
|
void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
|
{ |
|
LIST f,v; |
|
int m,homo,ac; |
|
Num nhomo; |
|
struct order_spec *ord; |
|
|
|
do_weyl = 1; |
|
if ( (ac = argc(arg)) == 5 ) { |
|
asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace"); |
|
asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace"); |
|
asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace"); |
|
asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace"); |
|
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
|
f = remove_zero_from_list(f); |
|
if ( !BDY(f) ) { |
|
*rp = f; do_weyl = 0; return; |
|
} |
|
homo = QTOS((Q)ARG2(arg)); |
|
m = QTOS((Q)ARG3(arg)); |
|
create_order_spec(0,ARG4(arg),&ord); |
|
} else if ( ac == 1 ) { |
|
f = (LIST)ARG0(arg); |
|
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
|
homo = QTOS((Q)nhomo); |
|
} else |
|
error("nd_weyl_gr_trace : invalid argument"); |
|
nd_gr_trace(f,v,m,homo,0,ord,rp); |
|
do_weyl = 0; |
|
} |
|
|
|
void Pnd_nf(NODE arg,Obj *rp) |
|
{ |
|
Obj f; |
|
LIST g,v; |
|
struct order_spec *ord; |
|
|
|
do_weyl = 0; |
|
asir_assert(ARG1(arg),O_LIST,"nd_nf"); |
|
asir_assert(ARG2(arg),O_LIST,"nd_nf"); |
|
asir_assert(ARG4(arg),O_N,"nd_nf"); |
|
f = (Obj)ARG0(arg); |
|
g = (LIST)ARG1(arg); g = remove_zero_from_list(g); |
|
if ( !BDY(g) ) { |
|
*rp = f; return; |
|
} |
|
v = (LIST)ARG2(arg); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
|
} |
|
|
|
void Pnd_weyl_nf(NODE arg,Obj *rp) |
|
{ |
|
Obj f; |
|
LIST g,v; |
|
struct order_spec *ord; |
|
|
|
do_weyl = 1; |
|
asir_assert(ARG1(arg),O_LIST,"nd_weyl_nf"); |
|
asir_assert(ARG2(arg),O_LIST,"nd_weyl_nf"); |
|
asir_assert(ARG4(arg),O_N,"nd_weyl_nf"); |
|
f = (Obj)ARG0(arg); |
|
g = (LIST)ARG1(arg); g = remove_zero_from_list(g); |
|
if ( !BDY(g) ) { |
|
*rp = f; return; |
|
} |
|
v = (LIST)ARG2(arg); |
|
create_order_spec(0,ARG3(arg),&ord); |
|
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
|
} |
|
|
/* for Weyl algebra */ |
/* for Weyl algebra */ |
|
|
void Pdp_weyl_gr_main(arg,rp) |
void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
Q m; |
Q m; |
int modular,ac; |
int modular,ac; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(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; |
} |
} |
if ( (ac = argc(arg)) == 5 ) { |
if ( (ac = argc(arg)) == 5 ) { |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Q)ARG3(arg); |
m = (Q)ARG3(arg); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
error("dp_weyl_gr_main : too large modulus"); |
error("dp_weyl_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = QTOS(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); |
else if ( ac == 1 ) |
else if ( ac == 1 ) |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
else |
else |
error("dp_weyl_gr_main : invalid argument"); |
error("dp_weyl_gr_main : invalid argument"); |
do_weyl = 1; |
do_weyl = 1; |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdp_weyl_gr_f_main(arg,rp) |
void Pdp_weyl_gr_f_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_weyl = 1; |
do_weyl = 1; |
dp_gr_main(f,v,homo,0,1,ord,rp); |
dp_gr_main(f,v,homo,0,1,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdp_weyl_f4_main(arg,rp) |
void Pdp_weyl_f4_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
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"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
create_order_spec(0,ARG2(arg),&ord); |
create_order_spec(0,ARG2(arg),&ord); |
do_weyl = 1; |
do_weyl = 1; |
dp_f4_main(f,v,ord,rp); |
dp_f4_main(f,v,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdp_weyl_f4_mod_main(arg,rp) |
void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
int m; |
int m; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
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 = QTOS((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; |
} |
} |
if ( !m ) |
if ( !m ) |
error("dp_weyl_f4_mod_main : invalid argument"); |
error("dp_weyl_f4_mod_main : invalid argument"); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_weyl = 1; |
do_weyl = 1; |
dp_f4_mod_main(f,v,m,ord,rp); |
dp_f4_mod_main(f,v,m,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
void Pdp_weyl_gr_mod_main(arg,rp) |
void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
NODE arg; |
|
LIST *rp; |
|
{ |
{ |
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
int m; |
int m; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(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; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = QTOS((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); |
do_weyl = 1; |
do_weyl = 1; |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
VECT current_dl_weight_vector_obj; |
VECT current_dl_weight_vector_obj; |
int *current_dl_weight_vector; |
int *current_dl_weight_vector; |
|
int dp_negative_weight; |
|
|
void Pdp_set_weight(arg,rp) |
void Pdp_set_weight(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
VECT v; |
VECT v; |
int i,n; |
int i,n; |
NODE node; |
NODE node; |
|
|
if ( !arg ) |
if ( !arg ) |
*rp = current_dl_weight_vector_obj; |
*rp = current_dl_weight_vector_obj; |
else if ( !ARG0(arg) ) { |
else if ( !ARG0(arg) ) { |
current_dl_weight_vector_obj = 0; |
current_dl_weight_vector_obj = 0; |
current_dl_weight_vector = 0; |
current_dl_weight_vector = 0; |
*rp = 0; |
dp_negative_weight = 0; |
} else { |
*rp = 0; |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
} else { |
error("dp_set_weight : invalid argument"); |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
if ( OID(ARG0(arg)) == O_VECT ) |
error("dp_set_weight : invalid argument"); |
v = (VECT)ARG0(arg); |
if ( OID(ARG0(arg)) == O_VECT ) |
else { |
v = (VECT)ARG0(arg); |
node = (NODE)BDY((LIST)ARG0(arg)); |
else { |
n = length(node); |
node = (NODE)BDY((LIST)ARG0(arg)); |
MKVECT(v,n); |
n = length(node); |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
MKVECT(v,n); |
BDY(v)[i] = BDY(node); |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
} |
BDY(v)[i] = BDY(node); |
current_dl_weight_vector_obj = v; |
} |
n = v->len; |
current_dl_weight_vector_obj = v; |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
n = v->len; |
for ( i = 0; i < n; i++ ) |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_dl_weight_vector[i] = QTOS((Q)v->body[i]); |
for ( i = 0; i < n; i++ ) |
*rp = v; |
current_dl_weight_vector[i] = QTOS((Q)v->body[i]); |
} |
for ( i = 0; i < n; i++ ) |
|
if ( current_dl_weight_vector[i] < 0 ) break; |
|
if ( i < n ) |
|
dp_negative_weight = 1; |
|
else |
|
dp_negative_weight = 0; |
|
*rp = v; |
|
} |
} |
} |
|
|
VECT current_top_weight_vector_obj; |
VECT current_module_weight_vector_obj; |
N *current_top_weight_vector; |
int *current_module_weight_vector; |
|
|
void Pdp_set_top_weight(arg,rp) |
void Pdp_set_module_weight(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
VECT v; |
VECT v; |
int i,n; |
int i,n; |
NODE node; |
NODE node; |
|
|
if ( !arg ) |
if ( !arg ) |
*rp = current_top_weight_vector_obj; |
*rp = current_module_weight_vector_obj; |
else if ( !ARG0(arg) ) { |
else if ( !ARG0(arg) ) { |
current_top_weight_vector = 0; |
current_module_weight_vector_obj = 0; |
current_top_weight_vector_obj = 0; |
current_module_weight_vector = 0; |
*rp = 0; |
*rp = 0; |
} else { |
} else { |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
error("dp_set_top_weight : invalid argument"); |
error("dp_module_set_weight : invalid argument"); |
if ( OID(ARG0(arg)) == O_VECT ) |
if ( OID(ARG0(arg)) == O_VECT ) |
v = (VECT)ARG0(arg); |
v = (VECT)ARG0(arg); |
else { |
else { |
node = (NODE)BDY((LIST)ARG0(arg)); |
node = (NODE)BDY((LIST)ARG0(arg)); |
n = length(node); |
n = length(node); |
MKVECT(v,n); |
MKVECT(v,n); |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
BDY(v)[i] = BDY(node); |
BDY(v)[i] = BDY(node); |
} |
} |
for ( i = 0; i < v->len; i++ ) |
current_module_weight_vector_obj = v; |
if ( !INT(BDY(v)[i]) || (BDY(v)[i] && SGN((Q)BDY(v)[i]) < 0) ) |
n = v->len; |
error("dp_set_top_weight : each element must be a non-negative integer"); |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_top_weight_vector_obj = v; |
for ( i = 0; i < n; i++ ) |
current_top_weight_vector = (N *)MALLOC(v->len*sizeof(N)); |
current_module_weight_vector[i] = QTOS((Q)v->body[i]); |
for ( i = 0; i < v->len; i++ ) { |
*rp = v; |
current_top_weight_vector[i] = !BDY(v)[i]?0:NM((Q)BDY(v)[i]); |
} |
} |
|
*rp = current_top_weight_vector_obj; |
|
} |
|
} |
} |
|
|
|
extern Obj current_top_weight; |
|
extern Obj nd_top_weight; |
|
|
|
void Pdp_set_top_weight(NODE arg,Obj *rp) |
|
{ |
|
VECT v; |
|
MAT m; |
|
Obj obj; |
|
int i,j,n,id,row,col; |
|
Q *mi; |
|
NODE node; |
|
|
|
if ( !arg ) |
|
*rp = current_top_weight; |
|
else if ( !ARG0(arg) ) { |
|
reset_top_weight(); |
|
*rp = 0; |
|
} else { |
|
id = OID(ARG0(arg)); |
|
if ( id != O_VECT && id != O_MAT && id != O_LIST ) |
|
error("dp_set_top_weight : invalid argument"); |
|
if ( id == O_LIST ) { |
|
node = (NODE)BDY((LIST)ARG0(arg)); |
|
n = length(node); |
|
MKVECT(v,n); |
|
for ( i = 0; i < n; i++, node = NEXT(node) ) |
|
BDY(v)[i] = BDY(node); |
|
obj = (Obj)v; |
|
} else |
|
obj = ARG0(arg); |
|
if ( OID(obj) == O_VECT ) { |
|
v = (VECT)obj; |
|
for ( i = 0; i < v->len; i++ ) |
|
if ( !INT(BDY(v)[i]) || (BDY(v)[i] && SGN((Q)BDY(v)[i]) < 0) ) |
|
error("dp_set_top_weight : each element must be a non-negative integer"); |
|
} else { |
|
m = (MAT)obj; row = m->row; col = m->col; |
|
for ( i = 0; i < row; i++ ) |
|
for ( j = 0, mi = (Q *)BDY(m)[i]; j < col; j++ ) |
|
if ( !INT(mi[j]) || (mi[j] && SGN((Q)mi[j]) < 0) ) |
|
error("dp_set_top_weight : each element must be a non-negative integer"); |
|
} |
|
current_top_weight = obj; |
|
nd_top_weight = obj; |
|
*rp = current_top_weight; |
|
} |
|
} |
|
|
LIST get_denomlist(); |
LIST get_denomlist(); |
|
|
void Pdp_get_denomlist(LIST *rp) |
void Pdp_get_denomlist(LIST *rp) |
{ |
{ |
*rp = get_denomlist(); |
*rp = get_denomlist(); |
} |
} |
|
|
static VECT current_weyl_weight_vector_obj; |
static VECT current_weyl_weight_vector_obj; |
int *current_weyl_weight_vector; |
int *current_weyl_weight_vector; |
|
|
void Pdp_weyl_set_weight(arg,rp) |
void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
VECT v; |
VECT v; |
int i,n; |
NODE node; |
|
int i,n; |
|
|
if ( !arg ) |
if ( !arg ) |
*rp = current_weyl_weight_vector_obj; |
*rp = current_weyl_weight_vector_obj; |
else { |
else if ( !ARG0(arg) ) { |
asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight"); |
current_weyl_weight_vector_obj = 0; |
v = (VECT)ARG0(arg); |
current_weyl_weight_vector = 0; |
current_weyl_weight_vector_obj = v; |
*rp = 0; |
n = v->len; |
} else { |
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
for ( i = 0; i < n; i++ ) |
error("dp_weyl_set_weight : invalid argument"); |
current_weyl_weight_vector[i] = QTOS((Q)v->body[i]); |
if ( OID(ARG0(arg)) == O_VECT ) |
*rp = v; |
v = (VECT)ARG0(arg); |
} |
else { |
|
node = (NODE)BDY((LIST)ARG0(arg)); |
|
n = length(node); |
|
MKVECT(v,n); |
|
for ( i = 0; i < n; i++, node = NEXT(node) ) |
|
BDY(v)[i] = BDY(node); |
|
} |
|
current_weyl_weight_vector_obj = v; |
|
n = v->len; |
|
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
|
for ( i = 0; i < n; i++ ) |
|
current_weyl_weight_vector[i] = QTOS((Q)v->body[i]); |
|
*rp = v; |
|
} |
} |
} |
|
|
|
NODE mono_raddec(NODE ideal); |
|
|
|
void Pdp_mono_raddec(NODE arg,LIST *rp) |
|
{ |
|
NODE ideal,rd,t,t1,r,r1,u; |
|
VL vl0,vl; |
|
int nv,i,bpi; |
|
int *s; |
|
DP dp; |
|
P *v; |
|
LIST l; |
|
|
|
ideal = BDY((LIST)ARG0(arg)); |
|
if ( !ideal ) *rp = (LIST)ARG0(arg); |
|
else { |
|
t = BDY((LIST)ARG1(arg)); |
|
nv = length(t); |
|
v = (P *)MALLOC(nv*sizeof(P)); |
|
for ( vl0 = 0, i = 0; t; t = NEXT(t), i++ ) { |
|
NEXTVL(vl0,vl); VR(vl) = VR((P)BDY(t)); |
|
MKV(VR(vl),v[i]); |
|
} |
|
if ( vl0 ) NEXT(vl) = 0; |
|
for ( t = 0, r = ideal; r; r = NEXT(r) ) { |
|
ptod(CO,vl0,BDY(r),&dp); MKNODE(t1,dp,t); t = t1; |
|
} |
|
rd = mono_raddec(t); |
|
r = 0; |
|
bpi = (sizeof(int)/sizeof(char))*8; |
|
for ( u = rd; u; u = NEXT(u) ) { |
|
s = (int *)BDY(u); |
|
for ( i = nv-1, t = 0; i >= 0; i-- ) |
|
if ( s[i/bpi]&(1<<(i%bpi)) ) { |
|
MKNODE(t1,v[i],t); t = t1; |
|
} |
|
MKLIST(l,t); MKNODE(r1,l,r); r = r1; |
|
} |
|
MKLIST(*rp,r); |
|
} |
|
} |
|
|
|
void Pdp_mono_reduce(NODE arg,LIST *rp) |
|
{ |
|
NODE t,t0,t1,r0,r; |
|
int i,n; |
|
DP m; |
|
DP *a; |
|
|
|
t0 = BDY((LIST)ARG0(arg)); |
|
t1 = BDY((LIST)ARG1(arg)); |
|
n = length(t0); |
|
a = (DP *)MALLOC(n*sizeof(DP)); |
|
for ( i = 0; i < n; i++, t0 = NEXT(t0) ) a[i] = (DP)BDY(t0); |
|
for ( t = t1; t; t = NEXT(t) ) { |
|
m = (DP)BDY(t); |
|
for ( i = 0; i < n; i++ ) |
|
if ( a[i] && dp_redble(a[i],m) ) a[i] = 0; |
|
} |
|
for ( i = n-1, r0 = 0; i >= 0; i-- ) |
|
if ( a[i] ) { NEXTNODE(r0,r); BDY(r) = a[i]; } |
|
if ( r0 ) NEXT(r) = 0; |
|
MKLIST(*rp,r0); |
|
} |
|
|
|
#define BLEN (8*sizeof(unsigned long)) |
|
|
|
void showmat2(unsigned long **a,int row,int col) |
|
{ |
|
int i,j; |
|
|
|
for ( i = 0; i < row; i++, putchar('\n') ) |
|
for ( j = 0; j < col; j++ ) |
|
if ( a[i][j/BLEN] & (1L<<(j%BLEN)) ) putchar('1'); |
|
else putchar('0'); |
|
} |
|
|
|
int rref2(unsigned long **a,int row,int col) |
|
{ |
|
int i,j,k,l,s,wcol,wj; |
|
unsigned long bj; |
|
unsigned long *ai,*ak,*as,*t; |
|
int *pivot; |
|
|
|
wcol = (col+BLEN-1)/BLEN; |
|
pivot = (int *)MALLOC_ATOMIC(row*sizeof(int)); |
|
i = 0; |
|
for ( j = 0; j < col; j++ ) { |
|
wj = j/BLEN; bj = 1L<<(j%BLEN); |
|
for ( k = i; k < row; k++ ) |
|
if ( a[k][wj] & bj ) break; |
|
if ( k == row ) continue; |
|
pivot[i] = j; |
|
if ( k != i ) { |
|
t = a[i]; a[i] = a[k]; a[k] = t; |
|
} |
|
ai = a[i]; |
|
for ( k = i+1; k < row; k++ ) { |
|
ak = a[k]; |
|
if ( ak[wj] & bj ) { |
|
for ( l = wj; l < wcol; l++ ) |
|
ak[l] ^= ai[l]; |
|
} |
|
} |
|
i++; |
|
} |
|
for ( k = i-1; k >= 0; k-- ) { |
|
j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN); |
|
ak = a[k]; |
|
for ( s = 0; s < k; s++ ) { |
|
as = a[s]; |
|
if ( as[wj] & bj ) { |
|
for ( l = wj; l < wcol; l++ ) |
|
as[l] ^= ak[l]; |
|
} |
|
} |
|
} |
|
return i; |
|
} |
|
|
|
void Pdp_rref2(NODE arg,VECT *rp) |
|
{ |
|
VECT f,term,ret; |
|
int row,col,wcol,size,nv,i,j,rank,td; |
|
unsigned long **mat; |
|
unsigned long *v; |
|
DL d; |
|
DL *t; |
|
DP dp; |
|
MP m,m0; |
|
|
|
f = (VECT)ARG0(arg); |
|
row = f->len; |
|
term = (VECT)ARG1(arg); |
|
col = term->len; |
|
mat = (unsigned long **)MALLOC(row*sizeof(unsigned long *)); |
|
size = sizeof(unsigned long)*((col+BLEN-1)/BLEN); |
|
nv = ((DP)term->body[0])->nv; |
|
t = (DL *)MALLOC(col*sizeof(DL)); |
|
for ( i = 0; i < col; i++ ) t[i] = BDY((DP)BDY(term)[i])->dl; |
|
for ( i = 0; i < row; i++ ) { |
|
v = mat[i] = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size); |
|
bzero(v,size); |
|
for ( j = 0, m = BDY((DP)BDY(f)[i]); m; m = NEXT(m) ) { |
|
d = m->dl; |
|
for ( ; !dl_equal(nv,d,t[j]); j++ ); |
|
v[j/BLEN] |= 1L <<(j%BLEN); |
|
} |
|
} |
|
rank = rref2(mat,row,col); |
|
MKVECT(ret,rank); |
|
*rp = ret; |
|
for ( i = 0; i < rank; i++ ) { |
|
v = mat[i]; |
|
m0 = 0; |
|
td = 0; |
|
for ( j = 0; j < col; j++ ) { |
|
if ( v[j/BLEN] & (1L<<(j%BLEN)) ) { |
|
NEXTMP(m0,m); |
|
m->dl = t[j]; |
|
m->c = (Obj)ONE; |
|
td = MAX(td,m->dl->td); |
|
} |
|
} |
|
NEXT(m) = 0; |
|
MKDP(nv,m0,dp); |
|
dp->sugar = td; |
|
BDY(ret)[i] = (pointer)dp; |
|
} |
|
} |
|
|
|
#define HDL(f) (BDY(f)->dl) |
|
|
|
NODE sumi_criB(int nv,NODE d,DP *f,int m) |
|
{ |
|
LIST p; |
|
NODE r0,r; |
|
int p0,p1; |
|
DL p2,lcm; |
|
|
|
NEWDL(lcm,nv); |
|
r0 = 0; |
|
for ( ; d; d = NEXT(d) ) { |
|
p = (LIST)BDY(d); |
|
p0 = QTOS((Q)ARG0(BDY(p))); |
|
p1 = QTOS((Q)ARG1(BDY(p))); |
|
p2 = HDL((DP)ARG2(BDY(p))); |
|
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[p1]),HDL(f[m]),lcm),p2) ) { |
|
NEXTNODE(r0,r); |
|
BDY(r) = p; |
|
} |
|
} |
|
if ( r0 ) NEXT(r) = 0; |
|
return r0; |
|
} |
|
|
|
NODE sumi_criFMD(int nv,DP *f,int m) |
|
{ |
|
DL *a; |
|
DL l1,dl1,dl2; |
|
int i,j,k,k2; |
|
NODE r,r1,nd; |
|
MP mp; |
|
DP u; |
|
Q iq,mq; |
|
LIST list; |
|
|
|
/* a[i] = lcm(LT(f[i]),LT(f[m])) */ |
|
a = (DL *)ALLOCA(m*sizeof(DL)); |
|
for ( i = 0; i < m; i++ ) { |
|
a[i] = lcm_of_DL(nv,HDL(f[i]),HDL(f[m]),0); |
|
} |
|
r = 0; |
|
for( i = 0; i < m; i++) { |
|
l1 = a[i]; |
|
if ( !l1 ) continue; |
|
/* Tkm = Tim (k<i) */ |
|
for( k = 0; k < i; k++) |
|
if( dl_equal(nv,l1,a[k]) ) break; |
|
if( k == i ){ |
|
/* Tk|Tim && Tkm != Tim (k<m) */ |
|
for ( k2 = 0; k2 < m; k2++ ) |
|
if ( _dl_redble(HDL(f[k2]),l1,nv) && |
|
!dl_equal(nv,l1,a[k2]) ) break; |
|
if ( k2 == m ) { |
|
dl1 = HDL(f[i]); dl2 = HDL(f[m]); |
|
for ( k2 = 0; k2 < nv; k2++ ) |
|
if ( dl1->d[k2] && dl2->d[k2] ) break; |
|
if ( k2 < nv ) { |
|
NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE; |
|
NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td; |
|
STOQ(i,iq); STOQ(m,mq); |
|
nd = mknode(3,iq,mq,u); |
|
MKLIST(list,nd); |
|
MKNODE(r1,list,r); |
|
r = r1; |
|
} |
|
} |
|
} |
|
} |
|
return r; |
|
} |
|
|
|
LIST sumi_updatepairs(LIST d,DP *f,int m) |
|
{ |
|
NODE old,new,t; |
|
LIST l; |
|
int nv; |
|
|
|
nv = f[0]->nv; |
|
old = sumi_criB(nv,BDY(d),f,m); |
|
new = sumi_criFMD(nv,f,m); |
|
if ( !new ) new = old; |
|
else { |
|
for ( t = new ; NEXT(t); t = NEXT(t) ); |
|
NEXT(t) = old; |
|
} |
|
MKLIST(l,new); |
|
return l; |
|
} |
|
|
|
VECT ltov(LIST l) |
|
{ |
|
NODE n; |
|
int i,len; |
|
VECT v; |
|
|
|
n = BDY(l); |
|
len = length(n); |
|
MKVECT(v,len); |
|
for ( i = 0; i < len; i++, n = NEXT(n) ) |
|
BDY(v)[i] = BDY(n); |
|
return v; |
|
} |
|
|
|
DL subdl(int nv,DL d1,DL d2) |
|
{ |
|
int i; |
|
DL d; |
|
|
|
NEWDL(d,nv); |
|
d->td = d1->td-d2->td; |
|
for ( i = 0; i < nv; i++ ) |
|
d->d[i] = d1->d[i]-d2->d[i]; |
|
return d; |
|
} |
|
|
|
DP dltodp(int nv,DL d) |
|
{ |
|
MP mp; |
|
DP dp; |
|
|
|
NEWMP(mp); mp->dl = d; C(mp) = (Obj)ONE; |
|
NEXT(mp) = 0; MKDP(nv,mp,dp); dp->sugar = d->td; |
|
return dp; |
|
} |
|
|
|
LIST sumi_simplify(int nv,DL t,DP p,NODE f2,int simp) |
|
{ |
|
DL d,h,hw; |
|
DP u,w,dp; |
|
int n,i,last; |
|
LIST *v; |
|
LIST list; |
|
NODE s,r; |
|
|
|
d = t; u = p; |
|
/* only the last history is used */ |
|
if ( f2 && simp && t->td != 0 ) { |
|
adddl(nv,t,HDL(p),&h); |
|
n = length(f2); |
|
last = 1; |
|
if ( simp > 1 ) last = n; |
|
v = (LIST *)ALLOCA(n*sizeof(LIST)); |
|
for ( r = f2, i = 0; r; r = NEXT(r), i++ ) v[n-i-1] = BDY(r); |
|
for ( i = 0; i < last; i++ ) { |
|
for ( s = BDY((LIST)v[i]); s; s = NEXT(s) ) { |
|
w = (DP)BDY(s); hw = HDL(w); |
|
if ( _dl_redble(hw,h,nv) ) { |
|
u = w; |
|
d = subdl(nv,h,hw); |
|
goto fin; |
|
} |
|
} |
|
} |
|
} |
|
fin: |
|
dp = dltodp(nv,d); |
|
r = mknode(2,dp,u); |
|
MKLIST(list,r); |
|
return list; |
|
} |
|
|
|
LIST sumi_symbolic(NODE l,int q,NODE f2,DP *g,int simp) |
|
{ |
|
int nv; |
|
NODE t,r; |
|
NODE f0,f,fd0,fd,done0,done,red0,red; |
|
DL h,d; |
|
DP mul; |
|
int m; |
|
LIST tp,l0,l1,l2,l3,list; |
|
VECT v0,v1,v2,v3; |
|
|
|
nv = ((DP)BDY(l))->nv; |
|
t = 0; |
|
|
|
f0 = 0; fd0 = 0; done0 = 0; red0 = 0; |
|
|
|
for ( ; l; l = NEXT(l) ) { |
|
t = symb_merge(t,dp_dllist((DP)BDY(l)),nv); |
|
NEXTNODE(fd0,fd); BDY(fd) = BDY(l); |
|
} |
|
|
|
while ( t ) { |
|
h = (DL)BDY(t); |
|
NEXTNODE(done0,done); BDY(done) = dltodp(nv,h); |
|
t = NEXT(t); |
|
for(m = 0; m < q; m++) |
|
if ( _dl_redble(HDL(g[m]),h,nv) ) break; |
|
if ( m == q ) { |
|
} else { |
|
d = subdl(nv,h,HDL(g[m])); |
|
tp = sumi_simplify(nv,d,g[m],f2,simp); |
|
|
|
muldm(CO,ARG1(BDY(tp)),BDY((DP)ARG0(BDY(tp))),&mul); |
|
t = symb_merge(t,NEXT(dp_dllist(mul)),nv); |
|
|
|
NEXTNODE(f0,f); BDY(f) = tp; |
|
NEXTNODE(fd0,fd); BDY(fd) = mul; |
|
NEXTNODE(red0,red); BDY(red) = mul; |
|
} |
|
} |
|
if ( fd0 ) NEXT(fd) = 0; MKLIST(l0,fd0); |
|
v0 = ltov(l0); |
|
if ( done0 ) NEXT(done) = 0; MKLIST(l1,done0); |
|
v1 = ltov(l1); |
|
if ( f0 ) NEXT(f) = 0; MKLIST(l2,f0); |
|
v2 = ltov(l2); |
|
if ( red0 ) NEXT(red) = 0; MKLIST(l3,red0); |
|
v3 = ltov(l3); |
|
r = mknode(4,v0,v1,v2,v3); |
|
MKLIST(list,r); |
|
return list; |
|
} |
|
|
|
void Psumi_symbolic(NODE arg,LIST *rp) |
|
{ |
|
NODE l,f2; |
|
DP *g; |
|
int q,simp; |
|
|
|
l = BDY((LIST)ARG0(arg)); |
|
q = QTOS((Q)ARG1(arg)); |
|
f2 = BDY((LIST)ARG2(arg)); |
|
g = (DP *)BDY((VECT)ARG3(arg)); |
|
simp = QTOS((Q)ARG4(arg)); |
|
*rp = sumi_symbolic(l,q,f2,g,simp); |
|
} |
|
|
|
void Psumi_updatepairs(NODE arg,LIST *rp) |
|
{ |
|
LIST d,l; |
|
DP *f; |
|
int m; |
|
|
|
d = (LIST)ARG0(arg); |
|
f = (DP *)BDY((VECT)ARG1(arg)); |
|
m = QTOS((Q)ARG2(arg)); |
|
*rp = sumi_updatepairs(d,f,m); |
|
} |
|
|
LIST remove_zero_from_list(LIST l) |
LIST remove_zero_from_list(LIST l) |
{ |
{ |
NODE n,r0,r; |
NODE n,r0,r; |
LIST rl; |
LIST rl; |
|
|
asir_assert(l,O_LIST,"remove_zero_from_list"); |
asir_assert(l,O_LIST,"remove_zero_from_list"); |
n = BDY(l); |
n = BDY(l); |
for ( r0 = 0; n; n = NEXT(n) ) |
for ( r0 = 0; n; n = NEXT(n) ) |
if ( BDY(n) ) { |
if ( BDY(n) ) { |
NEXTNODE(r0,r); |
NEXTNODE(r0,r); |
BDY(r) = BDY(n); |
BDY(r) = BDY(n); |
} |
} |
if ( r0 ) |
if ( r0 ) |
NEXT(r) = 0; |
NEXT(r) = 0; |
MKLIST(rl,r0); |
MKLIST(rl,r0); |
return rl; |
return rl; |
} |
} |
|
|
int get_field_type(P p) |
int get_field_type(P p) |
{ |
{ |
int type,t; |
int type,t; |
DCP dc; |
DCP dc; |
|
|
if ( !p ) |
if ( !p ) |
return 0; |
return 0; |
else if ( NUM(p) ) |
else if ( NUM(p) ) |
return NID((Num)p); |
return NID((Num)p); |
else { |
else { |
type = 0; |
type = 0; |
for ( dc = DC(p); dc; dc = NEXT(dc) ) { |
for ( dc = DC(p); dc; dc = NEXT(dc) ) { |
t = get_field_type(COEF(dc)); |
t = get_field_type(COEF(dc)); |
if ( !t ) |
if ( !t ) |
continue; |
continue; |
if ( t < 0 ) |
if ( t < 0 ) |
return t; |
return t; |
if ( !type ) |
if ( !type ) |
type = t; |
type = t; |
else if ( t != type ) |
else if ( t != type ) |
return -1; |
return -1; |
} |
} |
return type; |
return type; |
} |
} |
} |
} |
|
|
void Pdpv_ord(NODE arg,Obj *rp) |
void Pdpv_ord(NODE arg,Obj *rp) |
{ |
{ |
int ac,id; |
int ac,id; |
LIST shift; |
LIST shift; |
|
|
ac = argc(arg); |
ac = argc(arg); |
if ( ac ) { |
if ( ac ) { |
id = QTOS((Q)ARG0(arg)); |
id = QTOS((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 |
shift = 0; |
shift = 0; |
create_modorder_spec(id,shift,&dp_current_modspec); |
create_modorder_spec(id,shift,&dp_current_modspec); |
} |
} |
*rp = dp_current_modspec->obj; |
*rp = dp_current_modspec->obj; |
} |
} |
|
|
|
extern int dpm_ispot; |
|
|
|
void Pdpm_ord(NODE arg,LIST *rp) |
|
{ |
|
Q q; |
|
NODE nd; |
|
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); |
|
nd = mknode(2,q,dp_current_spec->obj); |
|
MKLIST(*rp,nd); |
|
} |
|
|
|
void Pdpm_hm(NODE arg,DPM *rp) |
|
{ |
|
DPM p; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_hm"); |
|
dpm_hm(p,rp); |
|
} |
|
|
|
void Pdpm_ht(NODE arg,DPM *rp) |
|
{ |
|
DPM p; |
|
|
|
p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dp_ht"); |
|
dpm_ht(p,rp); |
|
} |
|
|
|
void Pdpm_hc(NODE arg,Obj *rp) |
|
{ |
|
asir_assert(ARG0(arg),O_DPM,"dpm_hc"); |
|
if ( !ARG0(arg) ) |
|
*rp = 0; |
|
else |
|
*rp = BDY((DPM)ARG0(arg))->c; |
|
} |
|
|
|
|
void Pdpv_ht(NODE arg,LIST *rp) |
void Pdpv_ht(NODE arg,LIST *rp) |
{ |
{ |
NODE n; |
NODE n; |
DP ht; |
DP ht; |
int pos; |
int pos; |
DPV p; |
DPV p; |
Q q; |
Q q; |
|
|
asir_assert(ARG0(arg),O_DPV,"dpv_ht"); |
asir_assert(ARG0(arg),O_DPV,"dpv_ht"); |
p = (DPV)ARG0(arg); |
p = (DPV)ARG0(arg); |
pos = dpv_hp(p); |
pos = dpv_hp(p); |
if ( pos < 0 ) |
if ( pos < 0 ) |
ht = 0; |
ht = 0; |
else |
else |
dp_ht(BDY(p)[pos],&ht); |
dp_ht(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOQ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
void Pdpv_hm(NODE arg,LIST *rp) |
void Pdpv_hm(NODE arg,LIST *rp) |
{ |
{ |
NODE n; |
NODE n; |
DP ht; |
DP ht; |
int pos; |
int pos; |
DPV p; |
DPV p; |
Q q; |
Q q; |
|
|
asir_assert(ARG0(arg),O_DPV,"dpv_hm"); |
asir_assert(ARG0(arg),O_DPV,"dpv_hm"); |
p = (DPV)ARG0(arg); |
p = (DPV)ARG0(arg); |
pos = dpv_hp(p); |
pos = dpv_hp(p); |
if ( pos < 0 ) |
if ( pos < 0 ) |
ht = 0; |
ht = 0; |
else |
else |
dp_hm(BDY(p)[pos],&ht); |
dp_hm(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOQ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
void Pdpv_hc(NODE arg,LIST *rp) |
void Pdpv_hc(NODE arg,LIST *rp) |
{ |
{ |
NODE n; |
NODE n; |
P hc; |
P hc; |
int pos; |
int pos; |
DPV p; |
DPV p; |
Q q; |
Q q; |
|
|
asir_assert(ARG0(arg),O_DPV,"dpv_hc"); |
asir_assert(ARG0(arg),O_DPV,"dpv_hc"); |
p = (DPV)ARG0(arg); |
p = (DPV)ARG0(arg); |
pos = dpv_hp(p); |
pos = dpv_hp(p); |
if ( pos < 0 ) |
if ( pos < 0 ) |
hc = 0; |
hc = 0; |
else |
else |
hc = BDY(BDY(p)[pos])->c; |
hc = (P)BDY(BDY(p)[pos])->c; |
STOQ(pos,q); |
STOQ(pos,q); |
n = mknode(2,q,hc); |
n = mknode(2,q,hc); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
int dpv_hp(DPV p) |
int dpv_hp(DPV p) |
{ |
{ |
int len,i,maxp,maxw,w,slen; |
int len,i,maxp,maxw,w,slen; |
int *shift; |
int *shift; |
DP *e; |
DP *e; |
|
|
len = p->len; |
len = p->len; |
e = p->body; |
e = p->body; |
slen = dp_current_modspec->len; |
slen = dp_current_modspec->len; |
shift = dp_current_modspec->degree_shift; |
shift = dp_current_modspec->degree_shift; |
switch ( dp_current_modspec->id ) { |
switch ( dp_current_modspec->id ) { |
case ORD_REVGRADLEX: |
case ORD_REVGRADLEX: |
for ( maxp = -1, i = 0; i < len; i++ ) |
for ( maxp = -1, i = 0; i < len; i++ ) |
if ( !e[i] ) continue; |
if ( !e[i] ) continue; |
else if ( maxp < 0 ) { |
else if ( maxp < 0 ) { |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
} else { |
} else { |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
if ( w >= maxw ) { |
if ( w >= maxw ) { |
maxw = w; maxp = i; |
maxw = w; maxp = i; |
} |
} |
} |
} |
return maxp; |
return maxp; |
case ORD_GRADLEX: |
case ORD_GRADLEX: |
for ( maxp = -1, i = 0; i < len; i++ ) |
for ( maxp = -1, i = 0; i < len; i++ ) |
if ( !e[i] ) continue; |
if ( !e[i] ) continue; |
else if ( maxp < 0 ) { |
else if ( maxp < 0 ) { |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
} else { |
} else { |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
if ( w > maxw ) { |
if ( w > maxw ) { |
maxw = w; maxp = i; |
maxw = w; maxp = i; |
} |
} |
} |
} |
return maxp; |
return maxp; |
break; |
break; |
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; |
return -1; |
break; |
break; |
} |
} |
|
} |
|
|
|
int get_opt(char *key0,Obj *r) { |
|
NODE tt,p; |
|
char *key; |
|
|
|
if ( current_option ) { |
|
for ( tt = current_option; tt; tt = NEXT(tt) ) { |
|
p = BDY((LIST)BDY(tt)); |
|
key = BDY((STRING)BDY(p)); |
|
/* value = (Obj)BDY(NEXT(p)); */ |
|
if ( !strcmp(key,key0) ) { |
|
*r = (Obj)BDY(NEXT(p)); |
|
return 1; |
|
} |
|
} |
|
} |
|
return 0; |
} |
} |