| version 1.82, 2010/05/01 02:17:49 | 
version 1.85, 2011/03/30 02:43:18 | 
 | 
 | 
|   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | 
|   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. | 
  * 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 $ | 
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.84 2011/02/18 02:54:48 noro Exp $ | 
|  */ | 
 */ | 
|  #include "ca.h" | 
 #include "ca.h" | 
|  #include "base.h" | 
 #include "base.h" | 
| Line 97  void Pdp_lnf_f(); | 
 
  | 
| Line 97  void Pdp_lnf_f(); | 
 
 
 | 
|  void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); | 
 void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace(); | 
|  void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); | 
 void Pnd_gr_postproc(), Pnd_weyl_gr_postproc(); | 
|  void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); | 
 void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); | 
|  void Pnd_nf(); | 
 void Pnd_nf(),Pnd_weyl_nf(); | 
|  void Pdp_initial_term(); | 
 void Pdp_initial_term(); | 
|  void Pdp_order(); | 
 void Pdp_order(); | 
|  void Pdp_inv_or_split(); | 
 void Pdp_inv_or_split(); | 
| Line 107  void Pdp_compute_essential_df(); | 
 
  | 
| Line 107  void Pdp_compute_essential_df(); | 
 
 
 | 
|  void Pdp_get_denomlist(); | 
 void Pdp_get_denomlist(); | 
|  void Pdp_symb_add(); | 
 void Pdp_symb_add(); | 
|  void Pdp_mono_raddec(); | 
 void Pdp_mono_raddec(); | 
|   | 
 void Pdp_mono_reduce(); | 
|   | 
  | 
|  LIST dp_initial_term(); | 
 LIST dp_initial_term(); | 
|  LIST dp_order(); | 
 LIST dp_order(); | 
| Line 166  struct ftab dp_tab[] = { | 
 
  | 
| Line 167  struct ftab dp_tab[] = { | 
 
 
 | 
|          {"nd_weyl_gr",Pnd_weyl_gr,4}, | 
         {"nd_weyl_gr",Pnd_weyl_gr,4}, | 
|          {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, | 
         {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5}, | 
|          {"nd_nf",Pnd_nf,5}, | 
         {"nd_nf",Pnd_nf,5}, | 
|   | 
         {"nd_weyl_nf",Pnd_weyl_nf,5}, | 
|   | 
  | 
|          /* F4 algorithm */ | 
         /* F4 algorithm */ | 
|          {"dp_f4_main",Pdp_f4_main,3}, | 
         {"dp_f4_main",Pdp_f4_main,3}, | 
| Line 267  struct ftab dp_supp_tab[] = { | 
 
  | 
| Line 269  struct ftab dp_supp_tab[] = { | 
 
 
 | 
|          {"dp_compute_last_t",Pdp_compute_last_t,5}, | 
         {"dp_compute_last_t",Pdp_compute_last_t,5}, | 
|          {"dp_compute_essential_df",Pdp_compute_essential_df,2}, | 
         {"dp_compute_essential_df",Pdp_compute_essential_df,2}, | 
|          {"dp_mono_raddec",Pdp_mono_raddec,2}, | 
         {"dp_mono_raddec",Pdp_mono_raddec,2}, | 
|   | 
         {"dp_mono_reduce",Pdp_mono_reduce,2}, | 
|   | 
  | 
|          {0,0,0} | 
         {0,0,0} | 
|  }; | 
 }; | 
 | 
 | 
|          do_weyl = 0; | 
         do_weyl = 0; | 
|  } | 
 } | 
|   | 
  | 
|  void Pnd_nf(arg,rp) | 
 void Pnd_nf(NODE arg,Obj *rp) | 
|  NODE arg; | 
  | 
|  P *rp; | 
  | 
|  { | 
 { | 
|          P f; | 
         Obj f; | 
|          LIST g,v; | 
         LIST g,v; | 
|          struct order_spec *ord; | 
         struct order_spec *ord; | 
|   | 
  | 
|          do_weyl = 0; | 
         do_weyl = 0; | 
|          asir_assert(ARG0(arg),O_P,"nd_nf"); | 
  | 
|          asir_assert(ARG1(arg),O_LIST,"nd_nf"); | 
         asir_assert(ARG1(arg),O_LIST,"nd_nf"); | 
|          asir_assert(ARG2(arg),O_LIST,"nd_nf"); | 
         asir_assert(ARG2(arg),O_LIST,"nd_nf"); | 
|          asir_assert(ARG4(arg),O_N,"nd_nf"); | 
         asir_assert(ARG4(arg),O_N,"nd_nf"); | 
|          f = (P)ARG0(arg); | 
         f = (Obj)ARG0(arg); | 
|          g = (LIST)ARG1(arg); g = remove_zero_from_list(g); | 
         g = (LIST)ARG1(arg); g = remove_zero_from_list(g); | 
|          if ( !BDY(g) ) { | 
         if ( !BDY(g) ) { | 
|                  *rp = f; return; | 
                 *rp = f; return; | 
 | 
 | 
|          nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); | 
         nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); | 
|  } | 
 } | 
|   | 
  | 
|   | 
 void Pnd_weyl_nf(NODE arg,Obj *rp) | 
|   | 
 { | 
|   | 
         Obj f; | 
|   | 
         LIST g,v; | 
|   | 
         struct order_spec *ord; | 
|   | 
  | 
|   | 
         do_weyl = 1; | 
|   | 
         asir_assert(ARG1(arg),O_LIST,"nd_weyl_nf"); | 
|   | 
         asir_assert(ARG2(arg),O_LIST,"nd_weyl_nf"); | 
|   | 
         asir_assert(ARG4(arg),O_N,"nd_weyl_nf"); | 
|   | 
         f = (Obj)ARG0(arg); | 
|   | 
         g = (LIST)ARG1(arg); g = remove_zero_from_list(g); | 
|   | 
         if ( !BDY(g) ) { | 
|   | 
                 *rp = f; return; | 
|   | 
         } | 
|   | 
         v = (LIST)ARG2(arg); | 
|   | 
         create_order_spec(0,ARG3(arg),&ord); | 
|   | 
         nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); | 
|   | 
 } | 
|   | 
  | 
|  /* for Weyl algebra */ | 
 /* for Weyl algebra */ | 
|   | 
  | 
|  void Pdp_weyl_gr_main(arg,rp) | 
 void Pdp_weyl_gr_main(arg,rp) | 
 | 
 | 
|  VECT *rp; | 
 VECT *rp; | 
|  { | 
 { | 
|          VECT v; | 
         VECT v; | 
|   | 
         NODE node; | 
|          int i,n; | 
         int i,n; | 
|   | 
  | 
|          if ( !arg ) | 
         if ( !arg ) | 
 | 
 | 
|                  current_weyl_weight_vector = 0; | 
                 current_weyl_weight_vector = 0; | 
|                  *rp = 0; | 
                 *rp = 0; | 
|          } else { | 
         } else { | 
|                  asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight"); | 
                 if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) | 
|                  v = (VECT)ARG0(arg); | 
                         error("dp_weyl_set_weight : invalid argument"); | 
|   | 
                 if ( OID(ARG0(arg)) == O_VECT ) | 
|   | 
                         v = (VECT)ARG0(arg); | 
|   | 
                 else { | 
|   | 
                         node = (NODE)BDY((LIST)ARG0(arg)); | 
|   | 
                         n = length(node); | 
|   | 
                         MKVECT(v,n); | 
|   | 
                         for ( i = 0; i < n; i++, node = NEXT(node) ) | 
|   | 
                                 BDY(v)[i] = BDY(node); | 
|   | 
                 } | 
|                  current_weyl_weight_vector_obj = v; | 
                 current_weyl_weight_vector_obj = v; | 
|                  n = v->len; | 
                 n = v->len; | 
|                  current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); | 
                 current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); | 
| Line 2673  void Pdp_mono_raddec(NODE arg,LIST *rp) | 
 
  | 
| Line 2703  void Pdp_mono_raddec(NODE arg,LIST *rp) | 
 
 
 | 
|                  } | 
                 } | 
|                  MKLIST(*rp,r); | 
                 MKLIST(*rp,r); | 
|          } | 
         } | 
|   | 
 } | 
|   | 
  | 
|   | 
 void Pdp_mono_reduce(NODE arg,LIST *rp) | 
|   | 
 { | 
|   | 
         NODE t,t0,t1,r0,r; | 
|   | 
         int i,n; | 
|   | 
         DP m; | 
|   | 
         DP *a; | 
|   | 
  | 
|   | 
         t0 = BDY((LIST)ARG0(arg)); | 
|   | 
         t1 = BDY((LIST)ARG1(arg)); | 
|   | 
         n = length(t0); | 
|   | 
         a = (DP *)MALLOC(n*sizeof(DP)); | 
|   | 
         for ( i = 0; i < n; i++, t0 = NEXT(t0) ) a[i] = (DP)BDY(t0); | 
|   | 
         for ( t = t1; t; t = NEXT(t) ) { | 
|   | 
                 m = (DP)BDY(t); | 
|   | 
                 for ( i = 0; i < n; i++ ) | 
|   | 
                         if ( a[i] && dp_redble(a[i],m) ) a[i] = 0; | 
|   | 
         } | 
|   | 
         for ( i = n-1, r0 = 0; i >= 0; i-- ) | 
|   | 
                 if ( a[i] ) { NEXTNODE(r0,r); BDY(r) = a[i]; } | 
|   | 
         if ( r0 ) NEXT(r) = 0; | 
|   | 
         MKLIST(*rp,r0); | 
|  } | 
 } | 
|   | 
  | 
|  LIST remove_zero_from_list(LIST l) | 
 LIST remove_zero_from_list(LIST l) |