version 1.46, 2004/02/03 23:31:57 |
version 1.50, 2004/04/15 08:27:42 |
|
|
* 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.45 2003/12/25 08:46:19 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.49 2004/04/15 08:14:13 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 93 void Pdp_lnf_f(); |
|
Line 93 void Pdp_lnf_f(); |
|
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(); |
void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
void Pnd_nf(); |
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); |
LIST remove_zero_from_list(LIST); |
|
|
struct ftab dp_tab[] = { |
struct ftab dp_tab[] = { |
Line 161 struct ftab dp_tab[] = { |
|
Line 168 struct ftab dp_tab[] = { |
|
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
{"dp_weyl_nf_f",Pdp_weyl_nf_f,4}, |
|
|
/* Buchberger algorithm */ |
/* Buchberger algorithm */ |
{"dp_weyl_gr_main",Pdp_weyl_gr_main,5}, |
{"dp_weyl_gr_main",Pdp_weyl_gr_main,-5}, |
{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5}, |
{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5}, |
{"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4}, |
{"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4}, |
|
|
Line 208 struct ftab dp_supp_tab[] = { |
|
Line 215 struct ftab dp_supp_tab[] = { |
|
{"dp_ht",Pdp_ht,1}, |
{"dp_ht",Pdp_ht,1}, |
{"dp_hc",Pdp_hc,1}, |
{"dp_hc",Pdp_hc,1}, |
{"dp_rest",Pdp_rest,1}, |
{"dp_rest",Pdp_rest,1}, |
|
{"dp_initial_term",Pdp_initial_term,1}, |
|
{"dp_order",Pdp_order,1}, |
|
|
/* degree and size */ |
/* degree and size */ |
{"dp_td",Pdp_td,1}, |
{"dp_td",Pdp_td,1}, |
|
|
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 ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST ) |
|
parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&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 ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST ) |
|
parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&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) |
void Pdp_set_sugar(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
Line 1344 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
Line 1409 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
int ord_is_set = 0; |
int ord_is_set = 0; |
int modular_is_set = 0; |
int modular_is_set = 0; |
int homo_is_set = 0; |
int homo_is_set = 0; |
VL vl; |
VL vl,vl0; |
LIST vars; |
LIST vars; |
|
char xiname[BUFSIZ]; |
|
NODE x0,x; |
|
DP d; |
|
P xi; |
|
int nv,i; |
|
|
/* extract vars */ |
/* extract vars */ |
vars = 0; |
vars = 0; |
Line 1359 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
Line 1429 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
break; |
break; |
} |
} |
} |
} |
if ( !vars ) { |
if ( vars ) { |
get_vars((Obj)f,&vl); vltopl(vl,v); |
|
} else { |
|
*v = vars; pltovl(vars,&vl); |
*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) ) { |
for ( t = opt; t; t = NEXT(t) ) { |
|
|
asir_assert(ARG1(arg),O_LIST,"dp_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_main"); |
asir_assert(ARG2(arg),O_N,"dp_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Q)ARG3(arg); |
m = (Q)ARG3(arg); |
if ( !m ) |
if ( !m ) |
|
|
LIST f,v; |
LIST f,v; |
Num homo; |
Num homo; |
Q m; |
Q m; |
int modular; |
int modular,ac; |
struct order_spec *ord; |
struct order_spec *ord; |
|
|
|
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
f = (LIST)ARG0(arg); |
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); |
f = remove_zero_from_list(f); |
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = (Num)ARG2(arg); |
if ( argc(arg) == 5 ) { |
m = (Q)ARG3(arg); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main"); |
if ( !m ) |
asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main"); |
modular = 0; |
asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main"); |
else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) ) |
v = (LIST)ARG1(arg); |
error("dp_gr_main : too large modulus"); |
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 ( (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST ) |
|
parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord); |
|
else if ( ac == 1 ) |
|
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
else |
else |
modular = QTOS(m); |
error("dp_weyl_gr_main : invalid argument"); |
create_order_spec(0,ARG4(arg),&ord); |
|
do_weyl = 1; |
do_weyl = 1; |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
dp_gr_main(f,v,homo,modular,0,ord,rp); |
do_weyl = 0; |
do_weyl = 0; |