| version 1.47, 2004/03/09 08:31:47 |
version 1.53, 2004/05/14 09:20:56 |
|
|
| * 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.46 2004/02/03 23:31:57 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.52 2004/05/14 06:02:54 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "base.h" |
#include "base.h" |
| Line 55 extern int dp_nelim; |
|
| Line 55 extern int dp_nelim; |
|
| extern int dp_order_pair_length; |
extern int dp_order_pair_length; |
| extern struct order_pair *dp_order_pair; |
extern struct order_pair *dp_order_pair; |
| extern struct order_spec *dp_current_spec; |
extern struct order_spec *dp_current_spec; |
| |
extern struct modorder_spec *dp_current_modspec; |
| |
|
| int do_weyl; |
int do_weyl; |
| |
|
| Line 79 void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_md |
|
| Line 80 void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_md |
|
| void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep(); |
void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep(); |
| void Pdp_cont(); |
void Pdp_cont(); |
| void Pdp_gr_checklist(); |
void Pdp_gr_checklist(); |
| |
void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc(); |
| |
|
| void Pdp_weyl_red(); |
void Pdp_weyl_red(); |
| void Pdp_weyl_sp(); |
void Pdp_weyl_sp(); |
| Line 93 void Pdp_lnf_f(); |
|
| Line 95 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 170 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 179 struct ftab dp_supp_tab[] = { |
|
| Line 188 struct ftab dp_supp_tab[] = { |
|
| /* setting flags */ |
/* setting flags */ |
| {"dp_sort",Pdp_sort,1}, |
{"dp_sort",Pdp_sort,1}, |
| {"dp_ord",Pdp_ord,-1}, |
{"dp_ord",Pdp_ord,-1}, |
| |
{"dpv_ord",Pdpv_ord,-2}, |
| {"dp_set_kara",Pdp_set_kara,-1}, |
{"dp_set_kara",Pdp_set_kara,-1}, |
| {"dp_nelim",Pdp_nelim,-1}, |
{"dp_nelim",Pdp_nelim,-1}, |
| {"dp_gr_flags",Pdp_gr_flags,-1}, |
{"dp_gr_flags",Pdp_gr_flags,-1}, |
| {"dp_gr_print",Pdp_gr_print,-1}, |
{"dp_gr_print",Pdp_gr_print,-1}, |
| |
|
| /* converters */ |
/* converters */ |
| {"dp_ptod",Pdp_ptod,2}, |
{"dp_ptod",Pdp_ptod,-2}, |
| {"dp_dtop",Pdp_dtop,2}, |
{"dp_dtop",Pdp_dtop,2}, |
| {"dp_homo",Pdp_homo,1}, |
{"dp_homo",Pdp_homo,1}, |
| {"dp_dehomo",Pdp_dehomo,1}, |
{"dp_dehomo",Pdp_dehomo,1}, |
| Line 195 struct ftab dp_supp_tab[] = { |
|
| Line 205 struct ftab dp_supp_tab[] = { |
|
| {"dp_mdtod",Pdp_mdtod,1}, |
{"dp_mdtod",Pdp_mdtod,1}, |
| {"dp_mod",Pdp_mod,3}, |
{"dp_mod",Pdp_mod,3}, |
| {"dp_rat",Pdp_rat,1}, |
{"dp_rat",Pdp_rat,1}, |
| |
{"dp_ltod",Pdp_ltod,-2}, |
| |
|
| /* criteria */ |
/* criteria */ |
| {"dp_cri1",Pdp_cri1,2}, |
{"dp_cri1",Pdp_cri1,2}, |
| Line 207 struct ftab dp_supp_tab[] = { |
|
| Line 218 struct ftab dp_supp_tab[] = { |
|
| {"dp_hm",Pdp_hm,1}, |
{"dp_hm",Pdp_hm,1}, |
| {"dp_ht",Pdp_ht,1}, |
{"dp_ht",Pdp_ht,1}, |
| {"dp_hc",Pdp_hc,1}, |
{"dp_hc",Pdp_hc,1}, |
| |
{"dpv_hm",Pdpv_hm,1}, |
| |
{"dpv_ht",Pdpv_ht,1}, |
| |
{"dpv_hc",Pdpv_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}, |
|
|
| Obj *rp; |
Obj *rp; |
| { |
{ |
| struct order_spec *spec; |
struct order_spec *spec; |
| |
LIST v; |
| |
struct oLIST f; |
| |
Num homo; |
| |
int modular; |
| |
|
| |
f.id = O_LIST; f.body = 0; |
| if ( !arg ) |
if ( !arg ) |
| *rp = dp_current_spec->obj; |
*rp = dp_current_spec->obj; |
| else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
|
| error("dp_ord : invalid order specification"); |
|
| else { |
else { |
| |
if ( current_option ) |
| |
parse_gr_option(&f,current_option,&v,&homo,&modular,&spec); |
| |
else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) ) |
| |
error("dp_ord : invalid order specification"); |
| initd(spec); *rp = spec->obj; |
initd(spec); *rp = spec->obj; |
| } |
} |
| } |
} |
| Line 431 void Pdp_ptod(arg,rp) |
|
| Line 454 void Pdp_ptod(arg,rp) |
|
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
| { |
{ |
| |
P p; |
| NODE n; |
NODE n; |
| VL vl,tvl; |
VL vl,tvl; |
| |
struct oLIST f; |
| |
int ac; |
| |
LIST v; |
| |
Num homo; |
| |
int modular; |
| |
struct order_spec *ord; |
| |
|
| asir_assert(ARG0(arg),O_P,"dp_ptod"); |
asir_assert(ARG0(arg),O_P,"dp_ptod"); |
| asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
p = (P)ARG0(arg); |
| for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) { |
ac = argc(arg); |
| |
if ( ac == 1 ) { |
| |
if ( current_option ) { |
| |
f.id = O_LIST; f.body = mknode(1,p); |
| |
parse_gr_option(&f,current_option,&v,&homo,&modular,&ord); |
| |
dp_current_spec = ord; |
| |
} else |
| |
error("dp_ptod : invalid argument"); |
| |
} else { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
| |
v = (LIST)ARG1(arg); |
| |
} |
| |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| if ( !vl ) { |
if ( !vl ) { |
| NEWVL(vl); tvl = vl; |
NEWVL(vl); tvl = vl; |
| } else { |
} else { |
|
|
| } |
} |
| if ( vl ) |
if ( vl ) |
| NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
| ptod(CO,vl,(P)ARG0(arg),rp); |
ptod(CO,vl,p,rp); |
| } |
} |
| |
|
| |
void Pdp_ltod(arg,rp) |
| |
NODE arg; |
| |
DPV *rp; |
| |
{ |
| |
NODE n; |
| |
VL vl,tvl; |
| |
LIST f,v; |
| |
int sugar,i,len,ac,modular; |
| |
Num homo; |
| |
struct order_spec *ord; |
| |
DP *e; |
| |
NODE nd,t; |
| |
|
| |
ac = argc(arg); |
| |
asir_assert(ARG0(arg),O_LIST,"dp_ptod"); |
| |
f = (LIST)ARG0(arg); |
| |
if ( ac == 1 ) { |
| |
if ( current_option ) { |
| |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| |
dp_current_spec = ord; |
| |
} else |
| |
error("dp_ltod : invalid argument"); |
| |
} else { |
| |
asir_assert(ARG1(arg),O_LIST,"dp_ptod"); |
| |
v = (LIST)ARG1(arg); |
| |
} |
| |
for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) { |
| |
if ( !vl ) { |
| |
NEWVL(vl); tvl = vl; |
| |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = VR((P)BDY(n)); |
| |
} |
| |
if ( vl ) |
| |
NEXT(tvl) = 0; |
| |
|
| |
nd = BDY(f); |
| |
len = length(nd); |
| |
e = (DP *)MALLOC(len*sizeof(DP)); |
| |
sugar = 0; |
| |
for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) { |
| |
ptod(CO,vl,(P)BDY(t),&e[i]); |
| |
if ( e[i] ) |
| |
sugar = MAX(sugar,e[i]->sugar); |
| |
} |
| |
MKDPV(len,e,*rp); |
| |
} |
| |
|
| void Pdp_dtop(arg,rp) |
void Pdp_dtop(arg,rp) |
| NODE arg; |
NODE arg; |
| P *rp; |
P *rp; |
|
|
| MP m,mr; |
MP m,mr; |
| |
|
| p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht"); |
| if ( !p ) |
dp_ht(p,rp); |
| *rp = 0; |
|
| else { |
|
| m = BDY(p); |
|
| NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; |
|
| MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */ |
|
| } |
|
| } |
} |
| |
|
| void Pdp_hc(arg,rp) |
void Pdp_hc(arg,rp) |
|
|
| 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 ( current_option ) |
| |
parse_gr_option(f,current_option,&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 ( current_option ) |
| |
parse_gr_option(f,current_option,&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 1364 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
| Line 1505 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
| break; |
break; |
| } |
} |
| } |
} |
| for ( t = BDY(f); t; t = NEXT(t) ) |
if ( vars ) { |
| 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 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) ) { |
| Line 1401 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
| Line 1544 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
| /* variable list; ignore */ |
/* variable list; ignore */ |
| } else if ( !strcmp(key,"order") ) { |
} else if ( !strcmp(key,"order") ) { |
| /* order spec */ |
/* order spec */ |
| |
if ( !vl ) |
| |
error("parse_gr_option : variables must be specified"); |
| create_order_spec(vl,value,ord); |
create_order_spec(vl,value,ord); |
| ord_is_set = 1; |
ord_is_set = 1; |
| } else if ( !strcmp(key,"block") ) { |
} else if ( !strcmp(key,"block") ) { |
| create_order_spec(0,value,ord); |
create_order_spec(0,value,ord); |
| |
ord_is_set = 1; |
| } else if ( !strcmp(key,"matrix") ) { |
} else if ( !strcmp(key,"matrix") ) { |
| create_order_spec(0,value,ord); |
create_order_spec(0,value,ord); |
| |
ord_is_set = 1; |
| } else if ( !strcmp(key,"sugarweight") ) { |
} else if ( !strcmp(key,"sugarweight") ) { |
| /* weight */ |
/* weight */ |
| Pdp_set_weight(NEXT(p),&dmy); |
Pdp_set_weight(NEXT(p),&dmy); |
| ord_is_set = 1; |
|
| } else if ( !strcmp(key,"homo") ) { |
} else if ( !strcmp(key,"homo") ) { |
| *homo = (Num)value; |
*homo = (Num)value; |
| homo_is_set = 1; |
homo_is_set = 1; |
|
|
| if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
| *rp = f; return; |
*rp = f; return; |
| } |
} |
| if ( argc(arg) == 5 ) { |
if ( (ac = argc(arg)) == 5 ) { |
| 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 ) |
|
|
| else |
else |
| modular = QTOS(m); |
modular = QTOS(m); |
| create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
| } else if ( (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST ) |
} else if ( current_option ) |
| parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
| else if ( ac == 1 ) |
else if ( ac == 1 ) |
| parse_gr_option(f,0,&v,&homo,&modular,&ord); |
parse_gr_option(f,0,&v,&homo,&modular,&ord); |
| else |
else |
|
|
| 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 ( (ac = 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 ( current_option ) |
| |
parse_gr_option(f,current_option,&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; |
| Line 1976 int get_field_type(P p) |
|
| Line 2131 int get_field_type(P p) |
|
| return -1; |
return -1; |
| } |
} |
| return type; |
return type; |
| |
} |
| |
} |
| |
|
| |
void Pdpv_ord(NODE arg,Obj *rp) |
| |
{ |
| |
int ac,id; |
| |
LIST shift; |
| |
|
| |
ac = argc(arg); |
| |
if ( ac ) { |
| |
id = QTOS((Q)ARG0(arg)); |
| |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
| |
shift = (LIST)ARG1(arg); |
| |
else |
| |
shift = 0; |
| |
create_modorder_spec(id,shift,&dp_current_modspec); |
| |
} |
| |
*rp = dp_current_modspec->obj; |
| |
} |
| |
|
| |
void Pdpv_ht(NODE arg,LIST *rp) |
| |
{ |
| |
NODE n; |
| |
DP ht; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_ht"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
ht = 0; |
| |
else |
| |
dp_ht(BDY(p)[pos],&ht); |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,ht); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdpv_hm(NODE arg,LIST *rp) |
| |
{ |
| |
NODE n; |
| |
DP ht; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_hm"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
ht = 0; |
| |
else |
| |
dp_hm(BDY(p)[pos],&ht); |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,ht); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdpv_hc(NODE arg,LIST *rp) |
| |
{ |
| |
NODE n; |
| |
P hc; |
| |
int pos; |
| |
DPV p; |
| |
Q q; |
| |
|
| |
asir_assert(ARG0(arg),O_DPV,"dpv_hc"); |
| |
p = (DPV)ARG0(arg); |
| |
pos = dpv_hp(p); |
| |
if ( pos < 0 ) |
| |
hc = 0; |
| |
else |
| |
hc = BDY(BDY(p)[pos])->c; |
| |
STOQ(pos,q); |
| |
n = mknode(2,q,hc); |
| |
MKLIST(*rp,n); |
| |
} |
| |
|
| |
int dpv_hp(DPV p) |
| |
{ |
| |
int len,i,maxp,maxw,w,slen; |
| |
int *shift; |
| |
DP *e; |
| |
|
| |
len = p->len; |
| |
e = p->body; |
| |
slen = dp_current_modspec->len; |
| |
shift = dp_current_modspec->degree_shift; |
| |
switch ( dp_current_modspec->id ) { |
| |
case ORD_REVGRADLEX: |
| |
for ( maxp = -1, i = 0; i < len; i++ ) |
| |
if ( !e[i] ) continue; |
| |
else if ( maxp < 0 ) { |
| |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
| |
} else { |
| |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
| |
if ( w >= maxw ) { |
| |
maxw = w; maxp = i; |
| |
} |
| |
} |
| |
return maxp; |
| |
case ORD_GRADLEX: |
| |
for ( maxp = -1, i = 0; i < len; i++ ) |
| |
if ( !e[i] ) continue; |
| |
else if ( maxp < 0 ) { |
| |
maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i; |
| |
} else { |
| |
w = BDY(e[i])->dl->td+(i<slen?shift[i]:0); |
| |
if ( w > maxw ) { |
| |
maxw = w; maxp = i; |
| |
} |
| |
} |
| |
return maxp; |
| |
break; |
| |
case ORD_LEX: |
| |
for ( i = 0; i < len; i++ ) |
| |
if ( e[i] ) return i; |
| |
return -1; |
| |
break; |
| } |
} |
| } |
} |