=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v retrieving revision 1.57 retrieving revision 1.63 diff -u -p -r1.57 -r1.63 --- OpenXM_contrib2/asir2000/builtin/dp.c 2004/12/09 08:56:43 1.57 +++ OpenXM_contrib2/asir2000/builtin/dp.c 2006/06/09 09:59:12 1.63 @@ -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.56 2004/12/06 09:29:34 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.62 2006/06/05 08:11:10 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; @@ -74,6 +75,7 @@ void Pdp_minp(),Pdp_sp_mod(); void Pdp_homo(),Pdp_dehomo(); 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_interreduce(); void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main(); void Pdp_gr_print(); void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f(); @@ -92,7 +94,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(); @@ -139,12 +142,15 @@ struct ftab dp_tab[] = { /* Buchberger algorithm */ {"dp_gr_main",Pdp_gr_main,-5}, + {"dp_interreduce",Pdp_interreduce,3}, {"dp_gr_mod_main",Pdp_gr_mod_main,5}, {"dp_gr_f_main",Pdp_gr_f_main,4}, {"dp_gr_checklist",Pdp_gr_checklist,2}, {"nd_f4",Pnd_f4,4}, {"nd_gr",Pnd_gr,4}, {"nd_gr_trace",Pnd_gr_trace,5}, + {"nd_f4_trace",Pnd_f4_trace,5}, + {"nd_gr_postproc",Pnd_gr_postproc,5}, {"nd_weyl_gr",Pnd_weyl_gr,4}, {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, {"nd_nf",Pnd_nf,5}, @@ -439,7 +445,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 +572,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 +672,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 +797,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"); @@ -1621,6 +1659,30 @@ LIST *rp; 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; @@ -1798,6 +1860,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,7 +1904,31 @@ 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)