version 1.1, 2018/09/19 05:45:05 |
version 1.2, 2018/09/28 08:20:27 |
|
|
* 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: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.1 2018/09/19 05:45:05 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 362 void Pdp_compute_last_w(NODE arg,LIST *rp) |
|
Line 362 void Pdp_compute_last_w(NODE arg,LIST *rp) |
|
row2 = w2->row; |
row2 = w2->row; |
if ( w ) { |
if ( w ) { |
v = W_ALLOC(n); |
v = W_ALLOC(n); |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
for ( i = 0; i < n; i++ ) v[i] = ZTOS((Q)w->body[i]); |
} else v = 0; |
} else v = 0; |
m1 = almat(row1,n); |
m1 = almat(row1,n); |
for ( i = 0; i < row1; i++ ) |
for ( i = 0; i < row1; i++ ) |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
for ( j = 0; j < n; j++ ) m1[i][j] = ZTOS((Q)w1->body[i][j]); |
m2 = almat(row2,n); |
m2 = almat(row2,n); |
for ( i = 0; i < row2; i++ ) |
for ( i = 0; i < row2; i++ ) |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
for ( j = 0; j < n; j++ ) m2[i][j] = ZTOS((Q)w2->body[i][j]); |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
if ( !r ) *rp = 0; |
if ( !r ) *rp = 0; |
else { |
else { |
MKVECT(rv,n); |
MKVECT(rv,n); |
for ( i = 0; i < n; i++ ) { |
for ( i = 0; i < n; i++ ) { |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
STOZ(v[i],q); rv->body[i] = (pointer)q; |
} |
} |
MKLIST(l,r); |
MKLIST(l,r); |
r = mknode(2,rv,l); |
r = mknode(2,rv,l); |
Line 452 void Pdp_sep(NODE arg,VECT *rp) |
|
Line 452 void Pdp_sep(NODE arg,VECT *rp) |
|
pointer *pv; |
pointer *pv; |
|
|
p = (DP)ARG0(arg); m = BDY(p); |
p = (DP)ARG0(arg); m = BDY(p); |
d = QTOS((Q)ARG1(arg)); |
d = ZTOS((Q)ARG1(arg)); |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
for ( t = m, n = 0; t; t = NEXT(t), n++ ); |
if ( d > n ) |
if ( d > n ) |
d = n; |
d = n; |
Line 506 void Pdp_etov(NODE arg,VECT *rp) |
|
Line 506 void Pdp_etov(NODE arg,VECT *rp) |
|
n = dp->nv; d = BDY(dp)->dl->d; |
n = dp->nv; d = BDY(dp)->dl->d; |
MKVECT(v,n); |
MKVECT(v,n); |
for ( i = 0; i < n; i++ ) { |
for ( i = 0; i < n; i++ ) { |
STOQ(d[i],t); v->body[i] = (pointer)t; |
STOZ(d[i],t); v->body[i] = (pointer)t; |
} |
} |
*rp = v; |
*rp = v; |
} |
} |
Line 525 void Pdp_vtoe(NODE arg,DP *rp) |
|
Line 525 void Pdp_vtoe(NODE arg,DP *rp) |
|
n = v->len; |
n = v->len; |
NEWDL(dl,n); d = dl->d; |
NEWDL(dl,n); d = dl->d; |
for ( i = 0, td = 0; i < n; i++ ) { |
for ( i = 0, td = 0; i < n; i++ ) { |
d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
d[i] = ZTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i); |
} |
} |
dl->td = td; |
dl->td = td; |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0; |
Line 543 void Pdp_lnf_mod(NODE arg,LIST *rp) |
|
Line 543 void Pdp_lnf_mod(NODE arg,LIST *rp) |
|
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod"); |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
asir_assert(ARG2(arg),O_N,"dp_lnf_mod"); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg)); |
mod = QTOS((Q)ARG2(arg)); |
mod = ZTOS((Q)ARG2(arg)); |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2); |
NEWNODE(n); BDY(n) = (pointer)r1; |
NEWNODE(n); BDY(n) = (pointer)r1; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2; |
Line 570 void Pdp_nf_tab_mod(NODE arg,DP *rp) |
|
Line 570 void Pdp_nf_tab_mod(NODE arg,DP *rp) |
|
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod"); |
asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod"); |
asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod"); |
asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod"); |
dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)), |
dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)), |
QTOS((Q)ARG2(arg)),rp); |
ZTOS((Q)ARG2(arg)),rp); |
} |
} |
|
|
void Pdp_nf_tab_f(NODE arg,DP *rp) |
void Pdp_nf_tab_f(NODE arg,DP *rp) |
Line 779 void Pdpm_dtol(NODE arg,LIST *rp) |
|
Line 779 void Pdpm_dtol(NODE arg,LIST *rp) |
|
} |
} |
if ( vl ) |
if ( vl ) |
NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
n = QTOS((Q)ARG2(arg)); |
n = ZTOS((Q)ARG2(arg)); |
w = (MP *)CALLOC(n,sizeof(MP)); |
w = (MP *)CALLOC(n,sizeof(MP)); |
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++; |
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
wa = (DMM *)MALLOC(len*sizeof(DMM)); |
Line 891 void Pdp_mod(NODE arg,DP *rp) |
|
Line 891 void Pdp_mod(NODE arg,DP *rp) |
|
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
asir_assert(ARG0(arg),O_DP,"dp_mod"); |
asir_assert(ARG1(arg),O_N,"dp_mod"); |
asir_assert(ARG1(arg),O_N,"dp_mod"); |
asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
asir_assert(ARG2(arg),O_LIST,"dp_mod"); |
p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg)); |
p = (DP)ARG0(arg); mod = ZTOS((Q)ARG1(arg)); |
subst = BDY((LIST)ARG2(arg)); |
subst = BDY((LIST)ARG2(arg)); |
dp_mod(p,mod,subst,rp); |
dp_mod(p,mod,subst,rp); |
} |
} |
Line 1089 void Pdp_nf_mod(NODE arg,DP *rp) |
|
Line 1089 void Pdp_nf_mod(NODE arg,DP *rp) |
|
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
NEXTNODE(n0,n); |
NEXTNODE(n0,n); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
BDY(n) = (pointer)ZTOS((Q)BDY(b)); |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
Line 1186 void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST |
|
Line 1186 void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
Line 1248 void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
|
Line 1248 void Pdp_true_nf_marked_mod(NODE arg,LIST *rp) |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
n = mknode(2,nm,dn); |
n = mknode(2,nm,dn); |
Line 1273 void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
|
Line 1273 void Pdp_weyl_nf_mod(NODE arg,DP *rp) |
|
*rp = 0; return; |
*rp = 0; return; |
} |
} |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
for ( n0 = n = 0; b; b = NEXT(b) ) { |
NEXTNODE(n0,n); |
NEXTNODE(n0,n); |
BDY(n) = (pointer)QTOS((Q)BDY(b)); |
BDY(n) = (pointer)ZTOS((Q)BDY(b)); |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
Line 1304 void Pdp_true_nf_mod(NODE arg,LIST *rp) |
|
Line 1304 void Pdp_true_nf_mod(NODE arg,LIST *rp) |
|
nm = 0; dn = (P)ONEM; |
nm = 0; dn = (P)ONEM; |
} else { |
} else { |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg)); |
full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg)); |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn); |
} |
} |
NEWNODE(n); BDY(n) = (pointer)nm; |
NEWNODE(n); BDY(n) = (pointer)nm; |
Line 1369 void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg |
|
Line 1369 void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg |
|
b = BDY((LIST)ARG0(arg)); |
b = BDY((LIST)ARG0(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
ps = (DP *)BDY((VECT)ARG2(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
hps = (DP *)BDY((VECT)ARG3(arg)); |
mod = QTOS((Q)ARG4(arg)); |
mod = ZTOS((Q)ARG4(arg)); |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len; |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn); |
} |
} |
Line 1457 void Pdp_red_mod(NODE arg,LIST *rp) |
|
Line 1457 void Pdp_red_mod(NODE arg,LIST *rp) |
|
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG1(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG2(arg),O_DP,"dp_red_mod"); |
asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
asir_assert(ARG3(arg),O_N,"dp_red_mod"); |
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)), |
dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),ZTOS((Q)ARG3(arg)), |
&h,&r,&dmy); |
&h,&r,&dmy); |
NEWNODE(n); BDY(n) = (pointer)h; |
NEWNODE(n); BDY(n) = (pointer)h; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r; |
Line 1550 void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
|
Line 1550 void Pdp_weyl_mul_mod(NODE arg,DP *rp) |
|
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(p2,O_DP,"dp_mul_mod"); |
asir_assert(m,O_N,"dp_mul_mod"); |
asir_assert(m,O_N,"dp_mul_mod"); |
do_weyl = 1; |
do_weyl = 1; |
mulmd(CO,QTOS(m),p1,p2,rp); |
mulmd(CO,ZTOS(m),p1,p2,rp); |
do_weyl = 0; |
do_weyl = 0; |
} |
} |
|
|
Line 1638 void Pdp_sp_mod(NODE arg,DP *rp) |
|
Line 1638 void Pdp_sp_mod(NODE arg,DP *rp) |
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
asir_assert(ARG2(arg),O_N,"dp_sp_mod"); |
mod = QTOS((Q)ARG2(arg)); |
mod = ZTOS((Q)ARG2(arg)); |
dp_sp_mod(p1,p2,mod,rp); |
dp_sp_mod(p1,p2,mod,rp); |
} |
} |
|
|
Line 1704 void Pdp_td(NODE arg,Z *rp) |
|
Line 1704 void Pdp_td(NODE arg,Z *rp) |
|
if ( !p ) |
if ( !p ) |
*rp = 0; |
*rp = 0; |
else |
else |
STOQ(BDY(p)->dl->td,*rp); |
STOZ(BDY(p)->dl->td,*rp); |
} |
} |
|
|
void Pdp_sugar(NODE arg,Z *rp) |
void Pdp_sugar(NODE arg,Z *rp) |
Line 1715 void Pdp_sugar(NODE arg,Z *rp) |
|
Line 1715 void Pdp_sugar(NODE arg,Z *rp) |
|
if ( !p ) |
if ( !p ) |
*rp = 0; |
*rp = 0; |
else |
else |
STOQ(p->sugar,*rp); |
STOZ(p->sugar,*rp); |
} |
} |
|
|
void Pdp_initial_term(NODE arg,Obj *rp) |
void Pdp_initial_term(NODE arg,Obj *rp) |
Line 1783 void Pdp_set_sugar(NODE arg,Q *rp) |
|
Line 1783 void Pdp_set_sugar(NODE arg,Q *rp) |
|
if ( p && q) { |
if ( p && q) { |
asir_assert(p,O_DP,"dp_set_sugar"); |
asir_assert(p,O_DP,"dp_set_sugar"); |
asir_assert(q,O_N, "dp_set_sugar"); |
asir_assert(q,O_N, "dp_set_sugar"); |
i = QTOS(q); |
i = ZTOS(q); |
if (p->sugar < i) { |
if (p->sugar < i) { |
p->sugar = i; |
p->sugar = i; |
} |
} |
Line 1832 void Pdp_minp(NODE arg,LIST *rp) |
|
Line 1832 void Pdp_minp(NODE arg,LIST *rp) |
|
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d); |
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p); |
if ( !ARG1(arg) ) { |
if ( !ARG1(arg) ) { |
s = QTOS((Q)BDY(p)); p = NEXT(p); |
s = ZTOS((Q)BDY(p)); p = NEXT(p); |
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) { |
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp)); |
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
tlcm = (DP)BDY(tp); tp = NEXT(tp); |
ts = QTOS((Q)BDY(tp)); tp = NEXT(tp); |
ts = ZTOS((Q)BDY(tp)); tp = NEXT(tp); |
NEXTNODE(dd0,dd); |
NEXTNODE(dd0,dd); |
if ( ts < s ) { |
if ( ts < s ) { |
BDY(dd) = (pointer)minp; |
BDY(dd) = (pointer)minp; |
Line 1874 void Pdp_criB(NODE arg,LIST *rp) |
|
Line 1874 void Pdp_criB(NODE arg,LIST *rp) |
|
DL ts,ti,tj,lij,tdl; |
DL ts,ti,tj,lij,tdl; |
|
|
asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg)); |
asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg)); |
asir_assert(ARG1(arg),O_N,"dp_criB"); s = ZTOS((Q)ARG1(arg)); |
asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg)); |
if ( !d ) |
if ( !d ) |
*rp = (LIST)ARG0(arg); |
*rp = (LIST)ARG0(arg); |
Line 1884 void Pdp_criB(NODE arg,LIST *rp) |
|
Line 1884 void Pdp_criB(NODE arg,LIST *rp) |
|
NEWDL(tdl,n); |
NEWDL(tdl,n); |
for ( dd = 0; d; d = NEXT(d) ) { |
for ( dd = 0; d; d = NEXT(d) ) { |
ij = BDY((LIST)BDY(d)); |
ij = BDY((LIST)BDY(d)); |
i = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
i = ZTOS((Q)BDY(ij)); ij = NEXT(ij); |
j = QTOS((Q)BDY(ij)); ij = NEXT(ij); |
j = ZTOS((Q)BDY(ij)); ij = NEXT(ij); |
lij = BDY((DP)BDY(ij))->dl; |
lij = BDY((DP)BDY(ij))->dl; |
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl; |
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td |
Line 1906 void Pdp_nelim(NODE arg,Z *rp) |
|
Line 1906 void Pdp_nelim(NODE arg,Z *rp) |
|
{ |
{ |
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
asir_assert(ARG0(arg),O_N,"dp_nelim"); |
dp_nelim = QTOS((Q)ARG0(arg)); |
dp_nelim = ZTOS((Q)ARG0(arg)); |
} |
} |
STOQ(dp_nelim,*rp); |
STOZ(dp_nelim,*rp); |
} |
} |
|
|
void Pdp_mag(NODE arg,Z *rp) |
void Pdp_mag(NODE arg,Z *rp) |
Line 1924 void Pdp_mag(NODE arg,Z *rp) |
|
Line 1924 void Pdp_mag(NODE arg,Z *rp) |
|
else { |
else { |
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
for ( s = 0, m = BDY(p); m; m = NEXT(m) ) |
s += p_mag((P)m->c); |
s += p_mag((P)m->c); |
STOQ(s,*rp); |
STOZ(s,*rp); |
} |
} |
} |
} |
|
|
Line 1978 void Pdp_gr_print(NODE arg,Z *rp) |
|
Line 1978 void Pdp_gr_print(NODE arg,Z *rp) |
|
if ( arg ) { |
if ( arg ) { |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
asir_assert(ARG0(arg),O_N,"dp_gr_print"); |
q = (Z)ARG0(arg); |
q = (Z)ARG0(arg); |
s = QTOS(q); |
s = ZTOS(q); |
switch ( s ) { |
switch ( s ) { |
case 0: |
case 0: |
DP_Print = 0; DP_PrintShort = 0; |
DP_Print = 0; DP_PrintShort = 0; |
Line 1995 void Pdp_gr_print(NODE arg,Z *rp) |
|
Line 1995 void Pdp_gr_print(NODE arg,Z *rp) |
|
} |
} |
} else { |
} else { |
if ( DP_Print ) { |
if ( DP_Print ) { |
STOQ(1,q); |
STOZ(1,q); |
} else if ( DP_PrintShort ) { |
} else if ( DP_PrintShort ) { |
STOQ(2,q); |
STOZ(2,q); |
} else |
} else |
q = 0; |
q = 0; |
} |
} |
Line 2091 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
Line 2091 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo |
|
homo_is_set = 1; |
homo_is_set = 1; |
} else if ( !strcmp(key,"trace") ) { |
} else if ( !strcmp(key,"trace") ) { |
m = (Z)value; |
m = (Z)value; |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
*modular = 0; |
*modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("parse_gr_option : too large modulus"); |
error("parse_gr_option : too large modulus"); |
else |
else |
*modular = QTOS(m); |
*modular = ZTOS(m); |
modular_is_set = 1; |
modular_is_set = 1; |
} else if ( !strcmp(key,"dp") ) { |
} else if ( !strcmp(key,"dp") ) { |
/* XXX : ignore */ |
/* XXX : ignore */ |
Line 2132 void Pdp_gr_main(NODE arg,LIST *rp) |
|
Line 2132 void Pdp_gr_main(NODE arg,LIST *rp) |
|
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Z)ARG3(arg); |
m = (Z)ARG3(arg); |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("dp_gr_main : too large modulus"); |
error("dp_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = ZTOS(m); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( current_option ) |
} else if ( current_option ) |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
Line 2191 void Pdp_gr_f_main(NODE arg,LIST *rp) |
|
Line 2191 void Pdp_gr_f_main(NODE arg,LIST *rp) |
|
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
#if 0 |
#if 0 |
asir_assert(ARG3(arg),O_N,"dp_gr_f_main"); |
asir_assert(ARG3(arg),O_N,"dp_gr_f_main"); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
if ( m ) |
if ( m ) |
error("dp_gr_f_main : trace lifting is not implemented yet"); |
error("dp_gr_f_main : trace lifting is not implemented yet"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2243 void Pdp_gr_checklist(NODE arg,LIST *rp) |
|
Line 2243 void Pdp_gr_checklist(NODE arg,LIST *rp) |
|
do_weyl = 0; |
do_weyl = 0; |
asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist"); |
asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist"); |
asir_assert(ARG1(arg),O_N,"dp_gr_checklist"); |
asir_assert(ARG1(arg),O_N,"dp_gr_checklist"); |
n = QTOS((Q)ARG1(arg)); |
n = ZTOS((Q)ARG1(arg)); |
gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp); |
gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp); |
r = mknode(2,g,dp); |
r = mknode(2,g,dp); |
MKLIST(*rp,r); |
MKLIST(*rp,r); |
Line 2259 void Pdp_f4_mod_main(NODE arg,LIST *rp) |
|
Line 2259 void Pdp_f4_mod_main(NODE arg,LIST *rp) |
|
asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_mod_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_mod_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(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; |
Line 2287 void Pdp_gr_mod_main(NODE arg,LIST *rp) |
|
Line 2287 void Pdp_gr_mod_main(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg)); |
if ( !m ) |
if ( !m ) |
error("dp_gr_mod_main : invalid argument"); |
error("dp_gr_mod_main : invalid argument"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2319 void Pnd_f4(NODE arg,LIST *rp) |
|
Line 2319 void Pnd_f4(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ((unsigned long)0x40000000,z); |
STOZ((unsigned long)0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2334 void Pnd_f4(NODE arg,LIST *rp) |
|
Line 2334 void Pnd_f4(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
if ( get_opt("rref2",&val) && val ) nd_rref2 = 1; |
} else |
} else |
Line 2364 void Pnd_gr(NODE arg,LIST *rp) |
|
Line 2364 void Pnd_gr(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2378 void Pnd_gr(NODE arg,LIST *rp) |
|
Line 2378 void Pnd_gr(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
} else |
} else |
error("nd_gr : invalid argument"); |
error("nd_gr : invalid argument"); |
Line 2404 void Pnd_gr_postproc(NODE arg,LIST *rp) |
|
Line 2404 void Pnd_gr_postproc(NODE arg,LIST *rp) |
|
*rp = f; return; |
*rp = f; return; |
} |
} |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,&val); |
Psetmod_ff(node,&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_check = ARG4(arg) ? 1 : 0; |
do_check = ARG4(arg) ? 1 : 0; |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
Line 2427 void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
|
Line 2427 void Pnd_gr_recompute_trace(NODE arg,LIST *rp) |
|
asir_assert(ARG1(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"); |
asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
tlist = (LIST)ARG4(arg); |
tlist = (LIST)ARG4(arg); |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
nd_gr_recompute_trace(f,v,m,ord,tlist,rp); |
Line 2451 void Pnd_btog(NODE arg,Obj *rp) |
|
Line 2451 void Pnd_btog(NODE arg,Obj *rp) |
|
asir_assert(ARG2(arg),O_N,"nd_btog"); |
asir_assert(ARG2(arg),O_N,"nd_btog"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); |
mq = (Z)ARG2(arg); |
mq = (Z)ARG2(arg); |
STOQ(0x40000000,z); |
STOZ(0x40000000,z); |
if ( cmpz(mq,z) >= 0 ) { |
if ( cmpz(mq,z) >= 0 ) { |
node = mknode(1,mq); |
node = mknode(1,mq); |
Psetmod_ff(node,(Obj *)&val); |
Psetmod_ff(node,(Obj *)&val); |
m = -2; |
m = -2; |
} else |
} else |
m = QTOS(mq); |
m = ZTOS(mq); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
tlist = (LIST)ARG4(arg); |
tlist = (LIST)ARG4(arg); |
if ( (ac = argc(arg)) == 6 ) { |
if ( (ac = argc(arg)) == 6 ) { |
asir_assert(ARG5(arg),O_N,"nd_btog"); |
asir_assert(ARG5(arg),O_N,"nd_btog"); |
pos = QTOS((Q)ARG5(arg)); |
pos = ZTOS((Q)ARG5(arg)); |
*rp = nd_btog_one(f,v,m,ord,tlist,pos); |
*rp = nd_btog_one(f,v,m,ord,tlist,pos); |
} else if ( ac == 5 ) |
} else if ( ac == 5 ) |
*rp = nd_btog(f,v,m,ord,tlist); |
*rp = nd_btog(f,v,m,ord,tlist); |
Line 2485 void Pnd_weyl_gr_postproc(NODE arg,LIST *rp) |
|
Line 2485 void Pnd_weyl_gr_postproc(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
do_check = ARG4(arg) ? 1 : 0; |
do_check = ARG4(arg) ? 1 : 0; |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
Line 2510 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
Line 2510 void Pnd_gr_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_gr_trace : invalid argument"); |
error("nd_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
Line 2540 void Pnd_f4_trace(NODE arg,LIST *rp) |
|
Line 2540 void Pnd_f4_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_gr_trace : invalid argument"); |
error("nd_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
nd_gr_trace(f,v,m,homo,1,ord,rp); |
Line 2571 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
Line 2571 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
homo = 0; |
homo = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
Line 2579 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
Line 2579 void Pnd_weyl_gr(NODE arg,LIST *rp) |
|
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
if ( get_opt("dp",&val) && val ) retdp = 1; |
if ( get_opt("dp",&val) && val ) retdp = 1; |
} else |
} else |
error("nd_weyl_gr : invalid argument"); |
error("nd_weyl_gr : invalid argument"); |
Line 2605 void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
|
Line 2605 void Pnd_weyl_gr_trace(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; do_weyl = 0; return; |
*rp = f; do_weyl = 0; return; |
} |
} |
homo = QTOS((Q)ARG2(arg)); |
homo = ZTOS((Q)ARG2(arg)); |
m = QTOS((Q)ARG3(arg)); |
m = ZTOS((Q)ARG3(arg)); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( ac == 1 ) { |
} else if ( ac == 1 ) { |
f = (LIST)ARG0(arg); |
f = (LIST)ARG0(arg); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
parse_gr_option(f,current_option,&v,&nhomo,&m,&ord); |
homo = QTOS((Q)nhomo); |
homo = ZTOS((Q)nhomo); |
} else |
} else |
error("nd_weyl_gr_trace : invalid argument"); |
error("nd_weyl_gr_trace : invalid argument"); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
nd_gr_trace(f,v,m,homo,0,ord,rp); |
Line 2635 void Pnd_nf(NODE arg,Obj *rp) |
|
Line 2635 void Pnd_nf(NODE arg,Obj *rp) |
|
} |
} |
v = (LIST)ARG2(arg); |
v = (LIST)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp); |
} |
} |
|
|
void Pnd_weyl_nf(NODE arg,Obj *rp) |
void Pnd_weyl_nf(NODE arg,Obj *rp) |
Line 2655 void Pnd_weyl_nf(NODE arg,Obj *rp) |
|
Line 2655 void Pnd_weyl_nf(NODE arg,Obj *rp) |
|
} |
} |
v = (LIST)ARG2(arg); |
v = (LIST)ARG2(arg); |
create_order_spec(0,ARG3(arg),&ord); |
create_order_spec(0,ARG3(arg),&ord); |
nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp); |
nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp); |
} |
} |
|
|
/* for Weyl algebra */ |
/* for Weyl algebra */ |
Line 2682 void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
|
Line 2682 void Pdp_weyl_gr_main(NODE arg,LIST *rp) |
|
v = (LIST)ARG1(arg); |
v = (LIST)ARG1(arg); |
homo = (Num)ARG2(arg); |
homo = (Num)ARG2(arg); |
m = (Z)ARG3(arg); |
m = (Z)ARG3(arg); |
STOQ(0x80000000,z); |
STOZ(0x80000000,z); |
if ( !m ) |
if ( !m ) |
modular = 0; |
modular = 0; |
else if ( cmpz(m,z) >= 0 ) |
else if ( cmpz(m,z) >= 0 ) |
error("dp_weyl_gr_main : too large modulus"); |
error("dp_weyl_gr_main : too large modulus"); |
else |
else |
modular = QTOS(m); |
modular = ZTOS(m); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
} else if ( current_option ) |
} else if ( current_option ) |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
parse_gr_option(f,current_option,&v,&homo,&modular,&ord); |
Line 2750 void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
|
Line 2750 void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp) |
|
asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_main"); |
asir_assert(ARG2(arg),O_N,"dp_f4_main"); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg)); |
f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(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; |
Line 2779 void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
|
Line 2779 void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp) |
|
if ( !BDY(f) ) { |
if ( !BDY(f) ) { |
*rp = f; return; |
*rp = f; return; |
} |
} |
homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg)); |
homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg)); |
if ( !m ) |
if ( !m ) |
error("dp_weyl_gr_mod_main : invalid argument"); |
error("dp_weyl_gr_mod_main : invalid argument"); |
create_order_spec(0,ARG4(arg),&ord); |
create_order_spec(0,ARG4(arg),&ord); |
Line 2821 void Pdp_set_weight(NODE arg,VECT *rp) |
|
Line 2821 void Pdp_set_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_dl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_dl_weight_vector[i] = QTOS((Q)v->body[i]); |
current_dl_weight_vector[i] = ZTOS((Q)v->body[i]); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
if ( current_dl_weight_vector[i] < 0 ) break; |
if ( current_dl_weight_vector[i] < 0 ) break; |
if ( i < n ) |
if ( i < n ) |
Line 2863 void Pdp_set_module_weight(NODE arg,VECT *rp) |
|
Line 2863 void Pdp_set_module_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_module_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_module_weight_vector[i] = QTOS((Q)v->body[i]); |
current_module_weight_vector[i] = ZTOS((Q)v->body[i]); |
*rp = v; |
*rp = v; |
} |
} |
} |
} |
Line 2954 void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
|
Line 2954 void Pdp_weyl_set_weight(NODE arg,VECT *rp) |
|
n = v->len; |
n = v->len; |
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int)); |
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
current_weyl_weight_vector[i] = QTOS((Q)v->body[i]); |
current_weyl_weight_vector[i] = ZTOS((Q)v->body[i]); |
*rp = v; |
*rp = v; |
} |
} |
} |
} |
Line 3142 NODE sumi_criB(int nv,NODE d,DP *f,int m) |
|
Line 3142 NODE sumi_criB(int nv,NODE d,DP *f,int m) |
|
r0 = 0; |
r0 = 0; |
for ( ; d; d = NEXT(d) ) { |
for ( ; d; d = NEXT(d) ) { |
p = (LIST)BDY(d); |
p = (LIST)BDY(d); |
p0 = QTOS((Q)ARG0(BDY(p))); |
p0 = ZTOS((Q)ARG0(BDY(p))); |
p1 = QTOS((Q)ARG1(BDY(p))); |
p1 = ZTOS((Q)ARG1(BDY(p))); |
p2 = HDL((DP)ARG2(BDY(p))); |
p2 = HDL((DP)ARG2(BDY(p))); |
if(!_dl_redble(HDL((DP)f[m]),p2,nv) || |
if(!_dl_redble(HDL((DP)f[m]),p2,nv) || |
dl_equal(nv,lcm_of_DL(nv,HDL(f[p0]),HDL(f[m]),lcm),p2) || |
dl_equal(nv,lcm_of_DL(nv,HDL(f[p0]),HDL(f[m]),lcm),p2) || |
Line 3191 NODE sumi_criFMD(int nv,DP *f,int m) |
|
Line 3191 NODE sumi_criFMD(int nv,DP *f,int m) |
|
if ( k2 < nv ) { |
if ( k2 < nv ) { |
NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE; |
NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE; |
NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td; |
NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td; |
STOQ(i,iq); STOQ(m,mq); |
STOZ(i,iq); STOZ(m,mq); |
nd = mknode(3,iq,mq,u); |
nd = mknode(3,iq,mq,u); |
MKLIST(list,nd); |
MKLIST(list,nd); |
MKNODE(r1,list,r); |
MKNODE(r1,list,r); |
Line 3353 void Psumi_symbolic(NODE arg,LIST *rp) |
|
Line 3353 void Psumi_symbolic(NODE arg,LIST *rp) |
|
int q,simp; |
int q,simp; |
|
|
l = BDY((LIST)ARG0(arg)); |
l = BDY((LIST)ARG0(arg)); |
q = QTOS((Q)ARG1(arg)); |
q = ZTOS((Q)ARG1(arg)); |
f2 = BDY((LIST)ARG2(arg)); |
f2 = BDY((LIST)ARG2(arg)); |
g = (DP *)BDY((VECT)ARG3(arg)); |
g = (DP *)BDY((VECT)ARG3(arg)); |
simp = QTOS((Q)ARG4(arg)); |
simp = ZTOS((Q)ARG4(arg)); |
*rp = sumi_symbolic(l,q,f2,g,simp); |
*rp = sumi_symbolic(l,q,f2,g,simp); |
} |
} |
|
|
Line 3368 void Psumi_updatepairs(NODE arg,LIST *rp) |
|
Line 3368 void Psumi_updatepairs(NODE arg,LIST *rp) |
|
|
|
d = (LIST)ARG0(arg); |
d = (LIST)ARG0(arg); |
f = (DP *)BDY((VECT)ARG1(arg)); |
f = (DP *)BDY((VECT)ARG1(arg)); |
m = QTOS((Q)ARG2(arg)); |
m = ZTOS((Q)ARG2(arg)); |
*rp = sumi_updatepairs(d,f,m); |
*rp = sumi_updatepairs(d,f,m); |
} |
} |
|
|
Line 3423 void Pdpv_ord(NODE arg,Obj *rp) |
|
Line 3423 void Pdpv_ord(NODE arg,Obj *rp) |
|
|
|
ac = argc(arg); |
ac = argc(arg); |
if ( ac ) { |
if ( ac ) { |
id = QTOS((Q)ARG0(arg)); |
id = ZTOS((Q)ARG0(arg)); |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST ) |
shift = (LIST)ARG1(arg); |
shift = (LIST)ARG1(arg); |
else |
else |
Line 3445 void Pdpm_ord(NODE arg,LIST *rp) |
|
Line 3445 void Pdpm_ord(NODE arg,LIST *rp) |
|
nd = BDY((LIST)ARG0(arg)); |
nd = BDY((LIST)ARG0(arg)); |
if ( !create_order_spec(0,(Obj)ARG1(nd),&spec) ) |
if ( !create_order_spec(0,(Obj)ARG1(nd),&spec) ) |
error("dpm_ord : invalid order specification"); |
error("dpm_ord : invalid order specification"); |
initdpm(spec,QTOS((Q)ARG0(nd))); |
initdpm(spec,ZTOS((Q)ARG0(nd))); |
} |
} |
STOQ(dpm_ispot,q); |
STOZ(dpm_ispot,q); |
nd = mknode(2,q,dp_current_spec->obj); |
nd = mknode(2,q,dp_current_spec->obj); |
MKLIST(*rp,nd); |
MKLIST(*rp,nd); |
} |
} |
Line 3493 void Pdpv_ht(NODE arg,LIST *rp) |
|
Line 3493 void Pdpv_ht(NODE arg,LIST *rp) |
|
ht = 0; |
ht = 0; |
else |
else |
dp_ht(BDY(p)[pos],&ht); |
dp_ht(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
Line 3513 void Pdpv_hm(NODE arg,LIST *rp) |
|
Line 3513 void Pdpv_hm(NODE arg,LIST *rp) |
|
ht = 0; |
ht = 0; |
else |
else |
dp_hm(BDY(p)[pos],&ht); |
dp_hm(BDY(p)[pos],&ht); |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,ht); |
n = mknode(2,q,ht); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
Line 3533 void Pdpv_hc(NODE arg,LIST *rp) |
|
Line 3533 void Pdpv_hc(NODE arg,LIST *rp) |
|
hc = 0; |
hc = 0; |
else |
else |
hc = (P)BDY(BDY(p)[pos])->c; |
hc = (P)BDY(BDY(p)[pos])->c; |
STOQ(pos,q); |
STOZ(pos,q); |
n = mknode(2,q,hc); |
n = mknode(2,q,hc); |
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |