| version 1.4, 2000/07/14 08:26:39 |
version 1.82, 2010/05/01 02:17:49 |
|
|
| /* $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.81 2010/04/16 07:13:42 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; |
| |
|
| 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_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 Pdp_weyl_red(); |
| |
void Pdp_weyl_sp(); |
| |
void Pdp_weyl_nf(),Pdp_weyl_nf_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(); |
| |
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 Pdp_lnf_f(); |
| |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); |
| |
void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); |
| |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
| |
void Pnd_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(); |
| |
|
| |
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); |
| |
|
| |
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_dtop",Pdp_dtop,2}, |
|
| {"dp_ptozp",Pdp_ptozp,1}, |
{"dp_ptozp",Pdp_ptozp,1}, |
| {"dp_ptozp2",Pdp_ptozp2,2}, |
{"dp_ptozp2",Pdp_ptozp2,2}, |
| {"dp_prim",Pdp_prim,1}, |
{"dp_prim",Pdp_prim,1}, |
| {"dp_redble",Pdp_redble,2}, |
{"dp_red_coef",Pdp_red_coef,2}, |
| {"dp_subd",Pdp_subd,2}, |
{"dp_cont",Pdp_cont,1}, |
| {"dp_red",Pdp_red,3}, |
|
| {"dp_red_mod",Pdp_red_mod,4}, |
/* polynomial ring */ |
| |
/* special operations */ |
| |
{"dp_mul_trunc",Pdp_mul_trunc,3}, |
| |
{"dp_quo",Pdp_quo,2}, |
| |
|
| |
/* s-poly */ |
| {"dp_sp",Pdp_sp,2}, |
{"dp_sp",Pdp_sp,2}, |
| {"dp_sp_mod",Pdp_sp_mod,3}, |
{"dp_sp_mod",Pdp_sp_mod,3}, |
| {"dp_lcm",Pdp_lcm,2}, |
|
| {"dp_hm",Pdp_hm,1}, |
/* m-reduction */ |
| {"dp_ht",Pdp_ht,1}, |
{"dp_red",Pdp_red,3}, |
| {"dp_hc",Pdp_hc,1}, |
{"dp_red_mod",Pdp_red_mod,4}, |
| {"dp_rest",Pdp_rest,1}, |
|
| {"dp_td",Pdp_td,1}, |
/* normal form */ |
| {"dp_sugar",Pdp_sugar,1}, |
|
| {"dp_cri1",Pdp_cri1,2}, |
|
| {"dp_cri2",Pdp_cri2,2}, |
|
| {"dp_criB",Pdp_criB,3}, |
|
| {"dp_minp",Pdp_minp,2}, |
|
| {"dp_mod",Pdp_mod,3}, |
|
| {"dp_rat",Pdp_rat,1}, |
|
| {"dp_tdiv",Pdp_tdiv,2}, |
|
| {"dp_red_coef",Pdp_red_coef,2}, |
|
| {"dp_nelim",Pdp_nelim,-1}, |
|
| {"dp_mag",Pdp_mag,1}, |
|
| {"dp_set_kara",Pdp_set_kara,-1}, |
|
| {"dp_nf",Pdp_nf,4}, |
{"dp_nf",Pdp_nf,4}, |
| |
{"dp_nf_f",Pdp_nf_f,4}, |
| {"dp_true_nf",Pdp_true_nf,4}, |
{"dp_true_nf",Pdp_true_nf,4}, |
| {"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_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4}, |
| |
{"dp_true_nf_and_quotient_marked_mod",Pdp_true_nf_and_quotient_marked_mod,5}, |
| |
{"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5}, |
| {"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
| {"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
| {"dp_homo",Pdp_homo,1}, |
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
| {"dp_dehomo",Pdp_dehomo,1}, |
{"dp_nf_tab_f",Pdp_nf_tab_f,2}, |
| {"dp_gr_main",Pdp_gr_main,5}, |
{"dp_nf_tab_mod",Pdp_nf_tab_mod,3}, |
| /* {"dp_gr_hm_main",Pdp_gr_hm_main,5}, */ |
{"dp_lnf_f",Pdp_lnf_f,2}, |
| /* {"dp_gr_d_main",Pdp_gr_d_main,6}, */ |
|
| |
/* Buchberger algorithm */ |
| |
{"dp_gr_main",Pdp_gr_main,-5}, |
| |
{"dp_interreduce",Pdp_interreduce,3}, |
| {"dp_gr_mod_main",Pdp_gr_mod_main,5}, |
{"dp_gr_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_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, |
| |
{"nd_weyl_gr",Pnd_weyl_gr,4}, |
| |
{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, |
| |
{"nd_nf",Pnd_nf,5}, |
| |
|
| |
/* F4 algorithm */ |
| {"dp_f4_main",Pdp_f4_main,3}, |
{"dp_f4_main",Pdp_f4_main,3}, |
| {"dp_f4_mod_main",Pdp_f4_mod_main,4}, |
{"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}, |
| |
|
| |
/* 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}, |
| |
{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5}, |
| |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
| |
|
| |
/* 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}, |
| |
}; |
| |
|
| |
struct ftab dp_supp_tab[] = { |
| |
/* setting flags */ |
| |
{"dp_sort",Pdp_sort,1}, |
| |
{"dp_ord",Pdp_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_flags",Pdp_gr_flags,-1}, |
| {"dp_gr_print",Pdp_gr_print,-1}, |
{"dp_gr_print",Pdp_gr_print,-1}, |
| {0,0,0}, |
|
| |
/* converters */ |
| |
{"homogenize",Phomogenize,3}, |
| |
{"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}, |
| |
|
| |
/* 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}, |
| |
{"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}, |
| |
|
| |
{0,0,0} |
| }; |
}; |
| |
|
| extern int dp_nelim; |
NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2); |
| extern int dp_order_pair_length; |
Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp); |
| extern struct order_pair *dp_order_pair; |
|
| extern struct order_spec dp_current_spec; |
|
| |
|
| void Pdp_ord(arg,rp) |
void Pdp_compute_last_t(NODE arg,LIST *rp) |
| |
{ |
| |
NODE g,gh,homo,n; |
| |
LIST hlist; |
| |
VECT v1,v2,w; |
| |
Q t; |
| |
|
| |
g = (NODE)BDY((LIST)ARG0(arg)); |
| |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| |
t = (Q)ARG2(arg); |
| |
v1 = (VECT)ARG3(arg); |
| |
v2 = (VECT)ARG4(arg); |
| |
t = compute_last_t(g,gh,t,v1,v2,&homo,&w); |
| |
MKLIST(hlist,homo); |
| |
n = mknode(3,t,w,hlist); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdp_compute_last_w(NODE arg,LIST *rp) |
| |
{ |
| |
NODE g,gh,r; |
| |
VECT w,rv; |
| |
LIST l; |
| |
MAT w1,w2; |
| |
int row1,row2,i,j,n; |
| |
int *v; |
| |
int **m1,**m2; |
| |
Q q; |
| |
|
| |
g = (NODE)BDY((LIST)ARG0(arg)); |
| |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| |
w = (VECT)ARG2(arg); |
| |
w1 = (MAT)ARG3(arg); |
| |
w2 = (MAT)ARG4(arg); |
| |
n = w1->col; |
| |
row1 = w1->row; |
| |
row2 = w2->row; |
| |
if ( w ) { |
| |
v = W_ALLOC(n); |
| |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
| |
} else v = 0; |
| |
m1 = almat(row1,n); |
| |
for ( i = 0; i < row1; i++ ) |
| |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
| |
m2 = almat(row2,n); |
| |
for ( i = 0; i < row2; i++ ) |
| |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
| |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
| |
if ( !r ) *rp = 0; |
| |
else { |
| |
MKVECT(rv,n); |
| |
for ( i = 0; i < n; i++ ) { |
| |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
| |
} |
| |
MKLIST(l,r); |
| |
r = mknode(2,rv,l); |
| |
MKLIST(*rp,r); |
| |
} |
| |
} |
| |
|
| |
NODE compute_essential_df(DP *g,DP *gh,int n); |
| |
|
| |
void Pdp_compute_essential_df(NODE arg,LIST *rp) |
| |
{ |
| |
VECT g,gh; |
| |
NODE r; |
| |
|
| |
g = (VECT)ARG0(arg); |
| |
gh = (VECT)ARG1(arg); |
| |
r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len); |
| |
MKLIST(*rp,r); |
| |
} |
| |
|
| |
void Pdp_inv_or_split(arg,rp) |
| NODE arg; |
NODE arg; |
| Obj *rp; |
Obj *rp; |
| { |
{ |
| struct order_spec spec; |
NODE gb,newgb; |
| |
DP f,inv; |
| |
struct order_spec *spec; |
| |
LIST list; |
| |
|
| if ( !arg ) |
do_weyl = 0; dp_fcoeffs = 0; |
| *rp = dp_current_spec.obj; |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
| else if ( !create_order_spec((Obj)ARG0(arg),&spec) ) |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
| error("dp_ord : invalid order specification"); |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
| else { |
error("dp_inv_or_split : invalid order specification"); |
| initd(&spec); *rp = spec.obj; |
gb = BDY((LIST)ARG0(arg)); |
| |
f = (DP)ARG1(arg); |
| |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
| |
if ( !newgb ) { |
| |
/* invertible */ |
| |
*rp = (Obj)inv; |
| |
} else { |
| |
MKLIST(list,newgb); |
| |
*rp = (Obj)list; |
| } |
} |
| } |
} |
| |
|
| int create_order_spec(obj,spec) |
void Pdp_sort(arg,rp) |
| Obj obj; |
NODE arg; |
| struct order_spec *spec; |
DP *rp; |
| { |
{ |
| int i,j,n,s,row,col; |
dp_sort((DP)ARG0(arg),rp); |
| struct order_pair *l; |
} |
| NODE node,t,tn; |
|
| MAT m; |
|
| pointer **b; |
|
| int **w; |
|
| |
|
| if ( !obj || NUM(obj) ) { |
void Pdp_mdtod(arg,rp) |
| spec->id = 0; spec->obj = obj; |
NODE arg; |
| spec->ord.simple = QTOS((Q)obj); |
DP *rp; |
| return 1; |
{ |
| } else if ( OID(obj) == O_LIST ) { |
MP m,mr,mr0; |
| node = BDY((LIST)obj); |
DP p; |
| for ( n = 0, t = node; t; t = NEXT(t), n++ ); |
P t; |
| l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); |
|
| for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { |
p = (DP)ARG0(arg); |
| tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); |
if ( !p ) |
| tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); |
*rp = 0; |
| s += l[i].length; |
else { |
| |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
| |
mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl; |
| } |
} |
| spec->id = 1; spec->obj = obj; |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
| spec->ord.block.order_pair = l; |
} |
| spec->ord.block.length = n; spec->nv = s; |
|
| return 1; |
|
| } else if ( OID(obj) == O_MAT ) { |
|
| m = (MAT)obj; row = m->row; col = m->col; b = BDY(m); |
|
| w = almat(row,col); |
|
| for ( i = 0; i < row; i++ ) |
|
| for ( j = 0; j < col; j++ ) |
|
| w[i][j] = QTOS((Q)b[i][j]); |
|
| spec->id = 2; spec->obj = obj; |
|
| spec->nv = col; spec->ord.matrix.row = row; |
|
| spec->ord.matrix.matrix = w; |
|
| return 1; |
|
| } else |
|
| return 0; |
|
| } |
} |
| |
|
| void homogenize_order(old,n,new) |
void Pdp_sep(arg,rp) |
| struct order_spec *old,*new; |
NODE arg; |
| int n; |
VECT *rp; |
| { |
{ |
| struct order_pair *l; |
DP p,r; |
| int length,nv,row,i,j; |
MP m,t; |
| int **newm,**oldm; |
MP *w0,*w; |
| |
int i,n,d,nv,sugar; |
| |
VECT v; |
| |
pointer *pv; |
| |
|
| switch ( old->id ) { |
p = (DP)ARG0(arg); m = BDY(p); |
| case 0: |
d = QTOS((Q)ARG1(arg)); |
| switch ( old->ord.simple ) { |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
| case 0: |
if ( d > n ) |
| new->id = 0; new->ord.simple = 0; break; |
d = n; |
| case 1: |
MKVECT(v,d); *rp = v; |
| l = (struct order_pair *) |
pv = BDY(v); nv = p->nv; sugar = p->sugar; |
| MALLOC_ATOMIC(2*sizeof(struct order_pair)); |
w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP)); |
| l[0].length = n; l[0].order = 1; |
w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP)); |
| l[1].length = 1; l[1].order = 2; |
for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) { |
| new->id = 1; |
NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl; |
| 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"); |
|
| } |
} |
| |
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(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp); |
| |
} |
| |
|
| |
void Pdp_cont(arg,rp) |
| |
NODE arg; |
| |
Q *rp; |
| |
{ |
| |
dp_cont((DP)ARG0(arg),rp); |
| |
} |
| |
|
| |
void Pdp_dtov(arg,rp) |
| |
NODE arg; |
| |
VECT *rp; |
| |
{ |
| |
dp_dtov((DP)ARG0(arg),rp); |
| |
} |
| |
|
| |
void Pdp_mbase(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
NODE mb; |
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"dp_mbase"); |
| |
dp_mbase(BDY((LIST)ARG0(arg)),&mb); |
| |
MKLIST(*rp,mb); |
| |
} |
| |
|
| |
void Pdp_etov(arg,rp) |
| |
NODE arg; |
| |
VECT *rp; |
| |
{ |
| |
DP dp; |
| |
int n,i; |
| |
int *d; |
| |
VECT v; |
| |
Q t; |
| |
|
| |
dp = (DP)ARG0(arg); |
| |
asir_assert(dp,O_DP,"dp_etov"); |
| |
n = dp->nv; d = BDY(dp)->dl->d; |
| |
MKVECT(v,n); |
| |
for ( i = 0; i < n; i++ ) { |
| |
STOQ(d[i],t); v->body[i] = (pointer)t; |
| |
} |
| |
*rp = v; |
| |
} |
| |
|
| |
void Pdp_vtoe(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
DP dp; |
| |
DL dl; |
| |
MP m; |
| |
int n,i,td; |
| |
int *d; |
| |
VECT v; |
| |
|
| |
v = (VECT)ARG0(arg); |
| |
asir_assert(v,O_VECT,"dp_vtoe"); |
| |
n = v->len; |
| |
NEWDL(dl,n); d = dl->d; |
| |
for ( i = 0, td = 0; i < n; i++ ) { |
| |
d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
| |
} |
| |
dl->td = td; |
| |
NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0; |
| |
MKDP(n,m,dp); dp->sugar = td; |
| |
*rp = dp; |
| |
} |
| |
|
| |
void Pdp_lnf_mod(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
DP r1,r2; |
| |
NODE b,g,n; |
| |
int mod; |
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod"); |
| |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
| |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
| |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
| |
mod = QTOS((Q)ARG2(arg)); |
| |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
| |
NEWNODE(n); BDY(n) = (pointer)r1; |
| |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdp_lnf_f(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
DP r1,r2; |
| |
NODE b,g,n; |
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"dp_lnf_f"); |
| |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_f"); |
| |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
| |
dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2); |
| |
NEWNODE(n); BDY(n) = (pointer)r1; |
| |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdp_nf_tab_mod(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod"); |
| |
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 Pdp_nf_tab_f(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f"); |
| |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f"); |
| |
dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp); |
| |
} |
| |
|
| |
void Pdp_ord(arg,rp) |
| |
NODE arg; |
| |
Obj *rp; |
| |
{ |
| |
struct order_spec *spec; |
| |
LIST v; |
| |
struct oLIST f; |
| |
Num homo; |
| |
int modular; |
| |
|
| |
f.id = O_LIST; f.body = 0; |
| |
if ( !arg && !current_option ) |
| |
*rp = dp_current_spec->obj; |
| |
else { |
| |
if ( current_option ) |
| |
parse_gr_option(&f,current_option,&v,&homo,&modular,&spec); |
| |
else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
| |
error("dp_ord : invalid order specification"); |
| |
initd(spec); *rp = spec->obj; |
| |
} |
| |
} |
| |
|
| void Pdp_ptod(arg,rp) |
void Pdp_ptod(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| |
P p; |
| NODE n; |
NODE n; |
| VL vl,tvl; |
VL vl,tvl; |
| |
struct oLIST f; |
| |
int ac; |
| |
LIST v; |
| |
Num homo; |
| |
int modular; |
| |
struct order_spec *ord; |
| |
|
| asir_assert(ARG0(arg),O_P,"dp_ptod"); |
asir_assert(ARG0(arg),O_P,"dp_ptod"); |
| asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
p = (P)ARG0(arg); |
| for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) { |
ac = argc(arg); |
| |
if ( ac == 1 ) { |
| |
if ( current_option ) { |
| |
f.id = O_LIST; f.body = mknode(1,p); |
| |
parse_gr_option(&f,current_option,&v,&homo,&modular,&ord); |
| |
initd(ord); |
| |
} else |
| |
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 ) { |
if ( !vl ) { |
| NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
| } else { |
} else { |
|
|
| } |
} |
| if ( vl ) |
if ( vl ) |
| NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
| ptod(CO,vl,(P)ARG0(arg),rp); |
ptod(CO,vl,p,rp); |
| } |
} |
| |
|
| |
void Phomogenize(arg,rp) |
| |
NODE arg; |
| |
P *rp; |
| |
{ |
| |
P p; |
| |
DP d,h; |
| |
NODE n; |
| |
V hv; |
| |
VL vl,tvl,last; |
| |
struct oLIST f; |
| |
LIST v; |
| |
|
| |
asir_assert(ARG0(arg),O_P,"homogenize"); |
| |
p = (P)ARG0(arg); |
| |
asir_assert(ARG1(arg),O_LIST,"homogenize"); |
| |
v = (LIST)ARG1(arg); |
| |
asir_assert(ARG2(arg),O_P,"homogenize"); |
| |
hv = VR((P)ARG2(arg)); |
| |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| |
if ( !vl ) { |
| |
NEWVL(vl); tvl = vl; |
| |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) { |
| |
last = tvl; |
| |
NEXT(tvl) = 0; |
| |
} |
| |
ptod(CO,vl,p,&d); |
| |
dp_homo(d,&h); |
| |
NEWVL(NEXT(last)); last = NEXT(last); |
| |
VR(last) = hv; NEXT(last) = 0; |
| |
dtop(CO,vl,h,rp); |
| |
} |
| |
|
| |
void Pdp_ltod(arg,rp) |
| |
NODE arg; |
| |
DPV *rp; |
| |
{ |
| |
NODE n; |
| |
VL vl,tvl; |
| |
LIST f,v; |
| |
int sugar,i,len,ac,modular; |
| |
Num homo; |
| |
struct order_spec *ord; |
| |
DP *e; |
| |
NODE nd,t; |
| |
|
| |
ac = argc(arg); |
| |
asir_assert(ARG0(arg),O_LIST,"dp_ptod"); |
| |
f = (LIST)ARG0(arg); |
| |
if ( ac == 1 ) { |
| |
if ( current_option ) { |
| |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| |
initd(ord); |
| |
} else |
| |
error("dp_ltod : 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; |
| |
|
| |
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 Pdp_dtop(arg,rp) |
void Pdp_dtop(arg,rp) |
| NODE arg; |
NODE arg; |
| P *rp; |
P *rp; |
| Line 241 extern LIST Dist; |
|
| Line 734 extern LIST Dist; |
|
| |
|
| void Pdp_ptozp(arg,rp) |
void Pdp_ptozp(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
Obj *rp; |
| { |
{ |
| |
Q t; |
| |
NODE tt,p; |
| |
NODE n,n0; |
| |
char *key; |
| |
DP pp; |
| |
LIST list; |
| |
int get_factor=0; |
| |
|
| asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
| #if INET |
|
| if ( Dist ) |
/* analyze the option */ |
| dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp); |
if ( current_option ) { |
| else |
for ( tt = current_option; tt; tt = NEXT(tt) ) { |
| #endif |
p = BDY((LIST)BDY(tt)); |
| dp_ptozp((DP)ARG0(arg),rp); |
key = BDY((STRING)BDY(p)); |
| |
/* value = (Obj)BDY(NEXT(p)); */ |
| |
if ( !strcmp(key,"factor") ) get_factor=1; |
| |
else { |
| |
error("ptozp: unknown option."); |
| |
} |
| |
} |
| |
} |
| |
|
| |
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(arg,rp) |
void Pdp_ptozp2(arg,rp) |
|
|
| p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg); |
| asir_assert(p0,O_DP,"dp_ptozp2"); |
asir_assert(p0,O_DP,"dp_ptozp2"); |
| asir_assert(p1,O_DP,"dp_ptozp2"); |
asir_assert(p1,O_DP,"dp_ptozp2"); |
| #if INET |
dp_ptozp2(p0,p1,&h,&r); |
| 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(n0); BDY(n0) = (pointer)h; |
| NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r; |
| NEXT(NEXT(n0)) = 0; |
NEXT(NEXT(n0)) = 0; |
|
|
| dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp); |
| } |
} |
| |
|
| extern int NoGCD; |
|
| |
|
| void dp_prim(p,rp) |
|
| DP p,*rp; |
|
| { |
|
| P t,g; |
|
| DP p1; |
|
| MP m,mr,mr0; |
|
| int i,n; |
|
| P *w; |
|
| Q *c; |
|
| Q dvr; |
|
| |
|
| if ( !p ) |
|
| *rp = 0; |
|
| else if ( dp_fcoeffs ) |
|
| *rp = p; |
|
| else if ( NoGCD ) |
|
| dp_ptozp(p,rp); |
|
| else { |
|
| dp_ptozp(p,&p1); p = p1; |
|
| 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) |
|
| VL vl; |
|
| P *pl,*pr; |
|
| int m; |
|
| { |
|
| int i,r; |
|
| P gcd,t,s1,s2,u; |
|
| Q rq; |
|
| |
|
| while ( 1 ) { |
|
| for ( i = 0, s1 = 0; i < m; i++ ) { |
|
| r = random(); UTOQ(r,rq); |
|
| mulp(vl,pl[i],(P)rq,&t); addp(vl,s1,t,&u); s1 = u; |
|
| } |
|
| for ( i = 0, s2 = 0; i < m; i++ ) { |
|
| r = random(); UTOQ(r,rq); |
|
| mulp(vl,pl[i],(P)rq,&t); addp(vl,s2,t,&u); s2 = u; |
|
| } |
|
| ezgcdp(vl,s1,s2,&gcd); |
|
| for ( i = 0; i < m; i++ ) { |
|
| if ( !divtpz(vl,pl[i],gcd,&t) ) |
|
| break; |
|
| } |
|
| if ( i == m ) |
|
| break; |
|
| } |
|
| *pr = gcd; |
|
| } |
|
| |
|
| void dp_prim_mod(p,mod,rp) |
|
| int mod; |
|
| DP p,*rp; |
|
| { |
|
| P t,g; |
|
| MP m,mr,mr0; |
|
| |
|
| if ( !p ) |
|
| *rp = 0; |
|
| else if ( NoGCD ) |
|
| *rp = p; |
|
| else { |
|
| for ( m = BDY(p), g = m->c, m = NEXT(m); m; m = NEXT(m) ) { |
|
| gcdprsmp(CO,mod,g,m->c,&t); g = t; |
|
| } |
|
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
| 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_mod(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| dp_rat((DP)ARG0(arg),rp); |
dp_rat((DP)ARG0(arg),rp); |
| } |
} |
| |
|
| void dp_mod(p,mod,subst,rp) |
extern int DP_Multiple; |
| DP p; |
|
| int mod; |
void Pdp_nf(arg,rp) |
| NODE subst; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| MP m,mr,mr0; |
NODE b; |
| P t,s,s1; |
DP *ps; |
| V v; |
DP g; |
| NODE tn; |
int full; |
| |
|
| if ( !p ) |
do_weyl = 0; dp_fcoeffs = 0; |
| *rp = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
| else { |
asir_assert(ARG1(arg),O_DP,"dp_nf"); |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
| for ( tn = subst, s = m->c; tn; tn = NEXT(tn) ) { |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
| v = VR((P)BDY(tn)); tn = NEXT(tn); |
if ( !(g = (DP)ARG1(arg)) ) { |
| substp(CO,s,v,(P)BDY(tn),&s1); s = s1; |
*rp = 0; return; |
| } |
|
| ptomp(mod,s,&t); |
|
| if ( t ) { |
|
| NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl; |
|
| } |
|
| } |
|
| if ( mr0 ) { |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } else |
|
| *rp = 0; |
|
| } |
} |
| |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
full = (Q)ARG3(arg) ? 1 : 0; |
| |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
| } |
} |
| |
|
| void dp_rat(p,rp) |
void Pdp_weyl_nf(arg,rp) |
| DP p; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| MP m,mr,mr0; |
NODE b; |
| |
DP *ps; |
| |
DP g; |
| |
int full; |
| |
|
| if ( !p ) |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
| *rp = 0; |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf"); |
| else { |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf"); |
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf"); |
| NEXTMP(mr0,mr); mptop(m->c,&mr->c); mr->dl = m->dl; |
if ( !(g = (DP)ARG1(arg)) ) { |
| } |
*rp = 0; return; |
| if ( mr0 ) { |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } else |
|
| *rp = 0; |
|
| } |
} |
| |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
full = (Q)ARG3(arg) ? 1 : 0; |
| |
do_weyl = 1; |
| |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void Pdp_nf(arg,rp) |
/* nf computation using field operations */ |
| |
|
| |
void Pdp_nf_f(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
|
|
| DP g; |
DP g; |
| int full; |
int full; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
do_weyl = 0; |
| asir_assert(ARG1(arg),O_DP,"dp_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf_f"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_f"); |
| asir_assert(ARG3(arg),O_N,"dp_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_f"); |
| |
asir_assert(ARG3(arg),O_N,"dp_nf_f"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| *rp = 0; return; |
*rp = 0; return; |
| } |
} |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
| dp_nf(b,g,ps,full,rp); |
dp_nf_f(b,g,ps,full,rp); |
| } |
} |
| |
|
| |
void Pdp_weyl_nf_f(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
NODE b; |
| |
DP *ps; |
| |
DP g; |
| |
int full; |
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f"); |
| |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f"); |
| |
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; |
| |
do_weyl = 1; |
| |
dp_nf_f(b,g,ps,full,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pdp_nf_mod(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| |
NODE b; |
| |
DP g; |
| |
DP *ps; |
| |
int mod,full,ac; |
| |
NODE n,n0; |
| |
|
| |
do_weyl = 0; |
| |
ac = argc(arg); |
| |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
| |
asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
| |
asir_assert(ARG4(arg),O_N,"dp_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; |
| |
dp_nf_mod(n0,g,ps,mod,full,rp); |
| |
} |
| |
|
| void Pdp_true_nf(arg,rp) |
void Pdp_true_nf(arg,rp) |
| NODE arg; |
NODE arg; |
| LIST *rp; |
LIST *rp; |
|
|
| P dn; |
P dn; |
| int full; |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
| asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
| asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
|
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void dp_nf(b,g,ps,full,rp) |
void Pdp_true_nf_marked(arg,rp) |
| NODE b; |
NODE arg; |
| DP g; |
LIST *rp; |
| DP *ps; |
|
| int full; |
|
| DP *rp; |
|
| { |
{ |
| DP u,p,d,s,t,dmy1; |
NODE b,n; |
| P dmy; |
DP *ps,*hps; |
| NODE l; |
DP g; |
| MP m,mr; |
DP nm; |
| int i,n; |
Q cont; |
| int *wb; |
P dn; |
| int sugar,psugar; |
int full; |
| |
|
| if ( !g ) { |
do_weyl = 0; dp_fcoeffs = 0; |
| *rp = 0; return; |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
| |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
nm = 0; dn = (P)ONE; |
| |
} else { |
| |
b = BDY((LIST)ARG0(arg)); |
| |
ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
hps = (DP *)BDY((VECT)ARG3(arg)); |
| |
dp_true_nf_marked(b,g,ps,hps,&nm,&cont,&dn); |
| } |
} |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
n = mknode(3,nm,cont,dn); |
| wb = (int *)ALLOCA(n*sizeof(int)); |
MKLIST(*rp,n); |
| 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,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; |
|
| 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) |
DP *dp_true_nf_and_quotient_marked (NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp); |
| NODE b; |
|
| DP g; |
void Pdp_true_nf_and_quotient_marked(arg,rp) |
| DP *ps; |
NODE arg; |
| int full; |
LIST *rp; |
| DP *rp; |
|
| P *dnp; |
|
| { |
{ |
| DP u,p,d,s,t,dmy; |
NODE b,n; |
| NODE l; |
DP *ps,*hps; |
| MP m,mr; |
DP g; |
| int i,n; |
DP nm; |
| int *wb; |
VECT quo; |
| int sugar,psugar; |
P dn; |
| P dn,tdn,tdn1; |
int full; |
| |
|
| dn = (P)ONE; |
do_weyl = 0; dp_fcoeffs = 0; |
| if ( !g ) { |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked"); |
| *rp = 0; *dnp = dn; return; |
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); |
| } |
} |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
n = mknode(3,nm,dn,quo); |
| wb = (int *)ALLOCA(n*sizeof(int)); |
MKLIST(*rp,n); |
| 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,p = ps[wb[i]]) ) { |
|
| dp_red(d,g,p,&t,&u,&tdn,&dmy); |
|
| 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; |
|
| mulp(CO,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; |
|
| 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)) |
DP *dp_true_nf_and_quotient_marked_mod (NODE b,DP g,DP *ps,DP *hps,int mod,DP *rp,P *dnp); |
| |
|
| void Pdp_nf_ptozp(arg,rp) |
void Pdp_true_nf_and_quotient_marked_mod(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
LIST *rp; |
| { |
{ |
| NODE b; |
NODE b,n; |
| |
DP *ps,*hps; |
| DP g; |
DP g; |
| DP *ps; |
DP nm; |
| int full,multiple; |
VECT quo; |
| |
P dn; |
| |
int full,mod; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp"); |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked_mod"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked_mod"); |
| asir_assert(ARG3(arg),O_N,"dp_nf_ptozp"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
| asir_assert(ARG4(arg),O_N,"dp_nf_ptozp"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod"); |
| |
asir_assert(ARG4(arg),O_N,"dp_true_nf_and_quotient_marked_mod"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| *rp = 0; return; |
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); |
| } |
} |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
n = mknode(3,nm,dn,quo); |
| full = (Q)ARG3(arg) ? 1 : 0; |
MKLIST(*rp,n); |
| multiple = QTOS((Q)ARG4(arg)); |
|
| dp_nf_ptozp(b,g,ps,full,multiple,rp); |
|
| } |
} |
| |
|
| void dp_nf_ptozp(b,g,ps,full,multiple,rp) |
void Pdp_true_nf_marked_mod(arg,rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int full,multiple; |
|
| DP *rp; |
|
| { |
|
| DP u,p,d,s,t,dmy1; |
|
| P dmy; |
|
| NODE l; |
|
| MP m,mr; |
|
| int i,n; |
|
| int *wb; |
|
| int hmag; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
|
| *rp = 0; return; |
|
| } |
|
| 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_nf_demand(arg,rp) |
|
| NODE arg; |
NODE arg; |
| DP *rp; |
LIST *rp; |
| { |
{ |
| DP g,u,p,d,s,t,dmy1; |
NODE b,n; |
| P dmy; |
DP *ps,*hps; |
| NODE b,l; |
DP g; |
| DP *hps; |
DP nm; |
| MP m,mr; |
P dn; |
| int i,n; |
int mod; |
| int *wb; |
|
| int full; |
|
| char *fprefix; |
|
| int sugar,psugar; |
|
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_demand"); |
do_weyl = 0; dp_fcoeffs = 0; |
| asir_assert(ARG1(arg),O_DP,"dp_nf_demand"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod"); |
| asir_assert(ARG2(arg),O_N,"dp_nf_demand"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod"); |
| asir_assert(ARG3(arg),O_VECT,"dp_nf_demand"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod"); |
| asir_assert(ARG4(arg),O_STR,"dp_nf_demand"); |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod"); |
| |
asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| *rp = 0; return; |
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)); |
| |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
| } |
} |
| b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0; |
n = mknode(2,nm,dn); |
| hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg)); |
MKLIST(*rp,n); |
| 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]); |
|
| fprintf(stderr,"loading %s\n",fname); |
|
| fp = fopen(fname,"r"); skipvl(fp); |
|
| loadobj(fp,(Obj *)&p); fclose(fp); |
|
| 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; |
|
| 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_mod(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
|
|
| DP g; |
DP g; |
| DP *ps; |
DP *ps; |
| int mod,full,ac; |
int mod,full,ac; |
| |
NODE n,n0; |
| |
|
| ac = argc(arg); |
ac = argc(arg); |
| asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod"); |
| asir_assert(ARG3(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod"); |
| asir_assert(ARG4(arg),O_N,"dp_nf_mod"); |
asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| *rp = 0; return; |
*rp = 0; return; |
| } |
} |
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
| dp_nf_mod_qindex(b,g,ps,mod,full,rp); |
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 Pdp_true_nf_mod(arg,rp) |
void Pdp_true_nf_mod(arg,rp) |
|
|
| int mod,full; |
int mod,full; |
| NODE n; |
NODE n; |
| |
|
| |
do_weyl = 0; |
| asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf_mod"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_nf_mod"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf_mod"); |
|
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void dp_nf_mod_qindex(b,g,ps,mod,full,rp) |
|
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| { |
|
| DP u,p,d,s,t; |
|
| P dmy; |
|
| NODE l; |
|
| MP m,mr; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
|
| *rp = 0; return; |
|
| } |
|
| sugar = g->sugar; |
|
| for ( d = 0; g; ) { |
|
| for ( u = 0, l = b; l; l = NEXT(l) ) { |
|
| if ( dp_redble(g,p = ps[QTOS((Q)BDY(l))]) ) { |
|
| dp_red_mod(d,g,p,mod,&t,&u,&dmy); |
|
| 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; |
|
| 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) |
|
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| { |
|
| DP u,p,d,s,t; |
|
| P dmy; |
|
| NODE l; |
|
| MP m,mr; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
|
| *rp = 0; return; |
|
| } |
|
| sugar = g->sugar; |
|
| for ( d = 0; g; ) { |
|
| for ( u = 0, l = b; l; l = NEXT(l) ) { |
|
| if ( dp_redble(g,p = ps[(int)BDY(l)]) ) { |
|
| dp_red_mod(d,g,p,mod,&t,&u,&dmy); |
|
| 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; |
|
| 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) |
|
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int mod,full; |
|
| DP *rp; |
|
| P *dnp; |
|
| { |
|
| DP u,p,d,s,t; |
|
| NODE l; |
|
| MP m,mr; |
|
| int i,n; |
|
| int *wb; |
|
| int sugar,psugar; |
|
| P dn,tdn,tdn1; |
|
| |
|
| dn = (P)ONEM; |
|
| if ( !g ) { |
|
| *rp = 0; *dnp = dn; return; |
|
| } |
|
| 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,p = ps[wb[i]]) ) { |
|
| 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 Pdp_tdiv(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| } |
} |
| } |
} |
| |
|
| void qltozl(w,n,dvr) |
|
| Q *w,*dvr; |
|
| int n; |
|
| { |
|
| N nm,dn; |
|
| N g,l1,l2,l3; |
|
| Q c,d; |
|
| int i; |
|
| struct oVECT v; |
|
| |
|
| for ( i = 0; i < n; i++ ) |
|
| if ( w[i] && !INT(w[i]) ) |
|
| break; |
|
| if ( i == n ) { |
|
| v.id = O_VECT; v.len = n; v.body = (pointer *)w; |
|
| igcdv(&v,dvr); return; |
|
| } |
|
| c = w[0]; nm = NM(c); dn = INT(c) ? ONEN : DN(c); |
|
| for ( i = 1; i < n; i++ ) { |
|
| c = w[i]; l1 = INT(c) ? ONEN : DN(c); |
|
| gcdn(nm,NM(c),&g); nm = g; |
|
| gcdn(dn,l1,&l2); muln(dn,l1,&l3); divsn(l3,l2,&dn); |
|
| } |
|
| if ( UNIN(dn) ) |
|
| NTOQ(nm,1,d); |
|
| else |
|
| NDTOQ(nm,dn,1,d); |
|
| *dvr = d; |
|
| } |
|
| |
|
| int comp_nm(a,b) |
|
| Q *a,*b; |
|
| { |
|
| return cmpn((*a)?NM(*a):0,(*b)?NM(*b):0); |
|
| } |
|
| |
|
| void sortbynm(w,n) |
|
| Q *w; |
|
| int n; |
|
| { |
|
| qsort(w,n,sizeof(Q),(int (*)(const void *,const void *))comp_nm); |
|
| } |
|
| |
|
| void Pdp_redble(arg,rp) |
void Pdp_redble(arg,rp) |
| NODE arg; |
NODE arg; |
| Q *rp; |
Q *rp; |
|
|
| P dmy; |
P dmy; |
| NODE n; |
NODE n; |
| |
|
| |
do_weyl = 0; |
| asir_assert(ARG0(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG0(arg),O_DP,"dp_red_mod"); |
| asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
| asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
|
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| int dp_redble(p1,p2) |
void Pdp_subd(arg,rp) |
| DP p1,p2; |
NODE arg; |
| |
DP *rp; |
| { |
{ |
| int i,n; |
DP p1,p2; |
| DL d1,d2; |
|
| |
|
| d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| if ( d1->td < d2->td ) |
asir_assert(p1,O_DP,"dp_subd"); |
| return 0; |
asir_assert(p2,O_DP,"dp_subd"); |
| else { |
dp_subd(p1,p2,rp); |
| for ( i = 0, n = p1->nv; i < n; i++ ) |
|
| if ( d1->d[i] < d2->d[i] ) |
|
| return 0; |
|
| return 1; |
|
| } |
|
| } |
} |
| |
|
| void dp_red_mod(p0,p1,p2,mod,head,rest,dnp) |
void Pdp_symb_add(arg,rp) |
| DP p0,p1,p2; |
NODE arg; |
| int mod; |
DP *rp; |
| DP *head,*rest; |
|
| P *dnp; |
|
| { |
{ |
| int i,n; |
DP p1,p2,r; |
| DL d1,d2,d; |
NODE s0; |
| MP m; |
MP mp0,mp; |
| DP t,s,r,h; |
int nv; |
| P c1,c2,g,u; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(p1,O_DP,"dp_symb_add"); |
| for ( i = 0; i < n; i++ ) |
asir_assert(p2,O_DP,"dp_symb_add"); |
| d->d[i] = d1->d[i]-d2->d[i]; |
if ( p1->nv != p2->nv ) |
| c1 = (P)BDY(p1)->c; c2 = (P)BDY(p2)->c; |
error("dp_sumb_add : invalid input"); |
| gcdprsmp(CO,mod,c1,c2,&g); |
nv = p1->nv; |
| divsmp(CO,mod,c1,g,&u); c1 = u; divsmp(CO,mod,c2,g,&u); c2 = u; |
s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv); |
| if ( NUM(c2) ) { |
for ( mp0 = 0; s0; s0 = NEXT(s0) ) { |
| divsmp(CO,mod,c1,c2,&u); c1 = u; c2 = (P)ONEM; |
NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (P)ONE; |
| } |
} |
| NEWMP(m); m->dl = d; chsgnmp(mod,(P)c1,&m->c); NEXT(m) = 0; |
NEXT(mp) = 0; |
| MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&t); |
MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar); |
| if ( NUM(c2) ) { |
*rp = r; |
| addmd(CO,mod,p1,t,&r); h = p0; |
|
| } else { |
|
| mulmdc(CO,mod,p1,c2,&s); addmd(CO,mod,s,t,&r); mulmdc(CO,mod,p0,c2,&h); |
|
| } |
|
| *head = h; *rest = r; *dnp = c2; |
|
| } |
} |
| |
|
| void Pdp_subd(arg,rp) |
void Pdp_mul_trunc(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| |
DP p1,p2,p; |
| |
|
| |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg); |
| |
asir_assert(p1,O_DP,"dp_mul_trunc"); |
| |
asir_assert(p2,O_DP,"dp_mul_trunc"); |
| |
asir_assert(p,O_DP,"dp_mul_trunc"); |
| |
comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp); |
| |
} |
| |
|
| |
void Pdp_quo(arg,rp) |
| |
NODE arg; |
| |
DP *rp; |
| |
{ |
| DP p1,p2; |
DP p1,p2; |
| |
|
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| asir_assert(p1,O_DP,"dp_subd"); |
asir_assert(p1,O_DP,"dp_quo"); |
| asir_assert(p2,O_DP,"dp_subd"); |
asir_assert(p2,O_DP,"dp_quo"); |
| dp_subd(p1,p2,rp); |
comm_quod(CO,p1,p2,rp); |
| } |
} |
| |
|
| void dp_subd(p1,p2,rp) |
void Pdp_weyl_mul(arg,rp) |
| DP p1,p2; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| int i,n; |
DP p1,p2; |
| DL d1,d2,d; |
|
| MP m; |
|
| DP s; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul"); |
| for ( i = 0; i < n; i++ ) |
do_weyl = 1; |
| d->d[i] = d1->d[i]-d2->d[i]; |
muld(CO,p1,p2,rp); |
| NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
do_weyl = 0; |
| MKDP(n,m,s); s->sugar = d->td; |
|
| *rp = s; |
|
| } |
} |
| |
|
| void dltod(d,n,rp) |
void Pdp_weyl_mul_mod(arg,rp) |
| DL d; |
NODE arg; |
| int n; |
|
| DP *rp; |
DP *rp; |
| { |
{ |
| MP m; |
DP p1,p2; |
| DP s; |
Q m; |
| |
|
| NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg); |
| MKDP(n,m,s); s->sugar = d->td; |
asir_assert(p1,O_DP,"dp_weyl_mul_mod"); |
| *rp = s; |
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 Pdp_red(arg,rp) |
void Pdp_red(arg,rp) |
|
|
| DP head,rest,dmy1; |
DP head,rest,dmy1; |
| P dmy; |
P dmy; |
| |
|
| |
do_weyl = 0; |
| asir_assert(ARG0(arg),O_DP,"dp_red"); |
asir_assert(ARG0(arg),O_DP,"dp_red"); |
| asir_assert(ARG1(arg),O_DP,"dp_red"); |
asir_assert(ARG1(arg),O_DP,"dp_red"); |
| asir_assert(ARG2(arg),O_DP,"dp_red"); |
asir_assert(ARG2(arg),O_DP,"dp_red"); |
|
|
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| } |
} |
| |
|
| void dp_red(p0,p1,p2,head,rest,dnp,multp) |
void Pdp_weyl_red(arg,rp) |
| DP p0,p1,p2; |
NODE arg; |
| DP *head,*rest; |
LIST *rp; |
| P *dnp; |
|
| DP *multp; |
|
| { |
{ |
| int i,n; |
NODE n; |
| DL d1,d2,d; |
DP head,rest,dmy1; |
| MP m; |
P dmy; |
| 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; |
asir_assert(ARG0(arg),O_DP,"dp_weyl_red"); |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(ARG1(arg),O_DP,"dp_weyl_red"); |
| for ( i = 0; i < n; i++ ) |
asir_assert(ARG2(arg),O_DP,"dp_weyl_red"); |
| d->d[i] = d1->d[i]-d2->d[i]; |
do_weyl = 1; |
| c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c; |
dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1); |
| if ( dp_fcoeffs ) { |
do_weyl = 0; |
| /* do nothing */ |
NEWNODE(n); BDY(n) = (pointer)head; |
| } else if ( INT(c1) && INT(c2) ) { |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest; |
| gcdn(NM(c1),NM(c2),&gn); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| 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; |
|
| } |
|
| } else { |
|
| ezgcdpz(CO,(P)c1,(P)c2,&g); |
|
| divsp(CO,(P)c1,g,&a); c1 = (Q)a; divsp(CO,(P)c2,g,&a); c2 = (Q)a; |
|
| } |
|
| NEWMP(m); m->dl = d; chsgnp((P)c1,&m->c); NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td; |
|
| *multp = s; |
|
| muld(CO,s,p2,&t); muldc(CO,p1,(P)c2,&s); addd(CO,s,t,&r); |
|
| muldc(CO,p0,(P)c2,&h); |
|
| *head = h; *rest = r; *dnp = (P)c2; |
|
| } |
} |
| |
|
| void Pdp_sp(arg,rp) |
void Pdp_sp(arg,rp) |
|
|
| { |
{ |
| DP p1,p2; |
DP p1,p2; |
| |
|
| |
do_weyl = 0; |
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp"); |
| dp_sp(p1,p2,rp); |
dp_sp(p1,p2,rp); |
| } |
} |
| |
|
| extern int GenTrace; |
void Pdp_weyl_sp(arg,rp) |
| extern NODE TraceList; |
NODE arg; |
| |
|
| void dp_sp(p1,p2,rp) |
|
| DP p1,p2; |
|
| DP *rp; |
DP *rp; |
| { |
{ |
| int i,n,td; |
DP p1,p2; |
| int *w; |
|
| DL d1,d2,d; |
|
| 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; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| w = (int *)ALLOCA(n*sizeof(int)); |
asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp"); |
| for ( i = 0, td = 0; i < n; i++ ) { |
do_weyl = 1; |
| w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; |
dp_sp(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]; |
|
| 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; |
|
| MKDP(n,m,s1); s1->sugar = d->td; muld(CO,s1,p1,&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)c1; NEXT(m) = 0; |
|
| MKDP(n,m,s2); s2->sugar = d->td; muld(CO,s2,p2,&u); |
|
| |
|
| subd(CO,t,u,rp); |
|
| if ( GenTrace ) { |
|
| LIST hist; |
|
| NODE node; |
|
| |
|
| node = mknode(4,ONE,0,s1,ONE); |
|
| MKLIST(hist,node); |
|
| MKNODE(TraceList,hist,0); |
|
| |
|
| node = mknode(4,ONE,0,0,ONE); |
|
| chsgnd(s2,(DP *)&ARG2(node)); |
|
| MKLIST(hist,node); |
|
| MKNODE(node,hist,TraceList); TraceList = node; |
|
| } |
|
| } |
} |
| |
|
| void Pdp_sp_mod(arg,rp) |
void Pdp_sp_mod(arg,rp) |
|
|
| DP p1,p2; |
DP p1,p2; |
| int mod; |
int mod; |
| |
|
| |
do_weyl = 0; |
| p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
| asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
| asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
|
|
| dp_sp_mod(p1,p2,mod,rp); |
dp_sp_mod(p1,p2,mod,rp); |
| } |
} |
| |
|
| void dp_sp_mod(p1,p2,mod,rp) |
|
| DP p1,p2; |
|
| int mod; |
|
| DP *rp; |
|
| { |
|
| int i,n,td; |
|
| int *w; |
|
| DL d1,d2,d; |
|
| MP m; |
|
| DP t,s,u; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
|
| w = (int *)ALLOCA(n*sizeof(int)); |
|
| for ( i = 0, td = 0; i < n; i++ ) { |
|
| w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; |
|
| } |
|
| 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_lcm(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
| NEWDL(d,n); |
NEWDL(d,n); |
| for ( i = 0, td = 0; i < n; i++ ) { |
for ( i = 0, td = 0; i < n; i++ ) { |
| d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i]; |
d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i); |
| } |
} |
| d->td = td; |
d->td = td; |
| NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; |
|
|
| dp_hm(p,rp); |
dp_hm(p,rp); |
| } |
} |
| |
|
| void dp_hm(p,rp) |
|
| DP p; |
|
| DP *rp; |
|
| { |
|
| MP m,mr; |
|
| |
|
| if ( !p ) |
|
| *rp = 0; |
|
| else { |
|
| m = BDY(p); |
|
| NEWMP(mr); mr->dl = m->dl; mr->c = m->c; NEXT(mr) = 0; |
|
| MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */ |
|
| } |
|
| } |
|
| |
|
| void Pdp_ht(arg,rp) |
void Pdp_ht(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| MP m,mr; |
MP m,mr; |
| |
|
| p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
| if ( !p ) |
dp_ht(p,rp); |
| *rp = 0; |
|
| else { |
|
| m = BDY(p); |
|
| NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; |
|
| MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */ |
|
| } |
|
| } |
} |
| |
|
| void Pdp_hc(arg,rp) |
void Pdp_hc(arg,rp) |
|
|
| dp_rest((DP)ARG0(arg),rp); |
dp_rest((DP)ARG0(arg),rp); |
| } |
} |
| |
|
| void dp_rest(p,rp) |
|
| DP p,*rp; |
|
| { |
|
| MP m; |
|
| |
|
| m = BDY(p); |
|
| if ( !NEXT(m) ) |
|
| *rp = 0; |
|
| else { |
|
| MKDP(p->nv,NEXT(m),*rp); |
|
| if ( *rp ) |
|
| (*rp)->sugar = p->sugar; |
|
| } |
|
| } |
|
| |
|
| void Pdp_td(arg,rp) |
void Pdp_td(arg,rp) |
| NODE arg; |
NODE arg; |
| Q *rp; |
Q *rp; |
|
|
| STOQ(p->sugar,*rp); |
STOQ(p->sugar,*rp); |
| } |
} |
| |
|
| |
void Pdp_initial_term(arg,rp) |
| |
NODE arg; |
| |
Obj *rp; |
| |
{ |
| |
struct order_spec *ord; |
| |
Num homo; |
| |
int modular,is_list; |
| |
LIST v,f,l,initiallist; |
| |
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_order(arg,rp) |
| |
NODE arg; |
| |
Obj *rp; |
| |
{ |
| |
struct order_spec *ord; |
| |
Num homo; |
| |
int modular,is_list; |
| |
LIST v,f,l,ordlist; |
| |
NODE n; |
| |
|
| |
f = (LIST)ARG0(arg); |
| |
if ( f && OID(f) == O_LIST ) |
| |
is_list = 1; |
| |
else { |
| |
n = mknode(1,f); MKLIST(l,n); f = l; |
| |
is_list = 0; |
| |
} |
| |
if ( current_option ) { |
| |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| |
initd(ord); |
| |
} else |
| |
ord = dp_current_spec; |
| |
ordlist = dp_order(f,ord); |
| |
if ( !is_list ) |
| |
*rp = (Obj)BDY(BDY(ordlist)); |
| |
else |
| |
*rp = (Obj)ordlist; |
| |
} |
| |
|
| |
void Pdp_set_sugar(arg,rp) |
| |
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(arg,rp) |
void Pdp_cri1(arg,rp) |
| NODE arg; |
NODE arg; |
| Q *rp; |
Q *rp; |
|
|
| } |
} |
| } |
} |
| |
|
| DL lcm_of_DL(nv,dl1,dl2,dl) |
|
| int nv; |
|
| DL dl1,dl2; |
|
| register DL dl; |
|
| { |
|
| register int n, *d1, *d2, *d, td; |
|
| |
|
| if ( !dl ) NEWDL(dl,nv); |
|
| d = dl->d, d1 = dl1->d, d2 = dl2->d; |
|
| for ( td = 0, n = nv; --n >= 0; d1++, d2++, d++ ) |
|
| td += (*d = *d1 > *d2 ? *d1 : *d2 ); |
|
| dl->td = td; |
|
| return dl; |
|
| } |
|
| |
|
| int dl_equal(nv,dl1,dl2) |
|
| int nv; |
|
| DL dl1, dl2; |
|
| { |
|
| register int *d1, *d2, n; |
|
| |
|
| if ( dl1->td != dl2->td ) return 0; |
|
| for ( d1 = dl1->d, d2 = dl2->d, n = nv; --n >= 0; d1++, d2++ ) |
|
| if ( *d1 != *d2 ) return 0; |
|
| return 1; |
|
| } |
|
| |
|
| void Pdp_nelim(arg,rp) |
void Pdp_nelim(arg,rp) |
| NODE arg; |
NODE arg; |
| Q *rp; |
Q *rp; |
|
|
| dp_homo((DP)ARG0(arg),rp); |
dp_homo((DP)ARG0(arg),rp); |
| } |
} |
| |
|
| void dp_homo(p,rp) |
void Pdp_dehomo(arg,rp) |
| DP p; |
NODE arg; |
| DP *rp; |
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(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
Obj name,value; |
| |
NODE n; |
| |
|
| |
if ( arg ) { |
| |
asir_assert(ARG0(arg),O_LIST,"dp_gr_flags"); |
| |
n = BDY((LIST)ARG0(arg)); |
| |
while ( n ) { |
| |
name = (Obj)BDY(n); n = NEXT(n); |
| |
if ( !n ) |
| |
break; |
| |
else { |
| |
value = (Obj)BDY(n); n = NEXT(n); |
| |
} |
| |
dp_set_flag(name,value); |
| |
} |
| |
} |
| |
dp_make_flaglist(rp); |
| |
} |
| |
|
| |
extern int DP_Print, DP_PrintShort; |
| |
|
| |
void Pdp_gr_print(arg,rp) |
| |
NODE arg; |
| |
Q *rp; |
| |
{ |
| |
Q q; |
| |
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 parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
| |
int *modular,struct order_spec **ord) |
| |
{ |
| |
NODE t,p; |
| |
Q m; |
| |
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; |
| |
|
| |
/* extract vars */ |
| |
vars = 0; |
| |
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 */ |
| |
vars = (LIST)value; |
| |
break; |
| |
} |
| |
} |
| |
if ( vars ) { |
| |
*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 |
| |
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; |
| |
} |
| |
|
| |
void Pdp_gr_main(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
VL vl; |
| |
Num homo; |
| |
Q m; |
| |
int modular,ac; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_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_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(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
VL vl; |
| |
int ac; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_interreduce"); |
| |
f = (LIST)ARG0(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
if ( (ac = argc(arg)) == 3 ) { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_interreduce"); |
| |
v = (LIST)ARG1(arg); |
| |
create_order_spec(0,ARG2(arg),&ord); |
| |
} |
| |
dp_interreduce(f,v,0,ord,rp); |
| |
} |
| |
|
| |
void Pdp_gr_f_main(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,find; |
| |
Obj homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
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; |
| |
} |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
find = get_opt("homo",&homo); |
| |
nd_gr(f,v,m,find&&homo,1,ord,rp); |
| |
} |
| |
|
| |
void Pnd_gr(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,find; |
| |
Obj homo; |
| |
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; |
| |
} |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
find = get_opt("homo",&homo); |
| |
nd_gr(f,v,m,find&&homo,0,ord,rp); |
| |
} |
| |
|
| |
void Pnd_gr_postproc(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,do_check; |
| |
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; |
| |
} |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
do_check = ARG4(arg) ? 1 : 0; |
| |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
| |
} |
| |
|
| |
void Pnd_weyl_gr_postproc(arg,rp) |
| |
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(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
| |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = QTOS((Q)ARG2(arg)); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
| |
} |
| |
|
| |
void Pnd_f4_trace(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG1(arg),O_LIST,"nd_gr_trace"); |
| |
asir_assert(ARG2(arg),O_N,"nd_gr_trace"); |
| |
asir_assert(ARG3(arg),O_N,"nd_gr_trace"); |
| |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
| |
f = remove_zero_from_list(f); |
| |
if ( !BDY(f) ) { |
| |
*rp = f; return; |
| |
} |
| |
homo = QTOS((Q)ARG2(arg)); |
| |
m = QTOS((Q)ARG3(arg)); |
| |
create_order_spec(0,ARG4(arg),&ord); |
| |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
| |
} |
| |
|
| |
void Pnd_weyl_gr(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,find; |
| |
Obj homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 1; |
| |
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); |
| |
find = get_opt("homo",&homo); |
| |
nd_gr(f,v,m,find&&homo,0,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pnd_weyl_gr_trace(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
LIST f,v; |
| |
int m,homo; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 1; |
| |
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); |
| |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
| |
do_weyl = 0; |
| |
} |
| |
|
| |
void Pnd_nf(arg,rp) |
| |
NODE arg; |
| |
P *rp; |
| |
{ |
| |
P f; |
| |
LIST g,v; |
| |
struct order_spec *ord; |
| |
|
| |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_P,"nd_nf"); |
| |
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 = (P)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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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(arg,rp) |
| |
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; |
| |
|
| |
void Pdp_set_weight(arg,rp) |
| |
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; |
| *rp = 0; |
*rp = 0; |
| else { |
} else { |
| n = p->nv; nv = n + 1; |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
| m = BDY(p); td = sugard(m); |
error("dp_set_weight : invalid argument"); |
| for ( mr0 = 0; m; m = NEXT(m) ) { |
if ( OID(ARG0(arg)) == O_VECT ) |
| NEXTMP(mr0,mr); mr->c = m->c; |
v = (VECT)ARG0(arg); |
| dl = m->dl; |
else { |
| mr->dl = dlh = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
node = (NODE)BDY((LIST)ARG0(arg)); |
| dlh->td = td; |
n = length(node); |
| for ( i = 0; i < n; i++ ) |
MKVECT(v,n); |
| dlh->d[i] = dl->d[i]; |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
| dlh->d[n] = td - dl->td; |
BDY(v)[i] = BDY(node); |
| } |
} |
| NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar; |
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]); |
| |
*rp = v; |
| } |
} |
| } |
} |
| |
|
| void Pdp_dehomo(arg,rp) |
VECT current_module_weight_vector_obj; |
| |
int *current_module_weight_vector; |
| |
|
| |
void Pdp_set_module_weight(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
VECT *rp; |
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
VECT v; |
| dp_dehomo((DP)ARG0(arg),rp); |
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; |
| |
} |
| } |
} |
| |
|
| void dp_dehomo(p,rp) |
VECT current_top_weight_vector_obj; |
| DP p; |
N *current_top_weight_vector; |
| DP *rp; |
|
| |
void Pdp_set_top_weight(arg,rp) |
| |
NODE arg; |
| |
VECT *rp; |
| { |
{ |
| MP m,mr,mr0; |
VECT v; |
| int i,n,nv; |
int i,n; |
| DL dl,dlh; |
NODE node; |
| |
|
| if ( !p ) |
if ( !arg ) |
| |
*rp = current_top_weight_vector_obj; |
| |
else if ( !ARG0(arg) ) { |
| |
current_top_weight_vector = 0; |
| |
current_top_weight_vector_obj = 0; |
| *rp = 0; |
*rp = 0; |
| |
} else { |
| |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
| |
error("dp_set_top_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); |
| |
} |
| |
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"); |
| |
current_top_weight_vector_obj = v; |
| |
current_top_weight_vector = (N *)MALLOC(v->len*sizeof(N)); |
| |
for ( i = 0; i < v->len; i++ ) { |
| |
current_top_weight_vector[i] = !BDY(v)[i]?0:NM((Q)BDY(v)[i]); |
| |
} |
| |
*rp = current_top_weight_vector_obj; |
| |
} |
| |
} |
| |
|
| |
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(arg,rp) |
| |
NODE arg; |
| |
VECT *rp; |
| |
{ |
| |
VECT v; |
| |
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 { |
| |
asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight"); |
| |
v = (VECT)ARG0(arg); |
| |
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 { |
else { |
| n = p->nv; nv = n - 1; |
t = BDY((LIST)ARG1(arg)); |
| m = BDY(p); |
nv = length(t); |
| for ( mr0 = 0; m; m = NEXT(m) ) { |
v = (P)MALLOC(nv*sizeof(P)); |
| NEXTMP(mr0,mr); mr->c = m->c; |
for ( vl0 = 0, i = 0; t; t = NEXT(t), i++ ) { |
| dlh = m->dl; |
NEXTVL(vl0,vl); VR(vl) = VR((P)BDY(t)); |
| mr->dl = dl = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
MKV(VR(vl),v[i]); |
| dl->td = dlh->td - dlh->d[nv]; |
|
| for ( i = 0; i < nv; i++ ) |
|
| dl->d[i] = dlh->d[i]; |
|
| } |
} |
| NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar; |
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); |
| } |
} |
| } |
} |
| |
|
| int dp_nt(p) |
LIST remove_zero_from_list(LIST l) |
| DP p; |
|
| { |
{ |
| int i; |
NODE n,r0,r; |
| MP m; |
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 ) |
if ( !p ) |
| return 0; |
return 0; |
| |
else if ( NUM(p) ) |
| |
return NID((Num)p); |
| else { |
else { |
| for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ ); |
type = 0; |
| return i; |
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; |
| |
} |
| |
|
| |
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 = 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