=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v retrieving revision 1.56 retrieving revision 1.62 diff -u -p -r1.56 -r1.62 --- OpenXM_contrib2/asir2000/builtin/dp.c 2004/12/06 09:29:34 1.56 +++ OpenXM_contrib2/asir2000/builtin/dp.c 2006/06/05 08:11:10 1.62 @@ -45,12 +45,13 @@ * 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 $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.61 2005/11/12 09:43:01 noro Exp $ */ #include "ca.h" #include "base.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; @@ -92,7 +93,8 @@ 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_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); +void Pnd_gr_postproc(); void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); void Pnd_nf(); void Pdp_initial_term(); @@ -145,6 +147,8 @@ struct ftab dp_tab[] = { {"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",Pnd_weyl_gr,4}, {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, {"nd_nf",Pnd_nf,5}, @@ -439,7 +443,7 @@ Obj *rp; int modular; f.id = O_LIST; f.body = 0; - if ( !arg ) + if ( !arg && !current_option ) *rp = dp_current_spec->obj; else { if ( current_option ) @@ -566,10 +570,42 @@ extern LIST Dist; void Pdp_ptozp(arg,rp) 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"); - dp_ptozp((DP)ARG0(arg),rp); + + /* analyze the option */ + 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,"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) @@ -634,7 +670,7 @@ DP *rp; DP g; int full; - do_weyl = 0; + do_weyl = 0; dp_fcoeffs = 0; asir_assert(ARG0(arg),O_LIST,"dp_nf"); asir_assert(ARG1(arg),O_DP,"dp_nf"); asir_assert(ARG2(arg),O_VECT,"dp_nf"); @@ -759,7 +795,7 @@ LIST *rp; P dn; int full; - do_weyl = 0; + do_weyl = 0; dp_fcoeffs = 0; asir_assert(ARG0(arg),O_LIST,"dp_true_nf"); asir_assert(ARG1(arg),O_DP,"dp_true_nf"); asir_assert(ARG2(arg),O_VECT,"dp_true_nf"); @@ -1798,6 +1834,29 @@ LIST *rp; nd_gr(f,v,m,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_gr_trace(arg,rp) NODE arg; LIST *rp; @@ -1819,9 +1878,33 @@ LIST *rp; 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); + 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; @@ -2030,7 +2113,7 @@ LIST *rp; do_weyl = 0; } -static VECT current_dl_weight_vector_obj; +VECT current_dl_weight_vector_obj; int *current_dl_weight_vector; void Pdp_set_weight(arg,rp)