Return to dp.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
version 1.83, 2010/09/27 05:05:58 | version 1.89, 2013/09/09 07:29:25 | ||
---|---|---|---|
|
|
||
* 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.82 2010/05/01 02:17:49 noro Exp $ | * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.88 2013/06/14 04:47:17 ohara Exp $ | ||
*/ | */ | ||
#include "ca.h" | #include "ca.h" | ||
#include "base.h" | #include "base.h" | ||
|
|
||
void Pdp_lnf_f(); | 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_gr_recompute_trace(), Pnd_btog(); | |||
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); | void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); | ||
void Pnd_nf(),Pnd_weyl_nf(); | void Pnd_nf(),Pnd_weyl_nf(); | ||
void Pdp_initial_term(); | void Pdp_initial_term(); | ||
|
|
||
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(); | ||
void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, | void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo, | ||
int *modular,struct order_spec **ord); | int *modular,struct order_spec **ord); | ||
NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *spec, DP *inv); | |||
LIST remove_zero_from_list(LIST); | LIST remove_zero_from_list(LIST); | ||
|
|
||
{"nd_gr_trace",Pnd_gr_trace,5}, | {"nd_gr_trace",Pnd_gr_trace,5}, | ||
{"nd_f4_trace",Pnd_f4_trace,5}, | {"nd_f4_trace",Pnd_f4_trace,5}, | ||
{"nd_gr_postproc",Pnd_gr_postproc,5}, | {"nd_gr_postproc",Pnd_gr_postproc,5}, | ||
#if 0 | |||
{"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5}, | |||
#endif | |||
{"nd_btog",Pnd_btog,5}, | |||
{"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, | {"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, | ||
{"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}, | ||
|
|
||
{"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} | ||
}; | }; | ||
|
|
||
LIST *rp; | LIST *rp; | ||
{ | { | ||
LIST f,v; | LIST f,v; | ||
int m,find; | int m,homo,retdp; | ||
Obj homo; | Obj val; | ||
struct order_spec *ord; | struct order_spec *ord; | ||
do_weyl = 0; | do_weyl = 0; | ||
|
|
||
} | } | ||
m = QTOS((Q)ARG2(arg)); | m = QTOS((Q)ARG2(arg)); | ||
create_order_spec(0,ARG3(arg),&ord); | create_order_spec(0,ARG3(arg),&ord); | ||
find = get_opt("homo",&homo); | homo = retdp = 0; | ||
nd_gr(f,v,m,find&&homo,1,ord,rp); | if ( get_opt("homo",&val) && val ) homo = 1; | ||
if ( get_opt("dp",&val) && val ) retdp = 1; | |||
nd_gr(f,v,m,homo,retdp,1,ord,rp); | |||
} | } | ||
void Pnd_gr(arg,rp) | void Pnd_gr(arg,rp) | ||
|
|
||
LIST *rp; | LIST *rp; | ||
{ | { | ||
LIST f,v; | LIST f,v; | ||
int m,find; | int m,homo,retdp; | ||
Obj homo; | Obj val; | ||
struct order_spec *ord; | struct order_spec *ord; | ||
do_weyl = 0; | do_weyl = 0; | ||
|
|
||
} | } | ||
m = QTOS((Q)ARG2(arg)); | m = QTOS((Q)ARG2(arg)); | ||
create_order_spec(0,ARG3(arg),&ord); | create_order_spec(0,ARG3(arg),&ord); | ||
find = get_opt("homo",&homo); | homo = retdp = 0; | ||
nd_gr(f,v,m,find&&homo,0,ord,rp); | if ( get_opt("homo",&val) && val ) homo = 1; | ||
if ( get_opt("dp",&val) && val ) retdp = 1; | |||
nd_gr(f,v,m,homo,retdp,0,ord,rp); | |||
} | } | ||
void Pnd_gr_postproc(arg,rp) | void Pnd_gr_postproc(arg,rp) | ||
|
|
||
nd_gr_postproc(f,v,m,ord,do_check,rp); | nd_gr_postproc(f,v,m,ord,do_check,rp); | ||
} | } | ||
#if 0 | |||
void Pnd_gr_recompute_trace(arg,rp) | |||
NODE arg; | |||
LIST *rp; | |||
{ | |||
LIST f,v,tlist; | |||
int m; | |||
struct order_spec *ord; | |||
do_weyl = 0; | |||
asir_assert(ARG0(arg),O_LIST,"nd_gr_recompute_trace"); | |||
asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace"); | |||
asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace"); | |||
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); | |||
m = QTOS((Q)ARG2(arg)); | |||
create_order_spec(0,ARG3(arg),&ord); | |||
tlist = (LIST)ARG4(arg); | |||
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); | |||
} | |||
#endif | |||
void Pnd_btog(arg,rp) | |||
NODE arg; | |||
MAT *rp; | |||
{ | |||
LIST f,v,tlist; | |||
int m; | |||
struct order_spec *ord; | |||
do_weyl = 0; | |||
asir_assert(ARG0(arg),O_LIST,"nd_btog"); | |||
asir_assert(ARG1(arg),O_LIST,"nd_btog"); | |||
asir_assert(ARG2(arg),O_N,"nd_btog"); | |||
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); | |||
m = QTOS((Q)ARG2(arg)); | |||
create_order_spec(0,ARG3(arg),&ord); | |||
tlist = (LIST)ARG4(arg); | |||
*rp = nd_btog(f,v,m,ord,tlist); | |||
} | |||
void Pnd_weyl_gr_postproc(arg,rp) | void Pnd_weyl_gr_postproc(arg,rp) | ||
NODE arg; | NODE arg; | ||
LIST *rp; | LIST *rp; | ||
|
|
||
LIST *rp; | LIST *rp; | ||
{ | { | ||
LIST f,v; | LIST f,v; | ||
int m,find; | int m,homo,retdp; | ||
Obj homo; | Obj val; | ||
struct order_spec *ord; | struct order_spec *ord; | ||
do_weyl = 1; | do_weyl = 1; | ||
|
|
||
} | } | ||
m = QTOS((Q)ARG2(arg)); | m = QTOS((Q)ARG2(arg)); | ||
create_order_spec(0,ARG3(arg),&ord); | create_order_spec(0,ARG3(arg),&ord); | ||
find = get_opt("homo",&homo); | homo = retdp = 0; | ||
nd_gr(f,v,m,find&&homo,0,ord,rp); | if ( get_opt("homo",&val) && val ) homo = 1; | ||
if ( get_opt("dp",&val) && val ) retdp = 1; | |||
nd_gr(f,v,m,homo,retdp,0,ord,rp); | |||
do_weyl = 0; | do_weyl = 0; | ||
} | } | ||
|
|
||
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)); | ||
|
|
||
} | } | ||
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) |