| version 1.4, 2000/07/14 08:26:39 |
version 1.56, 2004/12/06 09:29:34 |
|
|
| /* $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.55 2004/12/04 09:39:27 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_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; |
| |
|
| |
int do_weyl; |
| |
|
| |
void Pdp_sort(); |
| |
void Pdp_mul_trunc(),Pdp_quo(); |
| void Pdp_ord(), Pdp_ptod(), Pdp_dtop(); |
void Pdp_ord(), Pdp_ptod(), Pdp_dtop(); |
| 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(); |
| 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_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(); |
| |
void Pdp_nf_f(),Pdp_weyl_nf_f(); |
| |
void Pdp_lnf_f(); |
| |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(); |
| |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
| |
void Pnd_nf(); |
| |
void Pdp_initial_term(); |
| |
void Pdp_order(); |
| |
|
| |
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_nf_demand",Pdp_nf_demand,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_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_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_set_weight",Pdp_set_weight,-1}, |
| |
{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
| |
{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 */ |
| |
{"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}, |
| |
|
| |
/* 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}, |
| |
|
| |
{0,0,0} |
| }; |
}; |
| |
|
| extern int dp_nelim; |
void Pdp_sort(arg,rp) |
| extern int dp_order_pair_length; |
NODE arg; |
| extern struct order_pair *dp_order_pair; |
DP *rp; |
| extern struct order_spec dp_current_spec; |
{ |
| |
dp_sort((DP)ARG0(arg),rp); |
| |
} |
| |
|
| void Pdp_ord(arg,rp) |
void Pdp_mdtod(arg,rp) |
| NODE arg; |
NODE arg; |
| Obj *rp; |
DP *rp; |
| { |
{ |
| struct order_spec spec; |
MP m,mr,mr0; |
| |
DP p; |
| |
P t; |
| |
|
| if ( !arg ) |
p = (DP)ARG0(arg); |
| *rp = dp_current_spec.obj; |
if ( !p ) |
| else if ( !create_order_spec((Obj)ARG0(arg),&spec) ) |
*rp = 0; |
| error("dp_ord : invalid order specification"); |
|
| else { |
else { |
| initd(&spec); *rp = spec.obj; |
for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
| |
mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl; |
| |
} |
| |
NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
| } |
} |
| } |
} |
| |
|
| int create_order_spec(obj,spec) |
void Pdp_sep(arg,rp) |
| Obj obj; |
NODE arg; |
| struct order_spec *spec; |
VECT *rp; |
| { |
{ |
| int i,j,n,s,row,col; |
DP p,r; |
| struct order_pair *l; |
MP m,t; |
| NODE node,t,tn; |
MP *w0,*w; |
| MAT m; |
int i,n,d,nv,sugar; |
| pointer **b; |
VECT v; |
| int **w; |
pointer *pv; |
| |
|
| if ( !obj || NUM(obj) ) { |
p = (DP)ARG0(arg); m = BDY(p); |
| spec->id = 0; spec->obj = obj; |
d = QTOS((Q)ARG1(arg)); |
| spec->ord.simple = QTOS((Q)obj); |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
| return 1; |
if ( d > n ) |
| } else if ( OID(obj) == O_LIST ) { |
d = n; |
| node = BDY((LIST)obj); |
MKVECT(v,d); *rp = v; |
| for ( n = 0, t = node; t; t = NEXT(t), n++ ); |
pv = BDY(v); nv = p->nv; sugar = p->sugar; |
| l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); |
w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP)); |
| for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { |
w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP)); |
| tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); |
for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) { |
| tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); |
NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl; |
| s += l[i].length; |
} |
| } |
for ( i = 0; i < d; i++ ) { |
| spec->id = 1; spec->obj = obj; |
NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar; |
| spec->ord.block.order_pair = l; |
pv[i] = (pointer)r; |
| 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_idiv(arg,rp) |
| struct order_spec *old,*new; |
NODE arg; |
| int n; |
DP *rp; |
| { |
{ |
| struct order_pair *l; |
dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp); |
| int length,nv,row,i,j; |
} |
| int **newm,**oldm; |
|
| |
|
| switch ( old->id ) { |
void Pdp_cont(arg,rp) |
| case 0: |
NODE arg; |
| switch ( old->ord.simple ) { |
Q *rp; |
| case 0: |
{ |
| new->id = 0; new->ord.simple = 0; break; |
dp_cont((DP)ARG0(arg),rp); |
| case 1: |
} |
| l = (struct order_pair *) |
|
| MALLOC_ATOMIC(2*sizeof(struct order_pair)); |
void Pdp_dtov(arg,rp) |
| l[0].length = n; l[0].order = 1; |
NODE arg; |
| l[1].length = 1; l[1].order = 2; |
VECT *rp; |
| new->id = 1; |
{ |
| new->ord.block.order_pair = l; |
dp_dtov((DP)ARG0(arg),rp); |
| new->ord.block.length = 2; new->nv = n+1; |
} |
| break; |
|
| case 2: |
void Pdp_mbase(arg,rp) |
| new->id = 0; new->ord.simple = 1; break; |
NODE arg; |
| case 3: case 4: case 5: |
LIST *rp; |
| new->id = 0; new->ord.simple = old->ord.simple+3; |
{ |
| dp_nelim = n-1; break; |
NODE mb; |
| case 6: case 7: case 8: case 9: |
|
| new->id = 0; new->ord.simple = old->ord.simple; break; |
asir_assert(ARG0(arg),O_LIST,"dp_mbase"); |
| default: |
dp_mbase(BDY((LIST)ARG0(arg)),&mb); |
| error("homogenize_order : invalid input"); |
MKLIST(*rp,mb); |
| } |
} |
| break; |
|
| case 1: |
void Pdp_etov(arg,rp) |
| length = old->ord.block.length; |
NODE arg; |
| l = (struct order_pair *) |
VECT *rp; |
| MALLOC_ATOMIC((length+1)*sizeof(struct order_pair)); |
{ |
| bcopy((char *)old->ord.block.order_pair,(char *)l,length*sizeof(struct order_pair)); |
DP dp; |
| l[length].order = 2; l[length].length = 1; |
int n,i; |
| new->id = 1; new->nv = n+1; |
int *d; |
| new->ord.block.order_pair = l; |
VECT v; |
| new->ord.block.length = length+1; |
Q t; |
| break; |
|
| case 2: |
dp = (DP)ARG0(arg); |
| nv = old->nv; row = old->ord.matrix.row; |
asir_assert(dp,O_DP,"dp_etov"); |
| oldm = old->ord.matrix.matrix; newm = almat(row+1,nv+1); |
n = dp->nv; d = BDY(dp)->dl->d; |
| for ( i = 0; i <= nv; i++ ) |
MKVECT(v,n); |
| newm[0][i] = 1; |
for ( i = 0; i < n; i++ ) { |
| for ( i = 0; i < row; i++ ) { |
STOQ(d[i],t); v->body[i] = (pointer)t; |
| 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"); |
|
| } |
} |
| |
*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 ) |
| |
*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 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; |
|
|
| DP *rp; |
DP *rp; |
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
asir_assert(ARG0(arg),O_DP,"dp_ptozp"); |
| #if INET |
dp_ptozp((DP)ARG0(arg),rp); |
| if ( Dist ) |
|
| dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp); |
|
| else |
|
| #endif |
|
| dp_ptozp((DP)ARG0(arg),rp); |
|
| } |
} |
| |
|
| void Pdp_ptozp2(arg,rp) |
void Pdp_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; |
|
| NODE subst; |
|
| DP *rp; |
|
| { |
|
| MP m,mr,mr0; |
|
| P t,s,s1; |
|
| V v; |
|
| NODE tn; |
|
| |
|
| if ( !p ) |
|
| *rp = 0; |
|
| else { |
|
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
| for ( tn = subst, s = m->c; tn; tn = NEXT(tn) ) { |
|
| v = VR((P)BDY(tn)); tn = NEXT(tn); |
|
| substp(CO,s,v,(P)BDY(tn),&s1); s = s1; |
|
| } |
|
| 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; |
|
| } |
|
| } |
|
| |
|
| void dp_rat(p,rp) |
|
| DP p; |
|
| DP *rp; |
|
| { |
|
| MP m,mr,mr0; |
|
| |
|
| if ( !p ) |
|
| *rp = 0; |
|
| else { |
|
| for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { |
|
| NEXTMP(mr0,mr); mptop(m->c,&mr->c); mr->dl = m->dl; |
|
| } |
|
| if ( mr0 ) { |
|
| NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } else |
|
| *rp = 0; |
|
| } |
|
| } |
|
| |
|
| void Pdp_nf(arg,rp) |
void Pdp_nf(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| DP g; |
DP g; |
| int full; |
int full; |
| |
|
| |
do_weyl = 0; |
| asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_nf"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_nf"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_nf"); |
|
|
| } |
} |
| 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_z(b,g,ps,full,DP_Multiple,rp); |
| } |
} |
| |
|
| void Pdp_true_nf(arg,rp) |
void Pdp_weyl_nf(arg,rp) |
| NODE arg; |
NODE arg; |
| LIST *rp; |
DP *rp; |
| { |
{ |
| NODE b,n; |
NODE b; |
| DP *ps; |
DP *ps; |
| DP g; |
DP g; |
| DP nm; |
|
| P dn; |
|
| int full; |
int full; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf"); |
| asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf"); |
| asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf"); |
| asir_assert(ARG3(arg),O_N,"dp_nf"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf"); |
| if ( !(g = (DP)ARG1(arg)) ) { |
if ( !(g = (DP)ARG1(arg)) ) { |
| nm = 0; dn = (P)ONE; |
*rp = 0; return; |
| } else { |
|
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
|
| full = (Q)ARG3(arg) ? 1 : 0; |
|
| dp_true_nf(b,g,ps,full,&nm,&dn); |
|
| } |
} |
| NEWNODE(n); BDY(n) = (pointer)nm; |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
full = (Q)ARG3(arg) ? 1 : 0; |
| NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
do_weyl = 1; |
| |
dp_nf_z(b,g,ps,full,DP_Multiple,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void dp_nf(b,g,ps,full,rp) |
/* nf computation using field operations */ |
| NODE b; |
|
| DP g; |
void Pdp_nf_f(arg,rp) |
| DP *ps; |
NODE arg; |
| int full; |
|
| DP *rp; |
DP *rp; |
| { |
{ |
| DP u,p,d,s,t,dmy1; |
NODE b; |
| P dmy; |
DP *ps; |
| NODE l; |
DP g; |
| MP m,mr; |
int full; |
| int i,n; |
|
| int *wb; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
do_weyl = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_nf_f"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_nf_f"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_nf_f"); |
| |
asir_assert(ARG3(arg),O_N,"dp_nf_f"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| *rp = 0; return; |
*rp = 0; return; |
| } |
} |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| wb = (int *)ALLOCA(n*sizeof(int)); |
full = (Q)ARG3(arg) ? 1 : 0; |
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
dp_nf_f(b,g,ps,full,rp); |
| 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) |
void Pdp_weyl_nf_f(arg,rp) |
| NODE b; |
|
| DP g; |
|
| DP *ps; |
|
| int full; |
|
| DP *rp; |
|
| P *dnp; |
|
| { |
|
| DP u,p,d,s,t,dmy; |
|
| NODE l; |
|
| MP m,mr; |
|
| int i,n; |
|
| int *wb; |
|
| int sugar,psugar; |
|
| P dn,tdn,tdn1; |
|
| |
|
| dn = (P)ONE; |
|
| 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(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)) |
|
| |
|
| void Pdp_nf_ptozp(arg,rp) |
|
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| NODE b; |
NODE b; |
| DP g; |
|
| DP *ps; |
DP *ps; |
| int full,multiple; |
DP g; |
| |
int full; |
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f"); |
| asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp"); |
asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f"); |
| asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp"); |
asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f"); |
| asir_assert(ARG3(arg),O_N,"dp_nf_ptozp"); |
asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f"); |
| asir_assert(ARG4(arg),O_N,"dp_nf_ptozp"); |
|
| 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; |
| multiple = QTOS((Q)ARG4(arg)); |
do_weyl = 1; |
| dp_nf_ptozp(b,g,ps,full,multiple,rp); |
dp_nf_f(b,g,ps,full,rp); |
| |
do_weyl = 0; |
| } |
} |
| |
|
| void dp_nf_ptozp(b,g,ps,full,multiple,rp) |
void Pdp_nf_mod(arg,rp) |
| NODE b; |
NODE arg; |
| DP g; |
|
| DP *ps; |
|
| int full,multiple; |
|
| DP *rp; |
DP *rp; |
| { |
{ |
| DP u,p,d,s,t,dmy1; |
NODE b; |
| P dmy; |
DP g; |
| NODE l; |
DP *ps; |
| MP m,mr; |
int mod,full,ac; |
| int i,n; |
NODE n,n0; |
| int *wb; |
|
| int hmag; |
|
| int sugar,psugar; |
|
| |
|
| if ( !g ) { |
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; |
*rp = 0; return; |
| } |
} |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| wb = (int *)ALLOCA(n*sizeof(int)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
| for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
| wb[i] = QTOS((Q)BDY(l)); |
NEXTNODE(n0,n); |
| hmag = multiple*HMAG(g); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
| 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 ) |
if ( n0 ) |
| d->sugar = sugar; |
NEXT(n) = 0; |
| *rp = d; |
dp_nf_mod(n0,g,ps,mod,full,rp); |
| } |
} |
| |
|
| void Pdp_nf_demand(arg,rp) |
void Pdp_true_nf(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; |
| NODE b,l; |
DP g; |
| DP *hps; |
DP nm; |
| MP m,mr; |
P dn; |
| int i,n; |
|
| int *wb; |
|
| int full; |
int full; |
| char *fprefix; |
|
| int sugar,psugar; |
|
| |
|
| asir_assert(ARG0(arg),O_LIST,"dp_nf_demand"); |
do_weyl = 0; |
| asir_assert(ARG1(arg),O_DP,"dp_nf_demand"); |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); |
| asir_assert(ARG2(arg),O_N,"dp_nf_demand"); |
asir_assert(ARG1(arg),O_DP,"dp_true_nf"); |
| asir_assert(ARG3(arg),O_VECT,"dp_nf_demand"); |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); |
| asir_assert(ARG4(arg),O_STR,"dp_nf_demand"); |
asir_assert(ARG3(arg),O_N,"dp_nf"); |
| 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)); |
| |
full = (Q)ARG3(arg) ? 1 : 0; |
| |
dp_true_nf(b,g,ps,full,&nm,&dn); |
| } |
} |
| b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0; |
NEWNODE(n); BDY(n) = (pointer)nm; |
| hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg)); |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
| for ( n = 0, l = b; l; l = NEXT(l), n++ ); |
NEXT(NEXT(n)) = 0; MKLIST(*rp,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_mul_trunc(arg,rp) |
| DP p0,p1,p2; |
NODE arg; |
| int mod; |
DP *rp; |
| DP *head,*rest; |
|
| P *dnp; |
|
| { |
{ |
| int i,n; |
DP p1,p2,p; |
| DL d1,d2,d; |
|
| MP m; |
|
| DP t,s,r,h; |
|
| P c1,c2,g,u; |
|
| |
|
| n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg); |
| NEWDL(d,n); d->td = d1->td - d2->td; |
asir_assert(p1,O_DP,"dp_mul_trunc"); |
| for ( i = 0; i < n; i++ ) |
asir_assert(p2,O_DP,"dp_mul_trunc"); |
| d->d[i] = d1->d[i]-d2->d[i]; |
asir_assert(p,O_DP,"dp_mul_trunc"); |
| c1 = (P)BDY(p1)->c; c2 = (P)BDY(p2)->c; |
comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp); |
| gcdprsmp(CO,mod,c1,c2,&g); |
|
| divsmp(CO,mod,c1,g,&u); c1 = u; divsmp(CO,mod,c2,g,&u); c2 = u; |
|
| if ( NUM(c2) ) { |
|
| divsmp(CO,mod,c1,c2,&u); c1 = u; c2 = (P)ONEM; |
|
| } |
|
| NEWMP(m); m->dl = d; chsgnmp(mod,(P)c1,&m->c); NEXT(m) = 0; |
|
| MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&t); |
|
| if ( NUM(c2) ) { |
|
| 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_quo(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
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) |
| *rp = 0; |
NODE arg; |
| else { |
LIST *rp; |
| n = p->nv; nv = n + 1; |
{ |
| m = BDY(p); td = sugard(m); |
Obj name,value; |
| for ( mr0 = 0; m; m = NEXT(m) ) { |
NODE n; |
| NEXTMP(mr0,mr); mr->c = m->c; |
|
| dl = m->dl; |
if ( arg ) { |
| mr->dl = dlh = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_flags"); |
| dlh->td = td; |
n = BDY((LIST)ARG0(arg)); |
| for ( i = 0; i < n; i++ ) |
while ( n ) { |
| dlh->d[i] = dl->d[i]; |
name = (Obj)BDY(n); n = NEXT(n); |
| dlh->d[n] = td - dl->td; |
if ( !n ) |
| |
break; |
| |
else { |
| |
value = (Obj)BDY(n); n = NEXT(n); |
| |
} |
| |
dp_set_flag(name,value); |
| } |
} |
| NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar; |
|
| } |
} |
| |
dp_make_flaglist(rp); |
| } |
} |
| |
|
| void Pdp_dehomo(arg,rp) |
extern int DP_Print, DP_PrintShort; |
| |
|
| |
void Pdp_gr_print(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
Q *rp; |
| { |
{ |
| asir_assert(ARG0(arg),O_DP,"dp_dehomo"); |
Q q; |
| dp_dehomo((DP)ARG0(arg),rp); |
int s; |
| |
|
| |
if ( arg ) { |
| |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
| |
q = (Q)ARG0(arg); |
| |
s = QTOS(q); |
| |
switch ( s ) { |
| |
case 0: |
| |
DP_Print = 0; DP_PrintShort = 0; |
| |
break; |
| |
case 1: |
| |
DP_Print = 1; |
| |
break; |
| |
case 2: |
| |
DP_Print = 0; DP_PrintShort = 1; |
| |
break; |
| |
default: |
| |
DP_Print = s; DP_PrintShort = 0; |
| |
break; |
| |
} |
| |
} else { |
| |
if ( DP_Print ) { |
| |
STOQ(1,q); |
| |
} else if ( DP_PrintShort ) { |
| |
STOQ(2,q); |
| |
} else |
| |
q = 0; |
| |
} |
| |
*rp = q; |
| } |
} |
| |
|
| void dp_dehomo(p,rp) |
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, |
| DP p; |
int *modular,struct order_spec **ord) |
| DP *rp; |
|
| { |
{ |
| MP m,mr,mr0; |
NODE t,p; |
| int i,n,nv; |
Q m; |
| DL dl,dlh; |
char *key; |
| |
Obj value,dmy; |
| |
int ord_is_set = 0; |
| |
int modular_is_set = 0; |
| |
int homo_is_set = 0; |
| |
VL vl,vl0; |
| |
LIST vars; |
| |
char xiname[BUFSIZ]; |
| |
NODE x0,x; |
| |
DP d; |
| |
P xi; |
| |
int nv,i; |
| |
|
| if ( !p ) |
/* extract vars */ |
| |
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_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,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); |
| |
nd_gr(f,v,m,1,ord,rp); |
| |
} |
| |
|
| |
void Pnd_gr(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"); |
| |
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); |
| |
nd_gr(f,v,m,0,ord,rp); |
| |
} |
| |
|
| |
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,ord,rp); |
| |
} |
| |
|
| |
void Pnd_weyl_gr(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"); |
| |
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; return; |
| |
} |
| |
m = QTOS((Q)ARG2(arg)); |
| |
create_order_spec(0,ARG3(arg),&ord); |
| |
nd_gr(f,v,m,0,ord,rp); |
| |
} |
| |
|
| |
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; 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,ord,rp); |
| |
} |
| |
|
| |
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; |
| |
} |
| |
|
| |
static 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); |
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); |
| dlh = m->dl; |
else { |
| mr->dl = dl = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int)); |
node = (NODE)BDY((LIST)ARG0(arg)); |
| dl->td = dlh->td - dlh->d[nv]; |
n = length(node); |
| for ( i = 0; i < nv; i++ ) |
MKVECT(v,n); |
| dl->d[i] = dlh->d[i]; |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
| |
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; |
| } |
} |
| } |
} |
| |
|
| int dp_nt(p) |
static VECT current_weyl_weight_vector_obj; |
| DP p; |
int *current_weyl_weight_vector; |
| |
|
| |
void Pdp_weyl_set_weight(arg,rp) |
| |
NODE arg; |
| |
VECT *rp; |
| { |
{ |
| int i; |
VECT v; |
| MP m; |
int i,n; |
| |
|
| |
if ( !arg ) |
| |
*rp = current_weyl_weight_vector_obj; |
| |
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; |
| |
} |
| |
} |
| |
|
| |
LIST remove_zero_from_list(LIST l) |
| |
{ |
| |
NODE n,r0,r; |
| |
LIST rl; |
| |
|
| |
asir_assert(l,O_LIST,"remove_zero_from_list"); |
| |
n = BDY(l); |
| |
for ( r0 = 0; n; n = NEXT(n) ) |
| |
if ( BDY(n) ) { |
| |
NEXTNODE(r0,r); |
| |
BDY(r) = BDY(n); |
| |
} |
| |
if ( r0 ) |
| |
NEXT(r) = 0; |
| |
MKLIST(rl,r0); |
| |
return rl; |
| |
} |
| |
|
| |
int get_field_type(P p) |
| |
{ |
| |
int type,t; |
| |
DCP dc; |
| |
|
| if ( !p ) |
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; |
| } |
} |
| } |
} |
![[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