| version 1.4, 2000/07/14 08:26:39 |
version 1.108, 2018/03/29 01:32:50 |
|
|
| /* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.3 2000/05/29 08:54:45 noro Exp $ */ |
/* |
| |
* Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED |
| |
* All rights reserved. |
| |
* |
| |
* FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited, |
| |
* non-exclusive and royalty-free license to use, copy, modify and |
| |
* redistribute, solely for non-commercial and non-profit purposes, the |
| |
* 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 |
| |
* third party developer retains all rights, including but not limited to |
| |
* copyrights, in and to the SOFTWARE. |
| |
* |
| |
* (1) FLL does not grant you a license in any way for commercial |
| |
* purposes. You may use the SOFTWARE only for non-commercial and |
| |
* non-profit purposes only, such as academic, research and internal |
| |
* business use. |
| |
* (2) The SOFTWARE is protected by the Copyright Law of Japan and |
| |
* international copyright treaties. If you make copies of the SOFTWARE, |
| |
* with or without modification, as permitted hereunder, you shall affix |
| |
* to all such copies of the SOFTWARE the above copyright notice. |
| |
* (3) An explicit reference to this SOFTWARE and its copyright owner |
| |
* shall be made on your publication or presentation in any form of the |
| |
* results obtained by use of the SOFTWARE. |
| |
* (4) In the event that you modify the SOFTWARE, you shall notify FLL by |
| |
* e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification |
| |
* for such modification or the source code of the modified part of the |
| |
* SOFTWARE. |
| |
* |
| |
* THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL |
| |
* MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND |
| |
* EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS |
| |
* FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES' |
| |
* RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY |
| |
* MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY. |
| |
* UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT, |
| |
* OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY |
| |
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL |
| |
* DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES |
| |
* ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES |
| |
* FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY |
| |
* DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF |
| |
* SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART |
| |
* OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY |
| |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
| |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
| |
* |
| |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.107 2017/09/14 01:34:53 noro Exp $ |
| |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "base.h" |
#include "base.h" |
| #include "parse.h" |
#include "parse.h" |
| |
|
| extern int dp_fcoeffs; |
extern int dp_fcoeffs; |
| |
extern int dp_nelim; |
| |
extern int dp_order_pair_length; |
| |
extern struct order_pair *dp_order_pair; |
| |
extern struct order_spec *dp_current_spec; |
| |
extern struct modorder_spec *dp_current_modspec; |
| |
extern int nd_rref2; |
| |
|
| void Pdp_ord(), Pdp_ptod(), Pdp_dtop(); |
int do_weyl; |
| |
|
| |
void Pdp_sort(); |
| |
void Pdp_mul_trunc(),Pdp_quo(); |
| |
void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize(); |
| void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble(); |
void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble(); |
| void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar(); |
void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar(); |
| |
void Pdp_set_sugar(); |
| void Pdp_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_nf_ptozp(); |
void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(),Pdp_true_nf_marked_mod(); |
| |
|
| |
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_nf_demand(),Pdp_sp_mod(); |
void Pdp_minp(),Pdp_sp_mod(); |
| void Pdp_homo(),Pdp_dehomo(); |
void Pdp_homo(),Pdp_dehomo(); |
| void Pdp_gr_mod_main(); |
void Pdp_gr_mod_main(),Pdp_gr_f_main(); |
| void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags(); |
void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags(); |
| void Pdp_f4_main(),Pdp_f4_mod_main(); |
void Pdp_interreduce(); |
| |
void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main(); |
| void Pdp_gr_print(); |
void Pdp_gr_print(); |
| |
void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f(); |
| |
void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep(); |
| |
void Pdp_cont(); |
| |
void Pdp_gr_checklist(); |
| |
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_sp(); |
| |
|
| |
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_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main(); |
| |
void Pdp_weyl_mul(),Pdp_weyl_mul_mod(),Pdp_weyl_act(); |
| |
void Pdp_weyl_set_weight(); |
| |
void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight(); |
| |
void Pdp_nf_f(),Pdp_weyl_nf_f(); |
| |
void Pdpm_nf_f(),Pdpm_weyl_nf_f(); |
| |
void Pdp_lnf_f(); |
| |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); |
| |
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_nf(),Pnd_weyl_nf(); |
| |
void Pdp_initial_term(); |
| |
void Pdp_order(); |
| |
void Pdp_inv_or_split(); |
| |
void Pdp_compute_last_t(); |
| |
void Pdp_compute_last_w(); |
| |
void Pdp_compute_essential_df(); |
| |
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_order(); |
| |
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
| |
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); |
| |
|
| struct ftab dp_tab[] = { |
struct ftab dp_tab[] = { |
| {"dp_ord",Pdp_ord,-1}, |
/* content reduction */ |
| {"dp_ptod",Pdp_ptod,2}, |
{"dp_ptozp",Pdp_ptozp,1}, |
| {"dp_dtop",Pdp_dtop,2}, |
{"dp_ptozp2",Pdp_ptozp2,2}, |
| {"dp_ptozp",Pdp_ptozp,1}, |
{"dp_prim",Pdp_prim,1}, |
| {"dp_ptozp2",Pdp_ptozp2,2}, |
{"dp_red_coef",Pdp_red_coef,2}, |
| {"dp_prim",Pdp_prim,1}, |
{"dp_cont",Pdp_cont,1}, |
| {"dp_redble",Pdp_redble,2}, |
|
| {"dp_subd",Pdp_subd,2}, |
/* polynomial ring */ |
| {"dp_red",Pdp_red,3}, |
/* special operations */ |
| {"dp_red_mod",Pdp_red_mod,4}, |
{"dp_mul_trunc",Pdp_mul_trunc,3}, |
| {"dp_sp",Pdp_sp,2}, |
{"dp_quo",Pdp_quo,2}, |
| {"dp_sp_mod",Pdp_sp_mod,3}, |
|
| {"dp_lcm",Pdp_lcm,2}, |
/* s-poly */ |
| {"dp_hm",Pdp_hm,1}, |
{"dp_sp",Pdp_sp,2}, |
| {"dp_ht",Pdp_ht,1}, |
{"dp_sp_mod",Pdp_sp_mod,3}, |
| {"dp_hc",Pdp_hc,1}, |
|
| {"dp_rest",Pdp_rest,1}, |
/* m-reduction */ |
| {"dp_td",Pdp_td,1}, |
{"dp_red",Pdp_red,3}, |
| {"dp_sugar",Pdp_sugar,1}, |
{"dp_red_mod",Pdp_red_mod,4}, |
| {"dp_cri1",Pdp_cri1,2}, |
|
| {"dp_cri2",Pdp_cri2,2}, |
/* normal form */ |
| {"dp_criB",Pdp_criB,3}, |
{"dp_nf",Pdp_nf,4}, |
| {"dp_minp",Pdp_minp,2}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
| {"dp_mod",Pdp_mod,3}, |
{"dp_nf_f",Pdp_nf_f,4}, |
| {"dp_rat",Pdp_rat,1}, |
{"dpm_nf_f",Pdpm_nf_f,4}, |
| {"dp_tdiv",Pdp_tdiv,2}, |
{"dpm_weyl_nf_f",Pdpm_weyl_nf_f,4}, |
| {"dp_red_coef",Pdp_red_coef,2}, |
{"dpm_nf",Pdpm_nf,4}, |
| {"dp_nelim",Pdp_nelim,-1}, |
{"dpm_sp",Pdpm_sp,2}, |
| {"dp_mag",Pdp_mag,1}, |
{"dpm_weyl_sp",Pdpm_weyl_sp,2}, |
| {"dp_set_kara",Pdp_set_kara,-1}, |
|
| {"dp_nf",Pdp_nf,4}, |
{"dp_true_nf",Pdp_true_nf,4}, |
| {"dp_true_nf",Pdp_true_nf,4}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
| {"dp_nf_ptozp",Pdp_nf_ptozp,5}, |
{"dp_true_nf_marked",Pdp_true_nf_marked,4}, |
| {"dp_nf_demand",Pdp_nf_demand,5}, |
{"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5}, |
| {"dp_nf_mod",Pdp_nf_mod,5}, |
|
| {"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dp_true_nf_and_quotient",Pdp_true_nf_and_quotient,3}, |
| {"dp_homo",Pdp_homo,1}, |
{"dp_true_nf_and_quotient_mod",Pdp_true_nf_and_quotient_mod,4}, |
| {"dp_dehomo",Pdp_dehomo,1}, |
{"dp_true_nf_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4}, |
| {"dp_gr_main",Pdp_gr_main,5}, |
{"dp_true_nf_and_quotient_marked_mod",Pdp_true_nf_and_quotient_marked_mod,5}, |
| /* {"dp_gr_hm_main",Pdp_gr_hm_main,5}, */ |
|
| /* {"dp_gr_d_main",Pdp_gr_d_main,6}, */ |
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
| {"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
{"dp_nf_tab_f",Pdp_nf_tab_f,2}, |
| {"dp_f4_main",Pdp_f4_main,3}, |
{"dp_nf_tab_mod",Pdp_nf_tab_mod,3}, |
| {"dp_f4_mod_main",Pdp_f4_mod_main,4}, |
{"dp_lnf_f",Pdp_lnf_f,2}, |
| {"dp_gr_flags",Pdp_gr_flags,-1}, |
|
| {"dp_gr_print",Pdp_gr_print,-1}, |
/* Buchberger algorithm */ |
| {0,0,0}, |
{"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 */ |
| |
/* multiplication */ |
| |
{"dp_weyl_mul",Pdp_weyl_mul,2}, |
| |
{"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3}, |
| |
{"dp_weyl_act",Pdp_weyl_act,2}, |
| |
|
| |
/* s-poly */ |
| |
{"dp_weyl_sp",Pdp_weyl_sp,2}, |
| |
|
| |
/* m-reduction */ |
| |
{"dp_weyl_red",Pdp_weyl_red,3}, |
| |
|
| |
/* normal form */ |
| |
{"dp_weyl_nf",Pdp_weyl_nf,4}, |
| |
{"dpm_weyl_nf",Pdpm_weyl_nf,4}, |
| |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
| |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
| |
|
| |
{"dp_weyl_true_nf_and_quotient",Pdp_weyl_true_nf_and_quotient,3}, |
| |
{"dp_weyl_true_nf_and_quotient_mod",Pdp_weyl_true_nf_and_quotient_mod,4}, |
| |
{"dp_weyl_true_nf_and_quotient_marked",Pdp_weyl_true_nf_and_quotient_marked,4}, |
| |
{"dp_weyl_true_nf_and_quotient_marked_mod",Pdp_weyl_true_nf_and_quotient_marked_mod,5}, |
| |
|
| |
|
| |
/* Buchberger algorithm */ |
| |
{"dp_weyl_gr_main",Pdp_weyl_gr_main,-5}, |
| |
{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5}, |
| |
{"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4}, |
| |
|
| |
/* F4 algorithm */ |
| |
{"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}, |
| }; |
}; |
| |
|
| extern int dp_nelim; |
struct ftab dp_supp_tab[] = { |
| extern int dp_order_pair_length; |
/* setting flags */ |
| extern struct order_pair *dp_order_pair; |
{"dp_sort",Pdp_sort,1}, |
| extern struct order_spec dp_current_spec; |
{"dp_ord",Pdp_ord,-1}, |
| |
{"dpm_ord",Pdpm_ord,-1}, |
| |
{"dpv_ord",Pdpv_ord,-2}, |
| |
{"dp_set_kara",Pdp_set_kara,-1}, |
| |
{"dp_nelim",Pdp_nelim,-1}, |
| |
{"dp_gr_flags",Pdp_gr_flags,-1}, |
| |
{"dp_gr_print",Pdp_gr_print,-1}, |
| |
|
| void Pdp_ord(arg,rp) |
/* converters */ |
| NODE arg; |
{"homogenize",Phomogenize,3}, |
| Obj *rp; |
{"dp_ptod",Pdp_ptod,-2}, |
| |
{"dp_dtop",Pdp_dtop,2}, |
| |
{"dp_homo",Pdp_homo,1}, |
| |
{"dp_dehomo",Pdp_dehomo,1}, |
| |
{"dp_etov",Pdp_etov,1}, |
| |
{"dp_vtoe",Pdp_vtoe,1}, |
| |
{"dp_dtov",Pdp_dtov,1}, |
| |
{"dp_mdtod",Pdp_mdtod,1}, |
| |
{"dp_mod",Pdp_mod,3}, |
| |
{"dp_rat",Pdp_rat,1}, |
| |
{"dp_ltod",Pdp_ltod,-2}, |
| |
|
| |
{"dpm_ltod",Pdpm_ltod,2}, |
| |
{"dpm_dtol",Pdpm_dtol,3}, |
| |
|
| |
/* criteria */ |
| |
{"dp_cri1",Pdp_cri1,2}, |
| |
{"dp_cri2",Pdp_cri2,2}, |
| |
{"dp_criB",Pdp_criB,3}, |
| |
|
| |
/* simple operation */ |
| |
{"dp_subd",Pdp_subd,2}, |
| |
{"dp_lcm",Pdp_lcm,2}, |
| |
{"dp_hm",Pdp_hm,1}, |
| |
{"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}, |
| |
|
| |
/* degree and size */ |
| |
{"dp_td",Pdp_td,1}, |
| |
{"dp_mag",Pdp_mag,1}, |
| |
{"dp_sugar",Pdp_sugar,1}, |
| |
{"dp_set_sugar",Pdp_set_sugar,2}, |
| |
|
| |
/* 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); |
| |
Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp); |
| |
|
| |
void Pdp_compute_last_t(NODE arg,LIST *rp) |
| { |
{ |
| struct order_spec spec; |
NODE g,gh,homo,n; |
| |
LIST hlist; |
| |
VECT v1,v2,w; |
| |
Q t; |
| |
|
| if ( !arg ) |
g = (NODE)BDY((LIST)ARG0(arg)); |
| *rp = dp_current_spec.obj; |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| else if ( !create_order_spec((Obj)ARG0(arg),&spec) ) |
t = (Q)ARG2(arg); |
| error("dp_ord : invalid order specification"); |
v1 = (VECT)ARG3(arg); |
| else { |
v2 = (VECT)ARG4(arg); |
| initd(&spec); *rp = spec.obj; |
t = compute_last_t(g,gh,t,v1,v2,&homo,&w); |
| } |
MKLIST(hlist,homo); |
| |
n = mknode(3,t,w,hlist); |
| |
MKLIST(*rp,n); |
| } |
} |
| |
|
| int create_order_spec(obj,spec) |
void Pdp_compute_last_w(NODE arg,LIST *rp) |
| Obj obj; |
|
| struct order_spec *spec; |
|
| { |
{ |
| int i,j,n,s,row,col; |
NODE g,gh,r; |
| struct order_pair *l; |
VECT w,rv; |
| NODE node,t,tn; |
LIST l; |
| MAT m; |
MAT w1,w2; |
| pointer **b; |
int row1,row2,i,j,n; |
| int **w; |
int *v; |
| |
int **m1,**m2; |
| |
Q q; |
| |
|
| if ( !obj || NUM(obj) ) { |
g = (NODE)BDY((LIST)ARG0(arg)); |
| spec->id = 0; spec->obj = obj; |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| spec->ord.simple = QTOS((Q)obj); |
w = (VECT)ARG2(arg); |
| return 1; |
w1 = (MAT)ARG3(arg); |
| } else if ( OID(obj) == O_LIST ) { |
w2 = (MAT)ARG4(arg); |
| node = BDY((LIST)obj); |
n = w1->col; |
| for ( n = 0, t = node; t; t = NEXT(t), n++ ); |
row1 = w1->row; |
| l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); |
row2 = w2->row; |
| for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { |
if ( w ) { |
| tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); |
v = W_ALLOC(n); |
| tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
| s += l[i].length; |
} else v = 0; |
| } |
m1 = almat(row1,n); |
| spec->id = 1; spec->obj = obj; |
for ( i = 0; i < row1; i++ ) |
| spec->ord.block.order_pair = l; |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
| spec->ord.block.length = n; spec->nv = s; |
m2 = almat(row2,n); |
| return 1; |
for ( i = 0; i < row2; i++ ) |
| } else if ( OID(obj) == O_MAT ) { |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
| m = (MAT)obj; row = m->row; col = m->col; b = BDY(m); |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
| w = almat(row,col); |
if ( !r ) *rp = 0; |
| for ( i = 0; i < row; i++ ) |
else { |
| for ( j = 0; j < col; j++ ) |
MKVECT(rv,n); |
| w[i][j] = QTOS((Q)b[i][j]); |
for ( i = 0; i < n; i++ ) { |
| spec->id = 2; spec->obj = obj; |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
| spec->nv = col; spec->ord.matrix.row = row; |
} |
| spec->ord.matrix.matrix = w; |
MKLIST(l,r); |
| return 1; |
r = mknode(2,rv,l); |
| } else |
MKLIST(*rp,r); |
| return 0; |
} |
| } |
} |
| |
|
| void homogenize_order(old,n,new) |
NODE compute_essential_df(DP *g,DP *gh,int n); |
| struct order_spec *old,*new; |
|
| int n; |
void Pdp_compute_essential_df(NODE arg,LIST *rp) |
| { |
{ |
| struct order_pair *l; |
VECT g,gh; |
| int length,nv,row,i,j; |
NODE r; |
| int **newm,**oldm; |
|
| |
|
| switch ( old->id ) { |
g = (VECT)ARG0(arg); |
| case 0: |
gh = (VECT)ARG1(arg); |
| switch ( old->ord.simple ) { |
r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len); |
| case 0: |
MKLIST(*rp,r); |
| new->id = 0; new->ord.simple = 0; break; |
|
| case 1: |
|
| l = (struct order_pair *) |
|
| MALLOC_ATOMIC(2*sizeof(struct order_pair)); |
|
| l[0].length = n; l[0].order = 1; |
|
| l[1].length = 1; l[1].order = 2; |
|
| new->id = 1; |
|
| new->ord.block.order_pair = l; |
|
| new->ord.block.length = 2; new->nv = n+1; |
|
| break; |
|
| case 2: |
|
| new->id = 0; new->ord.simple = 1; break; |
|
| case 3: case 4: case 5: |
|
| new->id = 0; new->ord.simple = old->ord.simple+3; |
|
| dp_nelim = n-1; break; |
|
| case 6: case 7: case 8: case 9: |
|
| new->id = 0; new->ord.simple = old->ord.simple; break; |
|
| default: |
|
| error("homogenize_order : invalid input"); |
|
| } |
|
| break; |
|
| case 1: |
|
| length = old->ord.block.length; |
|
| l = (struct order_pair *) |
|
| MALLOC_ATOMIC((length+1)*sizeof(struct order_pair)); |
|
| bcopy((char *)old->ord.block.order_pair,(char *)l,length*sizeof(struct order_pair)); |
|
| l[length].order = 2; l[length].length = 1; |
|
| new->id = 1; new->nv = n+1; |
|
| new->ord.block.order_pair = l; |
|
| new->ord.block.length = length+1; |
|
| break; |
|
| case 2: |
|
| nv = old->nv; row = old->ord.matrix.row; |
|
| oldm = old->ord.matrix.matrix; newm = almat(row+1,nv+1); |
|
| for ( i = 0; i <= nv; i++ ) |
|
| newm[0][i] = 1; |
|
| for ( i = 0; i < row; i++ ) { |
|
| for ( j = 0; j < nv; j++ ) |
|
| newm[i+1][j] = oldm[i][j]; |
|
| newm[i+1][j] = 0; |
|
| } |
|
| new->id = 2; new->nv = nv+1; |
|
| new->ord.matrix.row = row+1; new->ord.matrix.matrix = newm; |
|
| break; |
|
| default: |
|
| error("homogenize_order : invalid input"); |
|
| } |
|
| } |
} |
| |
|
| void Pdp_ptod(arg,rp) |
void Pdp_inv_or_split(NODE arg,Obj *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| NODE n; |
NODE gb,newgb; |
| VL vl,tvl; |
DP f,inv; |
| |
struct order_spec *spec; |
| |
LIST list; |
| |
|
| asir_assert(ARG0(arg),O_P,"dp_ptod"); |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
| for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) { |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
| if ( !vl ) { |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
| NEWVL(vl); tvl = vl; |
error("dp_inv_or_split : invalid order specification"); |
| } else { |
gb = BDY((LIST)ARG0(arg)); |
| NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
f = (DP)ARG1(arg); |
| } |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
| VR(tvl) = VR((P)BDY(n)); |
if ( !newgb ) { |
| } |
/* invertible */ |
| if ( vl ) |
*rp = (Obj)inv; |
| NEXT(tvl) = 0; |
} else { |
| ptod(CO,vl,(P)ARG0(arg),rp); |
MKLIST(list,newgb); |
| |
*rp = (Obj)list; |
| |
} |
| } |
} |
| |
|
| void Pdp_dtop(arg,rp) |
void Pdp_sort(NODE arg,DP *rp) |
| NODE arg; |
|
| P *rp; |
|
| { |
{ |
| NODE n; |
dp_sort((DP)ARG0(arg),rp); |
| VL vl,tvl; |
} |
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_dtop"); |
void Pdp_mdtod(NODE arg,DP *rp) |
| asir_assert(ARG1(arg),O_LIST,"dp_dtop"); |
{ |
| for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) { |
MP m,mr,mr0; |
| if ( !vl ) { |
DP p; |
| NEWVL(vl); tvl = vl; |
P t; |
| } else { |
|
| NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
p = (DP)ARG0(arg); |
| } |
if ( !p ) |
| VR(tvl) = VR((P)BDY(n)); |
*rp = 0; |
| } |
else { |
| if ( vl ) |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
| NEXT(tvl) = 0; |
mptop((P)m->c,&t); NEXTMP(mr0,mr); mr->c = (Obj)t; mr->dl = m->dl; |
| dtop(CO,vl,(DP)ARG0(arg),rp); |
} |
| |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
| |
} |
| } |
} |
| |
|
| extern LIST Dist; |
void Pdp_sep(NODE arg,VECT *rp) |
| |
{ |
| |
DP p,r; |
| |
MP m,t; |
| |
MP *w0,*w; |
| |
int i,n,d,nv,sugar; |
| |
VECT v; |
| |
pointer *pv; |
| |
|
| void Pdp_ptozp(arg,rp) |
p = (DP)ARG0(arg); m = BDY(p); |
| NODE arg; |
d = QTOS((Q)ARG1(arg)); |
| DP *rp; |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
| |
if ( d > n ) |
| |
d = n; |
| |
MKVECT(v,d); *rp = v; |
| |
pv = BDY(v); nv = p->nv; sugar = p->sugar; |
| |
w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,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 ) { |
| |
NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl; |
| |
} |
| |
for ( i = 0; i < d; i++ ) { |
| |
NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar; |
| |
pv[i] = (pointer)r; |
| |
} |
| |
} |
| |
|
| |
void Pdp_idiv(NODE arg,DP *rp) |
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp); |
| #if INET |
|
| if ( Dist ) |
|
| dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp); |
|
| else |
|
| #endif |
|
| dp_ptozp((DP)ARG0(arg),rp); |
|
| } |
} |
| |
|
| void Pdp_ptozp2(arg,rp) |
void Pdp_cont(NODE arg,Q *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| DP p0,p1,h,r; |
dp_cont((DP)ARG0(arg),rp); |
| NODE n0; |
} |
| |
|
| p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
void Pdp_dtov(NODE arg,VECT *rp) |
| asir_assert(p0,O_DP,"dp_ptozp2"); |
{ |
| asir_assert(p1,O_DP,"dp_ptozp2"); |
dp_dtov((DP)ARG0(arg),rp); |
| #if INET |
|
| if ( Dist ) |
|
| dp_ptozp2_d(BDY(Dist),length(BDY(Dist)),p0,p1,&h,&r); |
|
| else |
|
| #endif |
|
| dp_ptozp2(p0,p1,&h,&r); |
|
| NEWNODE(n0); BDY(n0) = (pointer)h; |
|
| NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
|
| NEXT(NEXT(n0)) = 0; |
|
| MKLIST(*rp,n0); |
|
| } |
} |
| |
|
| void Pdp_prim(arg,rp) |
void Pdp_mbase(NODE arg,LIST *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP t; |
NODE mb; |
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_prim"); |
asir_assert(ARG0(arg),O_LIST,"dp_mbase"); |
| dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
dp_mbase(BDY((LIST)ARG0(arg)),&mb); |
| |
MKLIST(*rp,mb); |
| } |
} |
| |
|
| extern int NoGCD; |
|
| |
|
| void dp_prim(p,rp) |
void Pdp_etov(NODE arg,VECT *rp) |
| DP p,*rp; |
|
| { |
{ |
| P t,g; |
DP dp; |
| DP p1; |
int n,i; |
| MP m,mr,mr0; |
int *d; |
| int i,n; |
VECT v; |
| P *w; |
Q t; |
| Q *c; |
|
| Q dvr; |
|
| |
|
| if ( !p ) |
dp = (DP)ARG0(arg); |
| *rp = 0; |
asir_assert(dp,O_DP,"dp_etov"); |
| else if ( dp_fcoeffs ) |
n = dp->nv; d = BDY(dp)->dl->d; |
| *rp = p; |
MKVECT(v,n); |
| else if ( NoGCD ) |
for ( i = 0; i < n; i++ ) { |
| dp_ptozp(p,rp); |
STOQ(d[i],t); v->body[i] = (pointer)t; |
| else { |
} |
| dp_ptozp(p,&p1); p = p1; |
*rp = v; |
| for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ ); |
|
| if ( n == 1 ) { |
|
| m = BDY(p); |
|
| NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; |
|
| MKDP(p->nv,mr,*rp); (*rp)->sugar = p->sugar; |
|
| return; |
|
| } |
|
| w = (P *)ALLOCA(n*sizeof(P)); |
|
| c = (Q *)ALLOCA(n*sizeof(Q)); |
|
| for ( m =BDY(p), i = 0; i < n; m = NEXT(m), i++ ) |
|
| if ( NUM(m->c) ) { |
|
| c[i] = (Q)m->c; w[i] = (P)ONE; |
|
| } else |
|
| ptozp(m->c,1,&c[i],&w[i]); |
|
| qltozl(c,n,&dvr); heu_nezgcdnpz(CO,w,n,&t); mulp(CO,t,(P)dvr,&g); |
|
| if ( NUM(g) ) |
|
| *rp = p; |
|
| else { |
|
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
| NEXTMP(mr0,mr); divsp(CO,m->c,g,&mr->c); mr->dl = m->dl; |
|
| } |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } |
|
| } |
|
| } |
} |
| |
|
| void heu_nezgcdnpz(vl,pl,m,pr) |
void Pdp_vtoe(NODE arg,DP *rp) |
| VL vl; |
|
| P *pl,*pr; |
|
| int m; |
|
| { |
{ |
| int i,r; |
DP dp; |
| P gcd,t,s1,s2,u; |
DL dl; |
| Q rq; |
MP m; |
| |
int n,i,td; |
| while ( 1 ) { |
int *d; |
| for ( i = 0, s1 = 0; i < m; i++ ) { |
VECT v; |
| r = random(); UTOQ(r,rq); |
|
| mulp(vl,pl[i],(P)rq,&t); addp(vl,s1,t,&u); s1 = u; |
v = (VECT)ARG0(arg); |
| } |
asir_assert(v,O_VECT,"dp_vtoe"); |
| for ( i = 0, s2 = 0; i < m; i++ ) { |
n = v->len; |
| r = random(); UTOQ(r,rq); |
NEWDL(dl,n); d = dl->d; |
| mulp(vl,pl[i],(P)rq,&t); addp(vl,s2,t,&u); s2 = u; |
for ( i = 0, td = 0; i < n; i++ ) { |
| } |
d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
| ezgcdp(vl,s1,s2,&gcd); |
} |
| for ( i = 0; i < m; i++ ) { |
dl->td = td; |
| if ( !divtpz(vl,pl[i],gcd,&t) ) |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
| break; |
MKDP(n,m,dp); dp->sugar = td; |
| } |
*rp = dp; |
| if ( i == m ) |
|
| break; |
|
| } |
|
| *pr = gcd; |
|
| } |
} |
| |
|
| void dp_prim_mod(p,mod,rp) |
void Pdp_lnf_mod(NODE arg,LIST *rp) |
| int mod; |
|
| DP p,*rp; |
|
| { |
{ |
| P t,g; |
DP r1,r2; |
| MP m,mr,mr0; |
NODE b,g,n; |
| |
int mod; |
| |
|
| if ( !p ) |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod"); |
| *rp = 0; |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
| else if ( NoGCD ) |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
| *rp = p; |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
| else { |
mod = QTOS((Q)ARG2(arg)); |
| for ( m = BDY(p), g = m->c, m = NEXT(m); m; m = NEXT(m) ) { |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
| gcdprsmp(CO,mod,g,m->c,&t); g = t; |
NEWNODE(n); BDY(n) = (pointer)r1; |
| } |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| NEXTMP(mr0,mr); divsmp(CO,mod,m->c,g,&mr->c); mr->dl = m->dl; |
|
| } |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } |
|
| } |
} |
| |
|
| void Pdp_mod(arg,rp) |
void Pdp_lnf_f(NODE arg,LIST *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP p; |
DP r1,r2; |
| int mod; |
NODE b,g,n; |
| NODE subst; |
|
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_f"); |
| asir_assert(ARG1(arg),O_N,"dp_mod"); |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_f"); |
| asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
| p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg)); |
dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2); |
| subst = BDY((LIST)ARG2(arg)); |
NEWNODE(n); BDY(n) = (pointer)r1; |
| dp_mod(p,mod,subst,rp); |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void Pdp_rat(arg,rp) |
void Pdp_nf_tab_mod(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_rat"); |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod"); |
| dp_rat((DP)ARG0(arg),rp); |
asir_assert(ARG1(arg),O_VECT,"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)), |
| |
QTOS((Q)ARG2(arg)),rp); |
| } |
} |
| |
|
| void dp_mod(p,mod,subst,rp) |
void Pdp_nf_tab_f(NODE arg,DP *rp) |
| DP p; |
|
| int mod; |
|
| NODE subst; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f"); |
| P t,s,s1; |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f"); |
| V v; |
dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp); |
| NODE tn; |
} |
| |
|
| if ( !p ) |
void Pdp_ord(NODE arg,Obj *rp) |
| *rp = 0; |
{ |
| else { |
struct order_spec *spec; |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
LIST v; |
| for ( tn = subst, s = m->c; tn; tn = NEXT(tn) ) { |
struct oLIST f; |
| v = VR((P)BDY(tn)); tn = NEXT(tn); |
Num homo; |
| substp(CO,s,v,(P)BDY(tn),&s1); s = s1; |
int modular; |
| } |
|
| ptomp(mod,s,&t); |
f.id = O_LIST; f.body = 0; |
| if ( t ) { |
if ( !arg && !current_option ) |
| NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl; |
*rp = dp_current_spec->obj; |
| } |
else { |
| } |
if ( current_option ) |
| if ( mr0 ) { |
parse_gr_option(&f,current_option,&v,&homo,&modular,&spec); |
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
| } else |
error("dp_ord : invalid order specification"); |
| *rp = 0; |
initd(spec); *rp = spec->obj; |
| } |
} |
| } |
} |
| |
|
| void dp_rat(p,rp) |
void Pdp_ptod(NODE arg,DP *rp) |
| DP p; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
P p; |
| |
NODE n; |
| |
VL vl,tvl; |
| |
struct oLIST f; |
| |
int ac; |
| |
LIST v; |
| |
Num homo; |
| |
int modular; |
| |
struct order_spec *ord; |
| |
|
| if ( !p ) |
asir_assert(ARG0(arg),O_P,"dp_ptod"); |
| *rp = 0; |
p = (P)ARG0(arg); |
| else { |
ac = argc(arg); |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
if ( ac == 1 ) { |
| NEXTMP(mr0,mr); mptop(m->c,&mr->c); mr->dl = m->dl; |
if ( current_option ) { |
| } |
f.id = O_LIST; f.body = mknode(1,p); |
| if ( mr0 ) { |
parse_gr_option(&f,current_option,&v,&homo,&modular,&ord); |
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
initd(ord); |
| } else |
} else |
| *rp = 0; |
error("dp_ptod : invalid argument"); |
| } |
} else { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
| |
v = (LIST)ARG1(arg); |
| |
} |
| |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| |
if ( !vl ) { |
| |
NEWVL(vl); tvl = vl; |
| |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) |
| |
NEXT(tvl) = 0; |
| |
ptod(CO,vl,p,rp); |
| } |
} |
| |
|
| void Pdp_nf(arg,rp) |
void Phomogenize(NODE arg,Obj *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| NODE b; |
P p; |
| DP *ps; |
DP d,h; |
| DP g; |
NODE n; |
| int full; |
V hv; |
| |
VL vl,tvl,last; |
| |
struct oLIST f; |
| |
LIST v; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
asir_assert(ARG0(arg),O_P,"homogenize"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf"); |
p = (P)ARG0(arg); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
asir_assert(ARG1(arg),O_LIST,"homogenize"); |
| asir_assert(ARG3(arg),O_N,"dp_nf"); |
v = (LIST)ARG1(arg); |
| if ( !(g = (DP)ARG1(arg)) ) { |
asir_assert(ARG2(arg),O_P,"homogenize"); |
| *rp = 0; return; |
hv = VR((P)ARG2(arg)); |
| } |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
if ( !vl ) { |
| full = (Q)ARG3(arg) ? 1 : 0; |
NEWVL(vl); tvl = vl; |
| dp_nf(b,g,ps,full,rp); |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) { |
| |
last = tvl; |
| |
NEXT(tvl) = 0; |
| |
} |
| |
ptod(CO,vl,p,&d); |
| |
dp_homo(d,&h); |
| |
NEWVL(NEXT(last)); last = NEXT(last); |
| |
VR(last) = hv; NEXT(last) = 0; |
| |
dtop(CO,vl,h,rp); |
| } |
} |
| |
|
| void Pdp_true_nf(arg,rp) |
void Pdp_ltod(NODE arg,DPV *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| NODE b,n; |
NODE n; |
| DP *ps; |
VL vl,tvl; |
| DP g; |
LIST f,v; |
| DP nm; |
int sugar,i,len,ac,modular; |
| P dn; |
Num homo; |
| int full; |
struct order_spec *ord; |
| |
DP *e; |
| |
NODE nd,t; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
ac = argc(arg); |
| asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_ptod"); |
| asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
f = (LIST)ARG0(arg); |
| asir_assert(ARG3(arg),O_N,"dp_nf"); |
if ( ac == 1 ) { |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( current_option ) { |
| nm = 0; dn = (P)ONE; |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| } else { |
initd(ord); |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
} else |
| full = (Q)ARG3(arg) ? 1 : 0; |
error("dp_ltod : invalid argument"); |
| dp_true_nf(b,g,ps,full,&nm,&dn); |
} else { |
| } |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
| NEWNODE(n); BDY(n) = (pointer)nm; |
v = (LIST)ARG1(arg); |
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
} |
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| |
if ( !vl ) { |
| |
NEWVL(vl); tvl = vl; |
| |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) |
| |
NEXT(tvl) = 0; |
| |
|
| |
nd = BDY(f); |
| |
len = length(nd); |
| |
e = (DP *)MALLOC(len*sizeof(DP)); |
| |
sugar = 0; |
| |
for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) { |
| |
ptod(CO,vl,(P)BDY(t),&e[i]); |
| |
if ( e[i] ) |
| |
sugar = MAX(sugar,e[i]->sugar); |
| |
} |
| |
MKDPV(len,e,*rp); |
| } |
} |
| |
|
| void dp_nf(b,g,ps,full,rp) |
void Pdpm_ltod(NODE arg,DPM *rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int full; |
|
| DP *rp; |
|
| { |
{ |
| DP u,p,d,s,t,dmy1; |
NODE n; |
| P dmy; |
VL vl,tvl; |
| NODE l; |
LIST f,v; |
| MP m,mr; |
int i,len; |
| int i,n; |
NODE nd; |
| int *wb; |
NODE t; |
| int sugar,psugar; |
DP d; |
| |
DPM s,u,w; |
| |
|
| if ( !g ) { |
f = (LIST)ARG0(arg); |
| *rp = 0; return; |
v = (LIST)ARG1(arg); |
| } |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
if ( !vl ) { |
| wb = (int *)ALLOCA(n*sizeof(int)); |
NEWVL(vl); tvl = vl; |
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
} else { |
| wb[i] = QTOS((Q)BDY(l)); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| sugar = g->sugar; |
} |
| for ( d = 0; g; ) { |
VR(tvl) = VR((P)BDY(n)); |
| for ( u = 0, i = 0; i < n; i++ ) { |
} |
| if ( dp_redble(g,p = ps[wb[i]]) ) { |
if ( vl ) |
| dp_red(d,g,p,&t,&u,&dmy,&dmy1); |
NEXT(tvl) = 0; |
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
|
| sugar = MAX(sugar,psugar); |
nd = BDY(f); |
| if ( !u ) { |
len = length(nd); |
| if ( d ) |
for ( i = 0, t = nd, s = 0; i < len; i++, t = NEXT(t) ) { |
| d->sugar = sugar; |
ptod(CO,vl,(P)BDY(t),&d); |
| *rp = d; return; |
dtodpm(d,i,&u); |
| } |
adddpm(CO,s,u,&w); s = w; |
| d = t; |
} |
| break; |
*rp = s; |
| } |
|
| } |
|
| if ( u ) |
|
| g = u; |
|
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addd(CO,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; |
|
| } |
} |
| |
|
| void dp_true_nf(b,g,ps,full,rp,dnp) |
void Pdpm_dtol(NODE arg,LIST *rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int full; |
|
| DP *rp; |
|
| P *dnp; |
|
| { |
{ |
| DP u,p,d,s,t,dmy; |
DPM a; |
| NODE l; |
NODE nd,nd1; |
| MP m,mr; |
VL vl,tvl; |
| int i,n; |
int n,len,i,pos,nv; |
| int *wb; |
MP *w; |
| int sugar,psugar; |
DMM t; |
| P dn,tdn,tdn1; |
DMM *wa; |
| |
MP m; |
| |
DP u; |
| |
Obj s; |
| |
|
| dn = (P)ONE; |
a = (DPM)ARG0(arg); |
| if ( !g ) { |
for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) { |
| *rp = 0; *dnp = dn; return; |
if ( !vl ) { |
| } |
NEWVL(vl); tvl = vl; |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
} else { |
| wb = (int *)ALLOCA(n*sizeof(int)); |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
} |
| wb[i] = QTOS((Q)BDY(l)); |
VR(tvl) = VR((P)BDY(nd)); |
| sugar = g->sugar; |
} |
| for ( d = 0; g; ) { |
if ( vl ) |
| for ( u = 0, i = 0; i < n; i++ ) { |
NEXT(tvl) = 0; |
| if ( dp_redble(g,p = ps[wb[i]]) ) { |
n = QTOS((Q)ARG2(arg)); |
| dp_red(d,g,p,&t,&u,&tdn,&dmy); |
w = (MP *)CALLOC(n,sizeof(MP)); |
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
| sugar = MAX(sugar,psugar); |
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
| if ( !u ) { |
for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) wa[i] = t; |
| if ( d ) |
for ( i = len-1; i >= 0; i-- ) { |
| d->sugar = sugar; |
NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]); |
| *rp = d; *dnp = dn; return; |
pos = wa[i]->pos; |
| } else { |
NEXT(m) = w[pos]; |
| d = t; |
w[pos] = m; |
| mulp(CO,dn,tdn,&tdn1); dn = tdn1; |
} |
| } |
nd = 0; |
| break; |
for ( i = n-1; i >= 0; i-- ) { |
| } |
MKDP(nv,w[i],u); u->sugar = a->sugar; /* XXX */ |
| } |
dtop(CO,vl,u,&s); |
| if ( u ) |
MKNODE(nd1,s,nd); nd = nd1; |
| g = u; |
} |
| else if ( !full ) { |
MKLIST(*rp,nd); |
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; *dnp = dn; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addd(CO,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; *dnp = dn; |
|
| } |
} |
| |
|
| #define HMAG(p) (p_mag(BDY(p)->c)) |
void Pdp_dtop(NODE arg,Obj *rp) |
| |
{ |
| |
NODE n; |
| |
VL vl,tvl; |
| |
|
| void Pdp_nf_ptozp(arg,rp) |
asir_assert(ARG0(arg),O_DP,"dp_dtop"); |
| NODE arg; |
asir_assert(ARG1(arg),O_LIST,"dp_dtop"); |
| DP *rp; |
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; |
| |
|
| |
void Pdp_ptozp(NODE arg,Obj *rp) |
| { |
{ |
| NODE b; |
Q t; |
| DP g; |
NODE tt,p; |
| DP *ps; |
NODE n,n0; |
| int full,multiple; |
char *key; |
| |
DP pp; |
| |
LIST list; |
| |
int get_factor=0; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp"); |
asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp"); |
|
| asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp"); |
/* analyze the option */ |
| asir_assert(ARG3(arg),O_N,"dp_nf_ptozp"); |
if ( current_option ) { |
| asir_assert(ARG4(arg),O_N,"dp_nf_ptozp"); |
for ( tt = current_option; tt; tt = NEXT(tt) ) { |
| if ( !(g = (DP)ARG1(arg)) ) { |
p = BDY((LIST)BDY(tt)); |
| *rp = 0; return; |
key = BDY((STRING)BDY(p)); |
| } |
/* value = (Obj)BDY(NEXT(p)); */ |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
if ( !strcmp(key,"factor") ) get_factor=1; |
| full = (Q)ARG3(arg) ? 1 : 0; |
else { |
| multiple = QTOS((Q)ARG4(arg)); |
error("ptozp: unknown option."); |
| dp_nf_ptozp(b,g,ps,full,multiple,rp); |
} |
| |
} |
| |
} |
| |
|
| |
dp_ptozp3((DP)ARG0(arg),&t,&pp); |
| |
|
| |
/* printexpr(NULL,t); */ |
| |
/* if the option factor is given, then it returns the answer |
| |
in the format [zpoly, num] where num*zpoly is equal to the argument.*/ |
| |
if (get_factor) { |
| |
n0 = mknode(2,pp,t); |
| |
MKLIST(list,n0); |
| |
*rp = (Obj)list; |
| |
} else |
| |
*rp = (Obj)pp; |
| } |
} |
| |
|
| |
void Pdp_ptozp2(NODE arg,LIST *rp) |
| |
{ |
| |
DP p0,p1,h,r; |
| |
NODE n0; |
| |
|
| void dp_nf_ptozp(b,g,ps,full,multiple,rp) |
p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
| NODE b; |
asir_assert(p0,O_DP,"dp_ptozp2"); |
| DP g; |
asir_assert(p1,O_DP,"dp_ptozp2"); |
| DP *ps; |
dp_ptozp2(p0,p1,&h,&r); |
| int full,multiple; |
NEWNODE(n0); BDY(n0) = (pointer)h; |
| DP *rp; |
NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
| |
NEXT(NEXT(n0)) = 0; |
| |
MKLIST(*rp,n0); |
| |
} |
| |
|
| |
void Pdp_prim(NODE arg,DP *rp) |
| { |
{ |
| DP u,p,d,s,t,dmy1; |
DP t; |
| P dmy; |
|
| NODE l; |
|
| MP m,mr; |
|
| int i,n; |
|
| int *wb; |
|
| int hmag; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
asir_assert(ARG0(arg),O_DP,"dp_prim"); |
| *rp = 0; return; |
dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
| } |
|
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
|
| wb = (int *)ALLOCA(n*sizeof(int)); |
|
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
|
| wb[i] = QTOS((Q)BDY(l)); |
|
| hmag = multiple*HMAG(g); |
|
| sugar = g->sugar; |
|
| for ( d = 0; g; ) { |
|
| for ( u = 0, i = 0; i < n; i++ ) { |
|
| if ( dp_redble(g,p = ps[wb[i]]) ) { |
|
| dp_red(d,g,p,&t,&u,&dmy,&dmy1); |
|
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
|
| sugar = MAX(sugar,psugar); |
|
| if ( !u ) { |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; return; |
|
| } |
|
| d = t; |
|
| break; |
|
| } |
|
| } |
|
| if ( u ) { |
|
| g = u; |
|
| if ( d ) { |
|
| if ( HMAG(d) > hmag ) { |
|
| dp_ptozp2(d,g,&t,&u); d = t; g = u; |
|
| hmag = multiple*HMAG(d); |
|
| } |
|
| } else { |
|
| if ( HMAG(g) > hmag ) { |
|
| dp_ptozp(g,&t); g = t; |
|
| hmag = multiple*HMAG(g); |
|
| } |
|
| } |
|
| } |
|
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addd(CO,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; |
|
| } |
} |
| |
|
| |
void Pdp_mod(NODE arg,DP *rp) |
| |
{ |
| |
DP p; |
| |
int mod; |
| |
NODE subst; |
| |
|
| void Pdp_nf_demand(arg,rp) |
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
| NODE arg; |
asir_assert(ARG1(arg),O_N,"dp_mod"); |
| DP *rp; |
asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
| |
p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg)); |
| |
subst = BDY((LIST)ARG2(arg)); |
| |
dp_mod(p,mod,subst,rp); |
| |
} |
| |
|
| |
void Pdp_rat(NODE arg,DP *rp) |
| { |
{ |
| DP g,u,p,d,s,t,dmy1; |
asir_assert(ARG0(arg),O_DP,"dp_rat"); |
| P dmy; |
dp_rat((DP)ARG0(arg),rp); |
| NODE b,l; |
} |
| DP *hps; |
|
| MP m,mr; |
|
| int i,n; |
|
| int *wb; |
|
| int full; |
|
| char *fprefix; |
|
| int sugar,psugar; |
|
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_demand"); |
extern int DP_Multiple; |
| asir_assert(ARG1(arg),O_DP,"dp_nf_demand"); |
|
| asir_assert(ARG2(arg),O_N,"dp_nf_demand"); |
|
| asir_assert(ARG3(arg),O_VECT,"dp_nf_demand"); |
|
| asir_assert(ARG4(arg),O_STR,"dp_nf_demand"); |
|
| if ( !(g = (DP)ARG1(arg)) ) { |
|
| *rp = 0; return; |
|
| } |
|
| b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0; |
|
| hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg)); |
|
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
|
| wb = (int *)ALLOCA(n*sizeof(int)); |
|
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
|
| wb[i] = QTOS((Q)BDY(l)); |
|
| sugar = g->sugar; |
|
| for ( d = 0; g; ) { |
|
| for ( u = 0, i = 0; i < n; i++ ) { |
|
| if ( dp_redble(g,hps[wb[i]]) ) { |
|
| FILE *fp; |
|
| char fname[BUFSIZ]; |
|
| |
|
| sprintf(fname,"%s%d",fprefix,wb[i]); |
void Pdp_nf(NODE arg,DP *rp) |
| fprintf(stderr,"loading %s\n",fname); |
{ |
| fp = fopen(fname,"r"); skipvl(fp); |
NODE b; |
| loadobj(fp,(Obj *)&p); fclose(fp); |
DP *ps; |
| dp_red(d,g,p,&t,&u,&dmy,&dmy1); |
DP g; |
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
int full; |
| sugar = MAX(sugar,psugar); |
|
| if ( !u ) { |
do_weyl = 0; dp_fcoeffs = 0; |
| if ( d ) |
asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
| d->sugar = sugar; |
asir_assert(ARG1(arg),O_DP,"dp_nf"); |
| *rp = d; return; |
asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
| } |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
| d = t; |
if ( !(g = (DP)ARG1(arg)) ) { |
| break; |
*rp = 0; return; |
| } |
} |
| } |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| if ( u ) |
full = (Q)ARG3(arg) ? 1 : 0; |
| g = u; |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addd(CO,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; |
|
| } |
} |
| |
|
| void Pdp_nf_mod(arg,rp) |
void Pdp_weyl_nf(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| NODE b; |
NODE b; |
| DP g; |
DP *ps; |
| DP *ps; |
DP g; |
| int mod,full,ac; |
int full; |
| |
|
| ac = argc(arg); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
| asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf"); |
| asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
if ( !(g = (DP)ARG1(arg)) ) { |
| asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
*rp = 0; return; |
| if ( !(g = (DP)ARG1(arg)) ) { |
} |
| *rp = 0; return; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| } |
full = (Q)ARG3(arg) ? 1 : 0; |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
do_weyl = 1; |
| full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
| dp_nf_mod_qindex(b,g,ps,mod,full,rp); |
do_weyl = 0; |
| } |
} |
| |
|
| void Pdp_true_nf_mod(arg,rp) |
void Pdpm_nf(NODE arg,DP *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| NODE b; |
NODE b; |
| DP g,nm; |
DPM *ps; |
| P dn; |
DPM g; |
| DP *ps; |
int full; |
| int mod,full; |
|
| NODE n; |
|
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
if ( !(g = (DPM)ARG1(arg)) ) { |
| asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
*rp = 0; return; |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
} |
| asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dpm_nf"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
asir_assert(ARG1(arg),O_DPM,"dpm_nf"); |
| nm = 0; dn = (P)ONEM; |
asir_assert(ARG2(arg),O_VECT,"dpm_nf"); |
| } else { |
asir_assert(ARG3(arg),O_N,"dpm_nf"); |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
| full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = (Q)ARG3(arg) ? 1 : 0; |
| dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
| } |
|
| NEWNODE(n); BDY(n) = (pointer)nm; |
|
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
|
| } |
} |
| |
|
| void dp_nf_mod_qindex(b,g,ps,mod,full,rp) |
void Pdpm_weyl_nf(NODE arg,DPM *rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| { |
{ |
| DP u,p,d,s,t; |
NODE b; |
| P dmy; |
DPM *ps; |
| NODE l; |
DPM g; |
| MP m,mr; |
int full; |
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
if ( !(g = (DPM)ARG1(arg)) ) { |
| *rp = 0; return; |
*rp = 0; return; |
| } |
} |
| sugar = g->sugar; |
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf"); |
| for ( d = 0; g; ) { |
asir_assert(ARG1(arg),O_DPM,"dpm_weyl_nf"); |
| for ( u = 0, l = b; l; l = NEXT(l) ) { |
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf"); |
| if ( dp_redble(g,p = ps[QTOS((Q)BDY(l))]) ) { |
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf"); |
| dp_red_mod(d,g,p,mod,&t,&u,&dmy); |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
full = (Q)ARG3(arg) ? 1 : 0; |
| sugar = MAX(sugar,psugar); |
do_weyl = 1; |
| if ( !u ) { |
dpm_nf_z(b,g,ps,full,DP_Multiple,rp); |
| if ( d ) |
do_weyl = 0; |
| d->sugar = sugar; |
|
| *rp = d; return; |
|
| } |
|
| d = t; |
|
| break; |
|
| } |
|
| } |
|
| if ( u ) |
|
| g = u; |
|
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addmd(CO,mod,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; |
|
| } |
} |
| |
|
| void dp_nf_mod(b,g,ps,mod,full,rp) |
/* nf computation using field operations */ |
| NODE b; |
|
| DP g; |
void Pdp_nf_f(NODE arg,DP *rp) |
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| { |
{ |
| DP u,p,d,s,t; |
NODE b; |
| P dmy; |
DP *ps; |
| NODE l; |
DP g; |
| MP m,mr; |
int full; |
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
do_weyl = 0; |
| *rp = 0; return; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_f"); |
| } |
asir_assert(ARG1(arg),O_DP,"dp_nf_f"); |
| sugar = g->sugar; |
asir_assert(ARG2(arg),O_VECT,"dp_nf_f"); |
| for ( d = 0; g; ) { |
asir_assert(ARG3(arg),O_N,"dp_nf_f"); |
| for ( u = 0, l = b; l; l = NEXT(l) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| if ( dp_redble(g,p = ps[(int)BDY(l)]) ) { |
*rp = 0; return; |
| dp_red_mod(d,g,p,mod,&t,&u,&dmy); |
} |
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| sugar = MAX(sugar,psugar); |
full = (Q)ARG3(arg) ? 1 : 0; |
| if ( !u ) { |
dp_nf_f(b,g,ps,full,rp); |
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; return; |
|
| } |
|
| d = t; |
|
| break; |
|
| } |
|
| } |
|
| if ( u ) |
|
| g = u; |
|
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addmd(CO,mod,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; |
|
| } |
} |
| |
|
| void dp_true_nf_mod(b,g,ps,mod,full,rp,dnp) |
void Pdp_weyl_nf_f(NODE arg,DP *rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| P *dnp; |
|
| { |
{ |
| DP u,p,d,s,t; |
NODE b; |
| NODE l; |
DP *ps; |
| MP m,mr; |
DP g; |
| int i,n; |
int full; |
| int *wb; |
|
| int sugar,psugar; |
|
| P dn,tdn,tdn1; |
|
| |
|
| dn = (P)ONEM; |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f"); |
| if ( !g ) { |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f"); |
| *rp = 0; *dnp = dn; return; |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f"); |
| } |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f"); |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
if ( !(g = (DP)ARG1(arg)) ) { |
| wb = (int *)ALLOCA(n*sizeof(int)); |
*rp = 0; return; |
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
} |
| wb[i] = QTOS((Q)BDY(l)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| sugar = g->sugar; |
full = (Q)ARG3(arg) ? 1 : 0; |
| for ( d = 0; g; ) { |
do_weyl = 1; |
| for ( u = 0, i = 0; i < n; i++ ) { |
dp_nf_f(b,g,ps,full,rp); |
| if ( dp_redble(g,p = ps[wb[i]]) ) { |
do_weyl = 0; |
| dp_red_mod(d,g,p,mod,&t,&u,&tdn); |
|
| psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar; |
|
| sugar = MAX(sugar,psugar); |
|
| if ( !u ) { |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; *dnp = dn; return; |
|
| } else { |
|
| d = t; |
|
| mulmp(CO,mod,dn,tdn,&tdn1); dn = tdn1; |
|
| } |
|
| break; |
|
| } |
|
| } |
|
| if ( u ) |
|
| g = u; |
|
| else if ( !full ) { |
|
| if ( g ) { |
|
| MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t; |
|
| } |
|
| *rp = g; *dnp = dn; return; |
|
| } else { |
|
| m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c; |
|
| NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td; |
|
| addmd(CO,mod,d,t,&s); d = s; |
|
| dp_rest(g,&t); g = t; |
|
| } |
|
| } |
|
| if ( d ) |
|
| d->sugar = sugar; |
|
| *rp = d; *dnp = dn; |
|
| } |
} |
| |
|
| void Pdp_tdiv(arg,rp) |
void Pdpm_nf_f(NODE arg,DPM *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
NODE b; |
| DP p; |
DPM *ps; |
| Q c; |
DPM g; |
| N d,q,r; |
int full; |
| int sgn; |
|
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_tdiv"); |
if ( !(g = (DPM)ARG1(arg)) ) { |
| asir_assert(ARG1(arg),O_N,"dp_tdiv"); |
*rp = 0; return; |
| p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg)); |
} |
| if ( !p ) |
asir_assert(ARG0(arg),O_LIST,"dpm_nf_f"); |
| *rp = 0; |
asir_assert(ARG1(arg),O_DPM,"dpm_nf_f"); |
| else { |
asir_assert(ARG2(arg),O_VECT,"dpm_nf_f"); |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
asir_assert(ARG3(arg),O_N,"dpm_nf_f"); |
| divn(NM((Q)m->c),d,&q,&r); |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
| if ( r ) { |
full = (Q)ARG3(arg) ? 1 : 0; |
| *rp = 0; return; |
dpm_nf_f(b,g,ps,full,rp); |
| } else { |
|
| NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c); |
|
| mr->c = (P)c; mr->dl = m->dl; |
|
| } |
|
| } |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } |
|
| } |
} |
| |
|
| void Pdp_red_coef(arg,rp) |
void Pdpm_weyl_nf_f(NODE arg,DPM *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
NODE b; |
| P q,r; |
DPM *ps; |
| DP p; |
DPM g; |
| P mod; |
int full; |
| |
|
| p = (DP)ARG0(arg); mod = (P)ARG1(arg); |
if ( !(g = (DPM)ARG1(arg)) ) { |
| asir_assert(p,O_DP,"dp_red_coef"); |
*rp = 0; return; |
| asir_assert(mod,O_P,"dp_red_coef"); |
} |
| if ( !p ) |
asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f"); |
| *rp = 0; |
asir_assert(ARG1(arg),O_DP,"dpm_weyl_nf_f"); |
| else { |
asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f"); |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
asir_assert(ARG3(arg),O_N,"dpm_weyl_nf_f"); |
| divsrp(CO,m->c,mod,&q,&r); |
b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg)); |
| if ( r ) { |
full = (Q)ARG3(arg) ? 1 : 0; |
| NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl; |
do_weyl = 1; |
| } |
dpm_nf_f(b,g,ps,full,rp); |
| } |
do_weyl = 0; |
| if ( mr0 ) { |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } else |
|
| *rp = 0; |
|
| } |
|
| } |
} |
| |
|
| void qltozl(w,n,dvr) |
|
| Q *w,*dvr; |
void Pdp_nf_mod(NODE arg,DP *rp) |
| int n; |
|
| { |
{ |
| N nm,dn; |
NODE b; |
| N g,l1,l2,l3; |
DP g; |
| Q c,d; |
DP *ps; |
| int i; |
int mod,full,ac; |
| struct oVECT v; |
NODE n,n0; |
| |
|
| for ( i = 0; i < n; i++ ) |
do_weyl = 0; |
| if ( w[i] && !INT(w[i]) ) |
ac = argc(arg); |
| break; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
| if ( i == n ) { |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
| v.id = O_VECT; v.len = n; v.body = (pointer *)w; |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
| igcdv(&v,dvr); return; |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
| } |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
| c = w[0]; nm = NM(c); dn = INT(c) ? ONEN : DN(c); |
if ( !(g = (DP)ARG1(arg)) ) { |
| for ( i = 1; i < n; i++ ) { |
*rp = 0; return; |
| c = w[i]; l1 = INT(c) ? ONEN : DN(c); |
} |
| gcdn(nm,NM(c),&g); nm = g; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| gcdn(dn,l1,&l2); muln(dn,l1,&l3); divsn(l3,l2,&dn); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
| } |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
| if ( UNIN(dn) ) |
NEXTNODE(n0,n); |
| NTOQ(nm,1,d); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
| else |
} |
| NDTOQ(nm,dn,1,d); |
if ( n0 ) |
| *dvr = d; |
NEXT(n) = 0; |
| |
dp_nf_mod(n0,g,ps,mod,full,rp); |
| } |
} |
| |
|
| int comp_nm(a,b) |
void Pdp_true_nf(NODE arg,LIST *rp) |
| Q *a,*b; |
|
| { |
{ |
| return cmpn((*a)?NM(*a):0,(*b)?NM(*b):0); |
NODE b,n; |
| |
DP *ps; |
| |
DP g; |
| |
DP nm; |
| |
P dn; |
| |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
| |
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); |
| } |
} |
| |
|
| void sortbynm(w,n) |
DP *dp_true_nf_and_quotient_marked(NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp); |
| Q *w; |
|
| int n; |
void Pdp_true_nf_and_quotient_marked(NODE arg,LIST *rp) |
| { |
{ |
| qsort(w,n,sizeof(Q),(int (*)(const void *,const void *))comp_nm); |
NODE b,n; |
| |
DP *ps,*hps; |
| |
DP g; |
| |
DP nm; |
| |
VECT quo; |
| |
P dn; |
| |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
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(ARG2(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)) ) { |
| |
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_redble(arg,rp) |
void Pdp_true_nf_and_quotient(NODE arg,LIST *rp) |
| NODE arg; |
|
| Q *rp; |
|
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_redble"); |
NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg)); |
| asir_assert(ARG1(arg),O_DP,"dp_redble"); |
Pdp_true_nf_and_quotient_marked(narg,rp); |
| if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) ) |
|
| *rp = ONE; |
|
| else |
|
| *rp = 0; |
|
| } |
} |
| |
|
| void Pdp_red_mod(arg,rp) |
|
| NODE arg; |
DP *dp_true_nf_and_quotient_marked_mod (NODE b,DP g,DP *ps,DP *hps,int mod,DP *rp,P *dnp); |
| LIST *rp; |
|
| |
void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp) |
| { |
{ |
| DP h,r; |
NODE b,n; |
| P dmy; |
DP *ps,*hps; |
| NODE n; |
DP g; |
| |
DP nm; |
| |
VECT quo; |
| |
P dn; |
| |
int full,mod; |
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_red_mod"); |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked_mod"); |
| asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked_mod"); |
| asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
| dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)), |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
| &h,&r,&dmy); |
asir_assert(ARG4(arg),O_N,"dp_true_nf_and_quotient_marked_mod"); |
| NEWNODE(n); BDY(n) = (pointer)h; |
if ( !(g = (DP)ARG1(arg)) ) { |
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
nm = 0; dn = (P)ONE; |
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
} 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); |
| } |
} |
| |
|
| int dp_redble(p1,p2) |
void Pdp_true_nf_and_quotient_mod(NODE arg,LIST *rp) |
| DP p1,p2; |
|
| { |
{ |
| int i,n; |
NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg)); |
| DL d1,d2; |
Pdp_true_nf_and_quotient_marked_mod(narg,rp); |
| |
} |
| |
|
| d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
void Pdp_true_nf_marked(NODE arg,LIST *rp) |
| if ( d1->td < d2->td ) |
{ |
| return 0; |
NODE b,n; |
| else { |
DP *ps,*hps; |
| for ( i = 0, n = p1->nv; i < n; i++ ) |
DP g; |
| if ( d1->d[i] < d2->d[i] ) |
DP nm; |
| return 0; |
Q cont; |
| return 1; |
P dn; |
| } |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
| |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
nm = 0; dn = (P)ONE; |
| |
} else { |
| |
b = BDY((LIST)ARG0(arg)); |
| |
ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
hps = (DP *)BDY((VECT)ARG3(arg)); |
| |
dp_true_nf_marked(b,g,ps,hps,&nm,(P *)&cont,(P *)&dn); |
| |
} |
| |
n = mknode(3,nm,cont,dn); |
| |
MKLIST(*rp,n); |
| } |
} |
| |
|
| void dp_red_mod(p0,p1,p2,mod,head,rest,dnp) |
void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
| DP p0,p1,p2; |
|
| int mod; |
|
| DP *head,*rest; |
|
| P *dnp; |
|
| { |
{ |
| int i,n; |
NODE b,n; |
| DL d1,d2,d; |
DP *ps,*hps; |
| MP m; |
DP g; |
| DP t,s,r,h; |
DP nm; |
| P c1,c2,g,u; |
P dn; |
| |
int mod; |
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
do_weyl = 0; dp_fcoeffs = 0; |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod"); |
| for ( i = 0; i < n; i++ ) |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod"); |
| d->d[i] = d1->d[i]-d2->d[i]; |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod"); |
| c1 = (P)BDY(p1)->c; c2 = (P)BDY(p2)->c; |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod"); |
| gcdprsmp(CO,mod,c1,c2,&g); |
asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod"); |
| divsmp(CO,mod,c1,g,&u); c1 = u; divsmp(CO,mod,c2,g,&u); c2 = u; |
if ( !(g = (DP)ARG1(arg)) ) { |
| if ( NUM(c2) ) { |
nm = 0; dn = (P)ONE; |
| divsmp(CO,mod,c1,c2,&u); c1 = u; c2 = (P)ONEM; |
} else { |
| } |
b = BDY((LIST)ARG0(arg)); |
| NEWMP(m); m->dl = d; chsgnmp(mod,(P)c1,&m->c); NEXT(m) = 0; |
ps = (DP *)BDY((VECT)ARG2(arg)); |
| MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&t); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
| if ( NUM(c2) ) { |
mod = QTOS((Q)ARG4(arg)); |
| addmd(CO,mod,p1,t,&r); h = p0; |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
| } else { |
} |
| mulmdc(CO,mod,p1,c2,&s); addmd(CO,mod,s,t,&r); mulmdc(CO,mod,p0,c2,&h); |
n = mknode(2,nm,dn); |
| } |
MKLIST(*rp,n); |
| *head = h; *rest = r; *dnp = c2; |
|
| } |
} |
| |
|
| void Pdp_subd(arg,rp) |
void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP p1,p2; |
NODE b; |
| |
DP g; |
| |
DP *ps; |
| |
int mod,full,ac; |
| |
NODE n,n0; |
| |
|
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
ac = argc(arg); |
| asir_assert(p1,O_DP,"dp_subd"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod"); |
| asir_assert(p2,O_DP,"dp_subd"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod"); |
| dp_subd(p1,p2,rp); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod"); |
| |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod"); |
| |
asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
*rp = 0; return; |
| |
} |
| |
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; |
| |
do_weyl = 1; |
| |
dp_nf_mod(n0,g,ps,mod,full,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void dp_subd(p1,p2,rp) |
void Pdp_true_nf_mod(NODE arg,LIST *rp) |
| DP p1,p2; |
|
| DP *rp; |
|
| { |
{ |
| int i,n; |
NODE b; |
| DL d1,d2,d; |
DP g,nm; |
| MP m; |
P dn; |
| DP s; |
DP *ps; |
| |
int mod,full; |
| |
NODE n; |
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
do_weyl = 0; |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
| for ( i = 0; i < n; i++ ) |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
| d->d[i] = d1->d[i]-d2->d[i]; |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
| NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
| MKDP(n,m,s); s->sugar = d->td; |
asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
| *rp = s; |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
nm = 0; dn = (P)ONEM; |
| |
} else { |
| |
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); |
| |
} |
| |
NEWNODE(n); BDY(n) = (pointer)nm; |
| |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void dltod(d,n,rp) |
void Pdp_weyl_true_nf_and_quotient_marked(NODE arg,LIST *rp) |
| DL d; |
|
| int n; |
|
| DP *rp; |
|
| { |
{ |
| MP m; |
NODE b,n; |
| DP s; |
DP *ps,*hps; |
| |
DP g; |
| |
DP nm; |
| |
VECT quo; |
| |
P dn; |
| |
int full; |
| |
|
| NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
do_weyl = 1; dp_fcoeffs = 0; |
| MKDP(n,m,s); s->sugar = d->td; |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_true_nf_and_quotient_marked"); |
| *rp = s; |
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(arg,rp) |
void Pdp_weyl_true_nf_and_quotient(NODE arg,LIST *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| NODE n; |
NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg)); |
| DP head,rest,dmy1; |
Pdp_weyl_true_nf_and_quotient_marked(narg,rp); |
| P dmy; |
} |
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_red"); |
|
| asir_assert(ARG1(arg),O_DP,"dp_red"); |
void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp) |
| asir_assert(ARG2(arg),O_DP,"dp_red"); |
{ |
| dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
NODE b,n; |
| NEWNODE(n); BDY(n) = (pointer)head; |
DP *ps,*hps; |
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
DP g; |
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
DP nm; |
| |
VECT quo; |
| |
P dn; |
| |
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 dp_red(p0,p1,p2,head,rest,dnp,multp) |
void Pdp_weyl_true_nf_and_quotient_mod(NODE arg,LIST *rp) |
| DP p0,p1,p2; |
|
| DP *head,*rest; |
|
| P *dnp; |
|
| DP *multp; |
|
| { |
{ |
| int i,n; |
NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg)); |
| DL d1,d2,d; |
Pdp_weyl_true_nf_and_quotient_marked_mod(narg,rp); |
| MP m; |
} |
| DP t,s,r,h; |
|
| Q c,c1,c2; |
|
| N gn,tn; |
|
| P g,a; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
|
| NEWDL(d,n); d->td = d1->td - d2->td; |
void Pdp_tdiv(NODE arg,DP *rp) |
| for ( i = 0; i < n; i++ ) |
{ |
| d->d[i] = d1->d[i]-d2->d[i]; |
MP m,mr,mr0; |
| c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c; |
DP p; |
| if ( dp_fcoeffs ) { |
Q c; |
| /* do nothing */ |
N d,q,r; |
| } else if ( INT(c1) && INT(c2) ) { |
int sgn; |
| gcdn(NM(c1),NM(c2),&gn); |
|
| if ( !UNIN(gn) ) { |
asir_assert(ARG0(arg),O_DP,"dp_tdiv"); |
| divsn(NM(c1),gn,&tn); NTOQ(tn,SGN(c1),c); c1 = c; |
asir_assert(ARG1(arg),O_N,"dp_tdiv"); |
| divsn(NM(c2),gn,&tn); NTOQ(tn,SGN(c2),c); c2 = c; |
p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg)); |
| } |
if ( !p ) |
| } else { |
*rp = 0; |
| ezgcdpz(CO,(P)c1,(P)c2,&g); |
else { |
| divsp(CO,(P)c1,g,&a); c1 = (Q)a; divsp(CO,(P)c2,g,&a); c2 = (Q)a; |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
| } |
divn(NM((Q)m->c),d,&q,&r); |
| NEWMP(m); m->dl = d; chsgnp((P)c1,&m->c); NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td; |
if ( r ) { |
| *multp = s; |
*rp = 0; return; |
| muld(CO,s,p2,&t); muldc(CO,p1,(P)c2,&s); addd(CO,s,t,&r); |
} else { |
| muldc(CO,p0,(P)c2,&h); |
NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c); |
| *head = h; *rest = r; *dnp = (P)c2; |
mr->c = (Obj)c; mr->dl = m->dl; |
| |
} |
| |
} |
| |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
| |
} |
| } |
} |
| |
|
| void Pdp_sp(arg,rp) |
void Pdp_red_coef(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP p1,p2; |
MP m,mr,mr0; |
| |
P q,r; |
| |
DP p; |
| |
P mod; |
| |
|
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p = (DP)ARG0(arg); mod = (P)ARG1(arg); |
| asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
asir_assert(p,O_DP,"dp_red_coef"); |
| dp_sp(p1,p2,rp); |
asir_assert(mod,O_P,"dp_red_coef"); |
| |
if ( !p ) |
| |
*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; |
| |
} |
| } |
} |
| |
|
| extern int GenTrace; |
void Pdp_redble(NODE arg,Q *rp) |
| extern NODE TraceList; |
{ |
| |
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; |
| |
} |
| |
|
| void dp_sp(p1,p2,rp) |
void Pdp_red_mod(NODE arg,LIST *rp) |
| DP p1,p2; |
|
| DP *rp; |
|
| { |
{ |
| int i,n,td; |
DP h,r; |
| int *w; |
P dmy; |
| DL d1,d2,d; |
NODE n; |
| MP m; |
|
| DP t,s1,s2,u; |
|
| Q c,c1,c2; |
|
| N gn,tn; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
do_weyl = 0; |
| w = (int *)ALLOCA(n*sizeof(int)); |
asir_assert(ARG0(arg),O_DP,"dp_red_mod"); |
| for ( i = 0, td = 0; i < n; i++ ) { |
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
| w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; |
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); |
| |
} |
| |
|
| NEWDL(d,n); d->td = td - d1->td; |
void Pdp_subd(NODE arg,DP *rp) |
| for ( i = 0; i < n; i++ ) |
{ |
| d->d[i] = w[i] - d1->d[i]; |
DP p1,p2; |
| c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c; |
|
| if ( INT(c1) && INT(c2) ) { |
|
| gcdn(NM(c1),NM(c2),&gn); |
|
| if ( !UNIN(gn) ) { |
|
| divsn(NM(c1),gn,&tn); NTOQ(tn,SGN(c1),c); c1 = c; |
|
| divsn(NM(c2),gn,&tn); NTOQ(tn,SGN(c2),c); c2 = c; |
|
| } |
|
| } |
|
| |
|
| NEWMP(m); m->dl = d; m->c = (P)c2; NEXT(m) = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| MKDP(n,m,s1); s1->sugar = d->td; muld(CO,s1,p1,&t); |
asir_assert(p1,O_DP,"dp_subd"); |
| |
asir_assert(p2,O_DP,"dp_subd"); |
| |
dp_subd(p1,p2,rp); |
| |
} |
| |
|
| NEWDL(d,n); d->td = td - d2->td; |
void Pdp_symb_add(NODE arg,DP *rp) |
| for ( i = 0; i < n; i++ ) |
{ |
| d->d[i] = w[i] - d2->d[i]; |
DP p1,p2,r; |
| NEWMP(m); m->dl = d; m->c = (P)c1; NEXT(m) = 0; |
NODE s0; |
| MKDP(n,m,s2); s2->sugar = d->td; muld(CO,s2,p2,&u); |
MP mp0,mp; |
| |
int nv; |
| |
|
| subd(CO,t,u,rp); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| if ( GenTrace ) { |
asir_assert(p1,O_DP,"dp_symb_add"); |
| LIST hist; |
asir_assert(p2,O_DP,"dp_symb_add"); |
| NODE node; |
if ( !p1 ) { *rp = p2; return; } |
| |
else if ( !p2 ) { *rp = p1; return; } |
| |
if ( p1->nv != p2->nv ) |
| |
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; |
| |
} |
| |
|
| node = mknode(4,ONE,0,s1,ONE); |
void Pdp_mul_trunc(NODE arg,DP *rp) |
| MKLIST(hist,node); |
{ |
| MKNODE(TraceList,hist,0); |
DP p1,p2,p; |
| |
|
| node = mknode(4,ONE,0,0,ONE); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg); |
| chsgnd(s2,(DP *)&ARG2(node)); |
asir_assert(p1,O_DP,"dp_mul_trunc"); |
| MKLIST(hist,node); |
asir_assert(p2,O_DP,"dp_mul_trunc"); |
| MKNODE(node,hist,TraceList); TraceList = node; |
asir_assert(p,O_DP,"dp_mul_trunc"); |
| } |
comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp); |
| } |
} |
| |
|
| void Pdp_sp_mod(arg,rp) |
void Pdp_quo(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP p1,p2; |
DP p1,p2; |
| int mod; |
|
| |
|
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(p1,O_DP,"dp_quo"); |
| asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
asir_assert(p2,O_DP,"dp_quo"); |
| mod = QTOS((Q)ARG2(arg)); |
comm_quod(CO,p1,p2,rp); |
| dp_sp_mod(p1,p2,mod,rp); |
|
| } |
} |
| |
|
| void dp_sp_mod(p1,p2,mod,rp) |
void Pdp_weyl_mul(NODE arg,DP *rp) |
| DP p1,p2; |
|
| int mod; |
|
| DP *rp; |
|
| { |
{ |
| int i,n,td; |
DP p1,p2; |
| int *w; |
|
| DL d1,d2,d; |
|
| MP m; |
|
| DP t,s,u; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| w = (int *)ALLOCA(n*sizeof(int)); |
asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul"); |
| for ( i = 0, td = 0; i < n; i++ ) { |
do_weyl = 1; |
| w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; |
muld(CO,p1,p2,rp); |
| } |
do_weyl = 0; |
| NEWDL(d,n); d->td = td - d1->td; |
|
| for ( i = 0; i < n; i++ ) |
|
| d->d[i] = w[i] - d1->d[i]; |
|
| NEWMP(m); m->dl = d; m->c = (P)BDY(p2)->c; NEXT(m) = 0; |
|
| MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p1,s,&t); |
|
| NEWDL(d,n); d->td = td - d2->td; |
|
| for ( i = 0; i < n; i++ ) |
|
| d->d[i] = w[i] - d2->d[i]; |
|
| NEWMP(m); m->dl = d; m->c = (P)BDY(p1)->c; NEXT(m) = 0; |
|
| MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&u); |
|
| submd(CO,mod,t,u,rp); |
|
| } |
} |
| |
|
| void Pdp_lcm(arg,rp) |
void Pdp_weyl_act(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| int i,n,td; |
DP p1,p2; |
| DL d1,d2,d; |
|
| MP m; |
|
| 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_lcm"); asir_assert(p2,O_DP,"dp_lcm"); |
asir_assert(p1,O_DP,"dp_weyl_act"); asir_assert(p2,O_DP,"dp_weyl_act"); |
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
weyl_actd(CO,p1,p2,rp); |
| NEWDL(d,n); |
|
| for ( i = 0, td = 0; i < n; i++ ) { |
|
| d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i]; |
|
| } |
|
| d->td = td; |
|
| 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) |
|
| NODE arg; |
void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
| DP *rp; |
|
| { |
{ |
| DP p; |
DP p1,p2; |
| |
Q m; |
| |
|
| p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm"); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg); |
| dp_hm(p,rp); |
asir_assert(p1,O_DP,"dp_weyl_mul_mod"); |
| |
asir_assert(p2,O_DP,"dp_mul_mod"); |
| |
asir_assert(m,O_N,"dp_mul_mod"); |
| |
do_weyl = 1; |
| |
mulmd(CO,QTOS(m),p1,p2,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void dp_hm(p,rp) |
void Pdp_red(NODE arg,LIST *rp) |
| DP p; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr; |
NODE n; |
| |
DP head,rest,dmy1; |
| |
P dmy; |
| |
|
| if ( !p ) |
do_weyl = 0; |
| *rp = 0; |
asir_assert(ARG0(arg),O_DP,"dp_red"); |
| else { |
asir_assert(ARG1(arg),O_DP,"dp_red"); |
| m = BDY(p); |
asir_assert(ARG2(arg),O_DP,"dp_red"); |
| NEWMP(mr); mr->dl = m->dl; mr->c = m->c; NEXT(mr) = 0; |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
| MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */ |
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_weyl_red(NODE arg,LIST *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| DP p; |
NODE n; |
| MP m,mr; |
DP head,rest,dmy1; |
| |
P dmy; |
| |
|
| p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
asir_assert(ARG0(arg),O_DP,"dp_weyl_red"); |
| if ( !p ) |
asir_assert(ARG1(arg),O_DP,"dp_weyl_red"); |
| *rp = 0; |
asir_assert(ARG2(arg),O_DP,"dp_weyl_red"); |
| else { |
do_weyl = 1; |
| m = BDY(p); |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
| NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; |
do_weyl = 0; |
| MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */ |
NEWNODE(n); BDY(n) = (pointer)head; |
| } |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void Pdp_hc(arg,rp) |
void Pdp_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; |
do_weyl = 0; |
| else |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| *rp = BDY((DP)ARG0(arg))->c; |
asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
| |
dp_sp(p1,p2,rp); |
| } |
} |
| |
|
| void Pdp_rest(arg,rp) |
void Pdp_weyl_sp(NODE arg,DP *rp) |
| NODE arg; |
|
| DP *rp; |
|
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_rest"); |
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"); |
| dp_rest((DP)ARG0(arg),rp); |
do_weyl = 1; |
| |
dp_sp(p1,p2,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void dp_rest(p,rp) |
void Pdpm_sp(NODE arg,DPM *rp) |
| DP p,*rp; |
|
| { |
{ |
| MP m; |
DPM p1,p2; |
| |
|
| m = BDY(p); |
do_weyl = 0; |
| if ( !NEXT(m) ) |
p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg); |
| *rp = 0; |
asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp"); |
| else { |
dpm_sp(p1,p2,rp); |
| MKDP(p->nv,NEXT(m),*rp); |
|
| if ( *rp ) |
|
| (*rp)->sugar = p->sugar; |
|
| } |
|
| } |
} |
| |
|
| 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_cri1(arg,rp) |
void Pdp_lcm(NODE arg,DP *rp) |
| NODE arg; |
|
| Q *rp; |
|
| { |
{ |
| DP p1,p2; |
int i,n,td; |
| int *d1,*d2; |
DL d1,d2,d; |
| int i,n; |
MP m; |
| |
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_cri1"); asir_assert(p2,O_DP,"dp_cri1"); |
asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm"); |
| n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d; |
n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
| for ( i = 0; i < n; i++ ) |
NEWDL(d,n); |
| if ( d1[i] > d2[i] ) |
for ( i = 0, td = 0; i < n; i++ ) { |
| break; |
d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i); |
| *rp = i == n ? ONE : 0; |
} |
| |
d->td = td; |
| |
NEWMP(m); m->dl = d; m->c = (Obj)ONE; NEXT(m) = 0; |
| |
MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */ |
| } |
} |
| |
|
| void Pdp_cri2(arg,rp) |
void Pdp_hm(NODE arg,DP *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_hm"); |
| asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2"); |
dp_hm(p,rp); |
| 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(arg,rp) |
void Pdp_ht(NODE arg,DP *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| NODE tn,tn1,d,dd,dd0,p,tp; |
DP p; |
| LIST l,minp; |
MP m,mr; |
| DP lcm,tlcm; |
|
| int s,ts; |
|
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_minp"); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
| d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
dp_ht(p,rp); |
| 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(arg,rp) |
void Pdp_hc(NODE arg,Obj *rp) |
| NODE arg; |
|
| LIST *rp; |
|
| { |
{ |
| NODE d,ij,dd,ddd; |
asir_assert(ARG0(arg),O_DP,"dp_hc"); |
| int i,j,s,n; |
if ( !ARG0(arg) ) |
| DP *ps; |
*rp = 0; |
| DL ts,ti,tj,lij,tdl; |
else |
| |
*rp = BDY((DP)ARG0(arg))->c; |
| |
} |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
void Pdp_rest(NODE arg,DP *rp) |
| 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)); |
asir_assert(ARG0(arg),O_DP,"dp_rest"); |
| if ( !d ) |
if ( !ARG0(arg) ) |
| *rp = (LIST)ARG0(arg); |
*rp = 0; |
| else { |
else |
| ts = BDY(ps[s])->dl; |
dp_rest((DP)ARG0(arg),rp); |
| 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); |
|
| } |
|
| } |
} |
| |
|
| DL lcm_of_DL(nv,dl1,dl2,dl) |
void Pdp_td(NODE arg,Q *rp) |
| int nv; |
|
| DL dl1,dl2; |
|
| register DL dl; |
|
| { |
{ |
| register int n, *d1, *d2, *d, td; |
DP p; |
| |
|
| if ( !dl ) NEWDL(dl,nv); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td"); |
| d = dl->d, d1 = dl1->d, d2 = dl2->d; |
if ( !p ) |
| for ( td = 0, n = nv; --n >= 0; d1++, d2++, d++ ) |
*rp = 0; |
| td += (*d = *d1 > *d2 ? *d1 : *d2 ); |
else |
| dl->td = td; |
STOQ(BDY(p)->dl->td,*rp); |
| return dl; |
|
| } |
} |
| |
|
| int dl_equal(nv,dl1,dl2) |
void Pdp_sugar(NODE arg,Q *rp) |
| int nv; |
|
| DL dl1, dl2; |
|
| { |
{ |
| register int *d1, *d2, n; |
DP p; |
| |
|
| if ( dl1->td != dl2->td ) return 0; |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar"); |
| for ( d1 = dl1->d, d2 = dl2->d, n = nv; --n >= 0; d1++, d2++ ) |
if ( !p ) |
| if ( *d1 != *d2 ) return 0; |
*rp = 0; |
| return 1; |
else |
| |
STOQ(p->sugar,*rp); |
| } |
} |
| |
|
| void Pdp_nelim(arg,rp) |
void Pdp_initial_term(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,initiallist; |
| 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; |
| |
initiallist = dp_initial_term(f,ord); |
| |
if ( !is_list ) |
| |
*rp = (Obj)BDY(BDY(initiallist)); |
| |
else |
| |
*rp = (Obj)initiallist; |
| } |
} |
| |
|
| void Pdp_mag(arg,rp) |
void Pdp_order(NODE arg,Obj *rp) |
| NODE arg; |
|
| Q *rp; |
|
| { |
{ |
| DP p; |
struct order_spec *ord; |
| int s; |
Num homo; |
| MP m; |
int modular,is_list; |
| |
LIST v,f,l,ordlist; |
| |
NODE n; |
| |
|
| p = (DP)ARG0(arg); |
f = (LIST)ARG0(arg); |
| asir_assert(p,O_DP,"dp_mag"); |
if ( f && OID(f) == O_LIST ) |
| if ( !p ) |
is_list = 1; |
| *rp = 0; |
else { |
| else { |
n = mknode(1,f); MKLIST(l,n); f = l; |
| for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
is_list = 0; |
| s += p_mag(m->c); |
} |
| STOQ(s,*rp); |
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(NODE arg,Q *rp) |
| |
{ |
| |
DP p; |
| |
Q q; |
| |
int i; |
| |
|
| |
p = (DP)ARG0(arg); |
| |
q = (Q)ARG1(arg); |
| |
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(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 dp_homo(p,rp) |
void Pdp_dehomo(NODE arg,DP *rp) |
| DP p; |
|
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
| int i,n,nv,td; |
dp_dehomo((DP)ARG0(arg),rp); |
| DL dl,dlh; |
} |
| |
|
| if ( !p ) |
void Pdp_gr_flags(NODE arg,LIST *rp) |
| *rp = 0; |
{ |
| else { |
Obj name,value; |
| n = p->nv; nv = n + 1; |
NODE n; |
| m = BDY(p); td = sugard(m); |
|
| for ( mr0 = 0; m; m = NEXT(m) ) { |
if ( arg ) { |
| NEXTMP(mr0,mr); mr->c = m->c; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_flags"); |
| dl = m->dl; |
n = BDY((LIST)ARG0(arg)); |
| mr->dl = dlh = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
while ( n ) { |
| dlh->td = td; |
name = (Obj)BDY(n); n = NEXT(n); |
| for ( i = 0; i < n; i++ ) |
if ( !n ) |
| dlh->d[i] = dl->d[i]; |
break; |
| dlh->d[n] = td - dl->td; |
else { |
| } |
value = (Obj)BDY(n); n = NEXT(n); |
| NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar; |
} |
| } |
dp_set_flag(name,value); |
| |
} |
| |
} |
| |
dp_make_flaglist(rp); |
| } |
} |
| |
|
| void Pdp_dehomo(arg,rp) |
extern int DP_Print, DP_PrintShort; |
| NODE arg; |
|
| DP *rp; |
void Pdp_gr_print(NODE arg,Q *rp) |
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
Q q; |
| dp_dehomo((DP)ARG0(arg),rp); |
int s; |
| |
|
| |
if ( arg ) { |
| |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
| |
q = (Q)ARG0(arg); |
| |
s = QTOS(q); |
| |
switch ( s ) { |
| |
case 0: |
| |
DP_Print = 0; DP_PrintShort = 0; |
| |
break; |
| |
case 1: |
| |
DP_Print = 1; |
| |
break; |
| |
case 2: |
| |
DP_Print = 0; DP_PrintShort = 1; |
| |
break; |
| |
default: |
| |
DP_Print = s; DP_PrintShort = 0; |
| |
break; |
| |
} |
| |
} else { |
| |
if ( DP_Print ) { |
| |
STOQ(1,q); |
| |
} else if ( DP_PrintShort ) { |
| |
STOQ(2,q); |
| |
} else |
| |
q = 0; |
| |
} |
| |
*rp = q; |
| } |
} |
| |
|
| void dp_dehomo(p,rp) |
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
| DP p; |
int *modular,struct order_spec **ord) |
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
NODE t,p; |
| int i,n,nv; |
Q m; |
| DL dl,dlh; |
char *key; |
| |
Obj value,dmy; |
| |
int ord_is_set = 0; |
| |
int modular_is_set = 0; |
| |
int homo_is_set = 0; |
| |
VL vl,vl0; |
| |
LIST vars; |
| |
char xiname[BUFSIZ]; |
| |
NODE x0,x; |
| |
DP d; |
| |
P xi; |
| |
int nv,i; |
| |
|
| if ( !p ) |
/* extract vars */ |
| *rp = 0; |
vars = 0; |
| else { |
for ( t = opt; t; t = NEXT(t) ) { |
| n = p->nv; nv = n - 1; |
p = BDY((LIST)BDY(t)); |
| m = BDY(p); |
key = BDY((STRING)BDY(p)); |
| for ( mr0 = 0; m; m = NEXT(m) ) { |
value = (Obj)BDY(NEXT(p)); |
| NEXTMP(mr0,mr); mr->c = m->c; |
if ( !strcmp(key,"v") ) { |
| dlh = m->dl; |
/* variable list */ |
| mr->dl = dl = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
vars = (LIST)value; |
| dl->td = dlh->td - dlh->d[nv]; |
break; |
| for ( i = 0; i < nv; i++ ) |
} |
| dl->d[i] = dlh->d[i]; |
} |
| } |
if ( vars ) { |
| NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar; |
*v = vars; pltovl(vars,&vl); |
| } |
} else { |
| |
for ( t = BDY(f); t; t = NEXT(t) ) |
| |
if ( BDY(t) && OID((Obj)BDY(t))==O_DP ) |
| |
break; |
| |
if ( t ) { |
| |
/* f is DP list */ |
| |
/* create dummy var list */ |
| |
d = (DP)BDY(t); |
| |
nv = NV(d); |
| |
for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) { |
| |
NEXTVL(vl0,vl); |
| |
NEXTNODE(x0,x); |
| |
sprintf(xiname,"x%d",i); |
| |
makevar(xiname,&xi); |
| |
x->body = (pointer)xi; |
| |
vl->v = VR((P)xi); |
| |
} |
| |
if ( vl0 ) { |
| |
NEXT(vl) = 0; |
| |
NEXT(x) = 0; |
| |
} |
| |
MKLIST(vars,x0); |
| |
*v = vars; |
| |
vl = vl0; |
| |
} else { |
| |
get_vars((Obj)f,&vl); vltopl(vl,v); |
| |
} |
| |
} |
| |
|
| |
for ( t = opt; t; t = NEXT(t) ) { |
| |
p = BDY((LIST)BDY(t)); |
| |
key = BDY((STRING)BDY(p)); |
| |
value = (Obj)BDY(NEXT(p)); |
| |
if ( !strcmp(key,"v") ) { |
| |
/* variable list; ignore */ |
| |
} else if ( !strcmp(key,"order") ) { |
| |
/* order spec */ |
| |
if ( !vl ) |
| |
error("parse_gr_option : variables must be specified"); |
| |
create_order_spec(vl,value,ord); |
| |
ord_is_set = 1; |
| |
} else if ( !strcmp(key,"block") ) { |
| |
create_order_spec(0,value,ord); |
| |
ord_is_set = 1; |
| |
} else if ( !strcmp(key,"matrix") ) { |
| |
create_order_spec(0,value,ord); |
| |
ord_is_set = 1; |
| |
} else if ( !strcmp(key,"sugarweight") ) { |
| |
/* weight */ |
| |
Pdp_set_weight(NEXT(p),&dmy); |
| |
} else if ( !strcmp(key,"homo") ) { |
| |
*homo = (Num)value; |
| |
homo_is_set = 1; |
| |
} else if ( !strcmp(key,"trace") ) { |
| |
m = (Q)value; |
| |
if ( !m ) |
| |
*modular = 0; |
| |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 |
| |
&& BD(NM(m))[0] >= 0x80000000) ) |
| |
error("parse_gr_option : too large modulus"); |
| |
else |
| |
*modular = QTOS(m); |
| |
modular_is_set = 1; |
| |
} else if ( !strcmp(key,"dp") ) { |
| |
/* XXX : ignore */ |
| |
} else |
| |
error("parse_gr_option : not implemented"); |
| |
} |
| |
if ( !ord_is_set ) create_order_spec(0,0,ord); |
| |
if ( !modular_is_set ) *modular = 0; |
| |
if ( !homo_is_set ) *homo = 0; |
| } |
} |
| |
|
| int dp_nt(p) |
void Pdp_gr_main(NODE arg,LIST *rp) |
| DP p; |
|
| { |
{ |
| int i; |
LIST f,v; |
| MP m; |
VL vl; |
| |
Num homo; |
| |
Q m; |
| |
int modular,ac; |
| |
struct order_spec *ord; |
| |
|
| if ( !p ) |
do_weyl = 0; |
| return 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_main"); |
| else { |
f = (LIST)ARG0(arg); |
| for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ ); |
f = remove_zero_from_list(f); |
| return i; |
if ( !BDY(f) ) { |
| } |
*rp = f; return; |
| |
} |
| |
if ( (ac = argc(arg)) == 5 ) { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_gr_main"); |
| |
asir_assert(ARG2(arg),O_N,"dp_gr_main"); |
| |
asir_assert(ARG3(arg),O_N,"dp_gr_main"); |
| |
v = (LIST)ARG1(arg); |
| |
homo = (Num)ARG2(arg); |
| |
m = (Q)ARG3(arg); |
| |
if ( !m ) |
| |
modular = 0; |
| |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
| |
error("dp_gr_main : too large modulus"); |
| |
else |
| |
modular = QTOS(m); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
} else if ( current_option ) |
| |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| |
else if ( ac == 1 ) |
| |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
| |
else |
| |
error("dp_gr_main : invalid argument"); |
| |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
| |
} |
| |
|
| |
void Pdp_interreduce(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
VL vl; |
| |
int ac; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_interreduce"); |
| |
f = (LIST)ARG0(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( (ac = argc(arg)) == 3 ) { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_interreduce"); |
| |
v = (LIST)ARG1(arg); |
| |
create_order_spec(0,ARG2(arg),&ord); |
| |
} |
| |
dp_interreduce(f,v,0,ord,rp); |
| |
} |
| |
|
| |
void Pdp_gr_f_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
Num homo; |
| |
int m,field,t; |
| |
struct order_spec *ord; |
| |
NODE n; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(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"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = (Num)ARG2(arg); |
| |
#if 0 |
| |
asir_assert(ARG3(arg),O_N,"dp_gr_f_main"); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
if ( m ) |
| |
error("dp_gr_f_main : trace lifting is not implemented yet"); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
#else |
| |
m = 0; |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
#endif |
| |
field = 0; |
| |
for ( n = BDY(f); n; n = NEXT(n) ) { |
| |
t = get_field_type(BDY(n)); |
| |
if ( !t ) |
| |
continue; |
| |
if ( t < 0 ) |
| |
error("dp_gr_f_main : incosistent coefficients"); |
| |
if ( !field ) |
| |
field = t; |
| |
else if ( t != field ) |
| |
error("dp_gr_f_main : incosistent coefficients"); |
| |
} |
| |
dp_gr_main(f,v,homo,m?1:0,field,ord,rp); |
| |
} |
| |
|
| |
void Pdp_f4_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_f4_main"); |
| |
asir_assert(ARG1(arg),O_LIST,"dp_f4_main"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
create_order_spec(0,ARG2(arg),&ord); |
| |
dp_f4_main(f,v,ord,rp); |
| |
} |
| |
|
| |
/* dp_gr_checklist(list of dp) */ |
| |
|
| |
void Pdp_gr_checklist(NODE arg,LIST *rp) |
| |
{ |
| |
VECT g; |
| |
LIST dp; |
| |
NODE r; |
| |
int n; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist"); |
| |
asir_assert(ARG1(arg),O_N,"dp_gr_checklist"); |
| |
n = QTOS((Q)ARG1(arg)); |
| |
gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp); |
| |
r = mknode(2,g,dp); |
| |
MKLIST(*rp,r); |
| |
} |
| |
|
| |
void Pdp_f4_mod_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(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"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( !m ) |
| |
error("dp_f4_mod_main : invalid argument"); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
dp_f4_mod_main(f,v,m,ord,rp); |
| |
} |
| |
|
| |
void Pdp_gr_mod_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
Num homo; |
| |
int m; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(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(ARG3(arg),O_N,"dp_gr_mod_main"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
| |
if ( !m ) |
| |
error("dp_gr_mod_main : invalid argument"); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
| |
} |
| |
|
| |
void Pnd_f4(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,homo,retdp,ac; |
| |
Obj val; |
| |
Q mq; |
| |
Num nhomo; |
| |
NODE node; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
nd_rref2 = 0; |
| |
retdp = 0; |
| |
if ( (ac = argc(arg)) == 4 ) { |
| |
asir_assert(ARG0(arg),O_LIST,"nd_f4"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_f4"); |
| |
asir_assert(ARG2(arg),O_N,"nd_f4"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
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(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,homo,retdp,ac; |
| |
Obj val; |
| |
Q mq; |
| |
Num nhomo; |
| |
NODE node; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
retdp = 0; |
| |
if ( (ac=argc(arg)) == 4 ) { |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
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(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,do_check; |
| |
Q mq; |
| |
Obj val; |
| |
NODE node; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
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); |
| |
do_check = ARG4(arg) ? 1 : 0; |
| |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
| |
} |
| |
|
| |
void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v,tlist; |
| |
int m; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr_recompute_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
tlist = (LIST)ARG4(arg); |
| |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
| |
} |
| |
|
| |
Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos); |
| |
Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist); |
| |
|
| |
void Pnd_btog(NODE arg,Obj *rp) |
| |
{ |
| |
LIST f,v,tlist; |
| |
int m,ac,pos; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_btog"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_btog"); |
| |
asir_assert(ARG2(arg),O_N,"nd_btog"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
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_weyl_gr_postproc(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,do_check; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 1; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; do_weyl = 0; return; |
| |
} |
| |
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); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pnd_gr_trace(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,homo,ac; |
| |
Num nhomo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
if ( (ac = argc(arg)) == 5 ) { |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
| |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = QTOS((Q)ARG2(arg)); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
} 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_f4_trace(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,homo,ac; |
| |
Num nhomo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
if ( (ac = argc(arg))==5 ) { |
| |
asir_assert(ARG0(arg),O_LIST,"nd_f4_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_f4_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_f4_trace"); |
| |
asir_assert(ARG3(arg),O_N,"nd_f4_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = QTOS((Q)ARG2(arg)); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
} 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_weyl_gr(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m,homo,retdp,ac; |
| |
Obj val; |
| |
Num nhomo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 1; |
| |
retdp = 0; |
| |
if ( (ac = argc(arg)) == 4 ) { |
| |
asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr"); |
| |
asir_assert(ARG2(arg),O_N,"nd_weyl_gr"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; do_weyl = 0; return; |
| |
} |
| |
m = QTOS((Q)ARG2(arg)); |
| |
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 */ |
| |
|
| |
void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
Num homo; |
| |
Q m; |
| |
int modular,ac; |
| |
struct order_spec *ord; |
| |
|
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
| |
f = (LIST)ARG0(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( (ac = argc(arg)) == 5 ) { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
| |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
| |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
| |
v = (LIST)ARG1(arg); |
| |
homo = (Num)ARG2(arg); |
| |
m = (Q)ARG3(arg); |
| |
if ( !m ) |
| |
modular = 0; |
| |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
| |
error("dp_weyl_gr_main : too large modulus"); |
| |
else |
| |
modular = QTOS(m); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
} else if ( current_option ) |
| |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| |
else if ( ac == 1 ) |
| |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
| |
else |
| |
error("dp_weyl_gr_main : invalid argument"); |
| |
do_weyl = 1; |
| |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pdp_weyl_gr_f_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
Num homo; |
| |
struct order_spec *ord; |
| |
|
| |
asir_assert(ARG0(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(ARG3(arg),O_N,"dp_weyl_gr_main"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = (Num)ARG2(arg); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
do_weyl = 1; |
| |
dp_gr_main(f,v,homo,0,1,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pdp_weyl_f4_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
struct order_spec *ord; |
| |
|
| |
asir_assert(ARG0(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 = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
create_order_spec(0,ARG2(arg),&ord); |
| |
do_weyl = 1; |
| |
dp_f4_main(f,v,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
int m; |
| |
struct order_spec *ord; |
| |
|
| |
asir_assert(ARG0(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"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( !m ) |
| |
error("dp_weyl_f4_mod_main : invalid argument"); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
do_weyl = 1; |
| |
dp_f4_mod_main(f,v,m,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
| |
{ |
| |
LIST f,v; |
| |
Num homo; |
| |
int m; |
| |
struct order_spec *ord; |
| |
|
| |
asir_assert(ARG0(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(ARG3(arg),O_N,"dp_weyl_gr_mod_main"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
| |
if ( !m ) |
| |
error("dp_weyl_gr_mod_main : invalid argument"); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
do_weyl = 1; |
| |
dp_gr_mod_main(f,v,homo,m,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
VECT current_dl_weight_vector_obj; |
| |
int *current_dl_weight_vector; |
| |
int dp_negative_weight; |
| |
|
| |
void Pdp_set_weight(NODE arg,VECT *rp) |
| |
{ |
| |
VECT v; |
| |
int i,n; |
| |
NODE node; |
| |
|
| |
if ( !arg ) |
| |
*rp = current_dl_weight_vector_obj; |
| |
else if ( !ARG0(arg) ) { |
| |
current_dl_weight_vector_obj = 0; |
| |
current_dl_weight_vector = 0; |
| |
dp_negative_weight = 0; |
| |
*rp = 0; |
| |
} else { |
| |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
| |
error("dp_set_weight : invalid argument"); |
| |
if ( OID(ARG0(arg)) == O_VECT ) |
| |
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_dl_weight_vector_obj = v; |
| |
n = v->len; |
| |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
| |
for ( i = 0; i < n; i++ ) |
| |
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_module_weight_vector_obj; |
| |
int *current_module_weight_vector; |
| |
|
| |
void Pdp_set_module_weight(NODE arg,VECT *rp) |
| |
{ |
| |
VECT v; |
| |
int i,n; |
| |
NODE node; |
| |
|
| |
if ( !arg ) |
| |
*rp = current_module_weight_vector_obj; |
| |
else if ( !ARG0(arg) ) { |
| |
current_module_weight_vector_obj = 0; |
| |
current_module_weight_vector = 0; |
| |
*rp = 0; |
| |
} else { |
| |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
| |
error("dp_module_set_weight : invalid argument"); |
| |
if ( OID(ARG0(arg)) == O_VECT ) |
| |
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_module_weight_vector_obj = v; |
| |
n = v->len; |
| |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
| |
for ( i = 0; i < n; i++ ) |
| |
current_module_weight_vector[i] = QTOS((Q)v->body[i]); |
| |
*rp = v; |
| |
} |
| |
} |
| |
|
| |
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(); |
| |
|
| |
void Pdp_get_denomlist(LIST *rp) |
| |
{ |
| |
*rp = get_denomlist(); |
| |
} |
| |
|
| |
static VECT current_weyl_weight_vector_obj; |
| |
int *current_weyl_weight_vector; |
| |
|
| |
void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
| |
{ |
| |
VECT v; |
| |
NODE node; |
| |
int i,n; |
| |
|
| |
if ( !arg ) |
| |
*rp = current_weyl_weight_vector_obj; |
| |
else if ( !ARG0(arg) ) { |
| |
current_weyl_weight_vector_obj = 0; |
| |
current_weyl_weight_vector = 0; |
| |
*rp = 0; |
| |
} else { |
| |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
| |
error("dp_weyl_set_weight : invalid argument"); |
| |
if ( OID(ARG0(arg)) == O_VECT ) |
| |
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) |
| |
{ |
| |
NODE n,r0,r; |
| |
LIST rl; |
| |
|
| |
asir_assert(l,O_LIST,"remove_zero_from_list"); |
| |
n = BDY(l); |
| |
for ( r0 = 0; n; n = NEXT(n) ) |
| |
if ( BDY(n) ) { |
| |
NEXTNODE(r0,r); |
| |
BDY(r) = BDY(n); |
| |
} |
| |
if ( r0 ) |
| |
NEXT(r) = 0; |
| |
MKLIST(rl,r0); |
| |
return rl; |
| |
} |
| |
|
| |
int get_field_type(P p) |
| |
{ |
| |
int type,t; |
| |
DCP dc; |
| |
|
| |
if ( !p ) |
| |
return 0; |
| |
else if ( NUM(p) ) |
| |
return NID((Num)p); |
| |
else { |
| |
type = 0; |
| |
for ( dc = DC(p); dc; dc = NEXT(dc) ) { |
| |
t = get_field_type(COEF(dc)); |
| |
if ( !t ) |
| |
continue; |
| |
if ( t < 0 ) |
| |
return t; |
| |
if ( !type ) |
| |
type = t; |
| |
else if ( t != type ) |
| |
return -1; |
| |
} |
| |
return type; |
| |
} |
| |
} |
| |
|
| |
void Pdpv_ord(NODE arg,Obj *rp) |
| |
{ |
| |
int ac,id; |
| |
LIST shift; |
| |
|
| |
ac = argc(arg); |
| |
if ( ac ) { |
| |
id = QTOS((Q)ARG0(arg)); |
| |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
| |
shift = (LIST)ARG1(arg); |
| |
else |
| |
shift = 0; |
| |
create_modorder_spec(id,shift,&dp_current_modspec); |
| |
} |
| |
*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) |
| |
{ |
| |
NODE n; |
| |
DP ht; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_ht"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
ht = 0; |
| |
else |
| |
dp_ht(BDY(p)[pos],&ht); |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,ht); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdpv_hm(NODE arg,LIST *rp) |
| |
{ |
| |
NODE n; |
| |
DP ht; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_hm"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
ht = 0; |
| |
else |
| |
dp_hm(BDY(p)[pos],&ht); |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,ht); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdpv_hc(NODE arg,LIST *rp) |
| |
{ |
| |
NODE n; |
| |
P hc; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_hc"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
hc = 0; |
| |
else |
| |
hc = (P)BDY(BDY(p)[pos])->c; |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,hc); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
int dpv_hp(DPV p) |
| |
{ |
| |
int len,i,maxp,maxw,w,slen; |
| |
int *shift; |
| |
DP *e; |
| |
|
| |
len = p->len; |
| |
e = p->body; |
| |
slen = dp_current_modspec->len; |
| |
shift = dp_current_modspec->degree_shift; |
| |
switch ( dp_current_modspec->id ) { |
| |
case ORD_REVGRADLEX: |
| |
for ( maxp = -1, i = 0; i < len; i++ ) |
| |
if ( !e[i] ) continue; |
| |
else if ( maxp < 0 ) { |
| |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
| |
} else { |
| |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
| |
if ( w >= maxw ) { |
| |
maxw = w; maxp = i; |
| |
} |
| |
} |
| |
return maxp; |
| |
case ORD_GRADLEX: |
| |
for ( maxp = -1, i = 0; i < len; i++ ) |
| |
if ( !e[i] ) continue; |
| |
else if ( maxp < 0 ) { |
| |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
| |
} else { |
| |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
| |
if ( w > maxw ) { |
| |
maxw = w; maxp = i; |
| |
} |
| |
} |
| |
return maxp; |
| |
break; |
| |
case ORD_LEX: |
| |
for ( i = 0; i < len; i++ ) |
| |
if ( e[i] ) return i; |
| |
return -1; |
| |
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; |
| } |
} |
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin