version 1.14, 2006/10/26 10:49:17 |
version 1.17, 2017/08/31 02:36:21 |
|
|
/* |
/* |
* $OpenXM: OpenXM_contrib2/asir2000/engine/dalg.c,v 1.13 2006/01/05 00:21:20 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/engine/dalg.c,v 1.16 2013/11/05 02:55:03 noro Exp $ |
*/ |
*/ |
|
|
#include "ca.h" |
#include "ca.h" |
Line 36 void setfield_dalg(NODE alist) |
|
Line 36 void setfield_dalg(NODE alist) |
|
current_numberfield = nf; |
current_numberfield = nf; |
vl = 0; |
vl = 0; |
for ( t = alist; t; t = NEXT(t) ) { |
for ( t = alist; t; t = NEXT(t) ) { |
clctalg(BDY((Alg)BDY(t)),&vl1); |
clctalg((P)BDY((Alg)BDY(t)),&vl1); |
mergev(ALG,vl,vl1,&vl2); vl = vl2; |
mergev(ALG,vl,vl1,&vl2); vl = vl2; |
} |
} |
for ( n = 0, vl1 = vl; vl1; vl1 = NEXT(vl1), n++ ); |
for ( n = 0, vl1 = vl; vl1; vl1 = NEXT(vl1), n++ ); |
Line 121 void qtodalg(Q q,DAlg *r) |
|
Line 121 void qtodalg(Q q,DAlg *r) |
|
*r = (DAlg)q; |
*r = (DAlg)q; |
else if ( NID(q) == N_Q ) { |
else if ( NID(q) == N_Q ) { |
if ( INT(q) ) { |
if ( INT(q) ) { |
muldc(CO,nf->one->nm,(P)q,&nm); |
muldc(CO,nf->one->nm,(Obj)q,&nm); |
MKDAlg(nm,ONE,*r); |
MKDAlg(nm,ONE,*r); |
} else { |
} else { |
NTOQ(NM(q),SGN(q),t); |
NTOQ(NM(q),SGN(q),t); |
muldc(CO,nf->one->nm,(P)t,&nm); |
muldc(CO,nf->one->nm,(Obj)t,&nm); |
NTOQ(DN(q),1,t); |
NTOQ(DN(q),1,t); |
MKDAlg(nm,t,*r); |
MKDAlg(nm,t,*r); |
} |
} |
Line 330 void algtodalg(Alg a,DAlg *r) |
|
Line 330 void algtodalg(Alg a,DAlg *r) |
|
case N_Q: |
case N_Q: |
c = (Q)a; |
c = (Q)a; |
if ( INT(c) ) { |
if ( INT(c) ) { |
muldc(CO,nf->one->nm,(P)c,&dp); |
muldc(CO,nf->one->nm,(Obj)c,&dp); |
MKDAlg(dp,ONE,*r); |
MKDAlg(dp,ONE,*r); |
} else { |
} else { |
NTOQ(NM(c),SGN(c),c1); |
NTOQ(NM(c),SGN(c),c1); |
NTOQ(DN(c),1,d1); |
NTOQ(DN(c),1,d1); |
muldc(CO,nf->one->nm,(P)c1,&dp); |
muldc(CO,nf->one->nm,(Obj)c1,&dp); |
MKDAlg(dp,d1,*r); |
MKDAlg(dp,d1,*r); |
} |
} |
break; |
break; |
Line 351 void algtodalg(Alg a,DAlg *r) |
|
Line 351 void algtodalg(Alg a,DAlg *r) |
|
mulpq(p,(P)nm,&p1); p = p1; |
mulpq(p,(P)nm,&p1); p = p1; |
} |
} |
current_spec = dp_current_spec; initd(nf->spec); |
current_spec = dp_current_spec; initd(nf->spec); |
get_vars(p,&vl); |
get_vars((Obj)p,&vl); |
for ( tvl = vl; tvl; tvl = NEXT(tvl) ) { |
for ( tvl = vl; tvl; tvl = NEXT(tvl) ) { |
v = tvl->v; |
v = tvl->v; |
for ( svl = nf->vl; svl; svl = NEXT(svl) ) |
for ( svl = nf->vl; svl; svl = NEXT(svl) ) |
Line 378 void dalgtoalg(DAlg da,Alg *r) |
|
Line 378 void dalgtoalg(DAlg da,Alg *r) |
|
|
|
if ( !(nf=current_numberfield) ) |
if ( !(nf=current_numberfield) ) |
error("dalgtoalg : current_numberfield is not set"); |
error("dalgtoalg : current_numberfield is not set"); |
dtop(ALG,nf->vl,da->nm,&p); |
if ( !da ) *r = 0; |
invq(da->dn,&inv); |
else { |
mulpq(p,(P)inv,&p1); |
dtop(ALG,nf->vl,da->nm,(Obj *)&p); |
MKAlg(p1,*r); |
invq(da->dn,&inv); |
|
mulpq(p,(P)inv,&p1); |
|
MKAlg(p1,*r); |
|
} |
} |
} |
|
|
void simpdalg(DAlg da,DAlg *r) |
void simpdalg(DAlg da,DAlg *r) |
Line 399 void simpdalg(DAlg da,DAlg *r) |
|
Line 402 void simpdalg(DAlg da,DAlg *r) |
|
return; |
return; |
} |
} |
current_spec = dp_current_spec; initd(nf->spec); |
current_spec = dp_current_spec; initd(nf->spec); |
dp_true_nf(nf->ind,da->nm,nf->ps,1,&nm,&dn); |
dp_true_nf(nf->ind,da->nm,nf->ps,1,&nm,(P *)&dn); |
if ( !nm ) *r = 0; |
if ( !nm ) *r = 0; |
else { |
else { |
initd(current_spec); |
initd(current_spec); |
Line 432 void adddalg(DAlg a,DAlg b,DAlg *c) |
|
Line 435 void adddalg(DAlg a,DAlg b,DAlg *c) |
|
divsn(NM(dna),gn,&an); divsn(NM(dnb),gn,&bn); |
divsn(NM(dna),gn,&an); divsn(NM(dnb),gn,&bn); |
NTOQ(an,SGN(dna),a1); NTOQ(bn,SGN(dnb),b1); |
NTOQ(an,SGN(dna),a1); NTOQ(bn,SGN(dnb),b1); |
/* nma/dna+nmb/dnb = (nma*b1+nmb*a1)/(dna*b1) */ |
/* nma/dna+nmb/dnb = (nma*b1+nmb*a1)/(dna*b1) */ |
muldc(CO,a->nm,(P)b1,&ta); muldc(CO,b->nm,(P)a1,&tb); |
muldc(CO,a->nm,(Obj)b1,&ta); muldc(CO,b->nm,(Obj)a1,&tb); |
current_spec = dp_current_spec; initd(nf->spec); |
current_spec = dp_current_spec; initd(nf->spec); |
addd(CO,ta,tb,&nm); |
addd(CO,ta,tb,&nm); |
initd(current_spec); |
initd(current_spec); |
Line 468 void subdalg(DAlg a,DAlg b,DAlg *c) |
|
Line 471 void subdalg(DAlg a,DAlg b,DAlg *c) |
|
divsn(NM(dna),gn,&an); divsn(NM(dnb),gn,&bn); |
divsn(NM(dna),gn,&an); divsn(NM(dnb),gn,&bn); |
NTOQ(an,SGN(dna),a1); NTOQ(bn,SGN(dnb),b1); |
NTOQ(an,SGN(dna),a1); NTOQ(bn,SGN(dnb),b1); |
/* nma/dna-nmb/dnb = (nma*b1-nmb*a1)/(dna*b1) */ |
/* nma/dna-nmb/dnb = (nma*b1-nmb*a1)/(dna*b1) */ |
muldc(CO,a->nm,(P)b1,&ta); muldc(CO,b->nm,(P)a1,&tb); |
muldc(CO,a->nm,(Obj)b1,&ta); muldc(CO,b->nm,(Obj)a1,&tb); |
current_spec = dp_current_spec; initd(nf->spec); |
current_spec = dp_current_spec; initd(nf->spec); |
subd(CO,ta,tb,&nm); |
subd(CO,ta,tb,&nm); |
initd(current_spec); |
initd(current_spec); |
Line 540 void rmcontdalg(DAlg a, DAlg *r) |
|
Line 543 void rmcontdalg(DAlg a, DAlg *r) |
|
gcdn(NM(cont),NM(a->dn),&gn); |
gcdn(NM(cont),NM(a->dn),&gn); |
divsn(NM(cont),gn,&cn); NTOQ(cn,SGN(cont),c); |
divsn(NM(cont),gn,&cn); NTOQ(cn,SGN(cont),c); |
divsn(NM(a->dn),gn,&dn); NTOQ(dn,SGN(a->dn),d); |
divsn(NM(a->dn),gn,&dn); NTOQ(dn,SGN(a->dn),d); |
muldc(CO,u,(P)c,&u1); |
muldc(CO,u,(Obj)c,&u1); |
MKDAlg(u1,d,*r); |
MKDAlg(u1,d,*r); |
} |
} |
} |
} |
Line 571 int invdalg(DAlg a,DAlg *c) |
|
Line 574 int invdalg(DAlg a,DAlg *c) |
|
error("invdalg : division by 0"); |
error("invdalg : division by 0"); |
else if ( NID(a) == N_Q ) { |
else if ( NID(a) == N_Q ) { |
invq((Q)a,&dn); *c = (DAlg)dn; |
invq((Q)a,&dn); *c = (DAlg)dn; |
return; |
return 1; |
} |
} |
dim = nf->dim; |
dim = nf->dim; |
mb = nf->mb; |
mb = nf->mb; |
Line 620 int invdalg(DAlg a,DAlg *c) |
|
Line 623 int invdalg(DAlg a,DAlg *c) |
|
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
if ( solmat[i][0] ) { |
if ( solmat[i][0] ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
mp->c = (P)solmat[i][0]; |
mp->c = (Obj)solmat[i][0]; |
mp->dl = BDY(mb[i])->dl; |
mp->dl = BDY(mb[i])->dl; |
} |
} |
NEXT(mp) = 0; MKDP(n,mp0,u); |
NEXT(mp) = 0; MKDP(n,mp0,u); |
Line 659 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
Line 662 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
error("invdalg : division by 0"); |
error("invdalg : division by 0"); |
else if ( NID(a) == N_Q ) { |
else if ( NID(a) == N_Q ) { |
invq((Q)a,&dn); *c = (DAlg)dn; |
invq((Q)a,&dn); *c = (DAlg)dn; |
return; |
return 0; |
} |
} |
dim = nf->dim; |
dim = nf->dim; |
mb = nf->mb; |
mb = nf->mb; |
Line 716 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
Line 719 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
if ( solmat[i][0] ) { |
if ( solmat[i][0] ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
mp->c = (P)solmat[i][0]; |
mp->c = (Obj)solmat[i][0]; |
mp->dl = BDY(mb[i])->dl; |
mp->dl = BDY(mb[i])->dl; |
} |
} |
NEXT(mp) = 0; MKDP(n,mp0,u); |
NEXT(mp) = 0; MKDP(n,mp0,u); |
Line 734 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
Line 737 NODE inv_or_split_dalg(DAlg a,DAlg *c) |
|
m = mb[cinfo[k]]; |
m = mb[cinfo[k]]; |
mp0 = 0; |
mp0 = 0; |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
chsgnq(dnsol,&dn1); mp->c = (P)dn1; |
chsgnq(dnsol,&dn1); mp->c = (Obj)dn1; |
mp->dl = BDY(m)->dl; |
mp->dl = BDY(m)->dl; |
/* skip the last parameter */ |
/* skip the last parameter */ |
for ( l = rank-2; l >= 0; l-- ) { |
for ( l = rank-2; l >= 0; l-- ) { |
if ( solmat[l][k] ) { |
if ( solmat[l][k] ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
mp->c = (P)solmat[l][k]; |
mp->c = (Obj)solmat[l][k]; |
mp->dl = BDY(mb[rinfo[l]])->dl; |
mp->dl = BDY(mb[rinfo[l]])->dl; |
} |
} |
} |
} |
Line 783 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
Line 786 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
STOQ(i,iq); BDY(indt) = iq; |
STOQ(i,iq); BDY(indt) = iq; |
} |
} |
if ( ind ) NEXT(indt) = 0; |
if ( ind ) NEXT(indt) = 0; |
dp_true_nf(ind,f,ps,1,&nm,&dn); |
dp_true_nf(ind,f,ps,1,&nm,(P *)&dn); |
if ( !nm ) error("dp_inv_or_split : input is 0"); |
if ( !nm ) error("dp_inv_or_split : input is 0"); |
f = nm; |
f = nm; |
|
|
Line 805 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
Line 808 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
dp_subd(m,mb[j],&d); |
dp_subd(m,mb[j],&d); |
if ( simp[j] ) { |
if ( simp[j] ) { |
muld(CO,d,simp[j]->nm,&u); |
muld(CO,d,simp[j]->nm,&u); |
dp_true_nf(ind,u,ps,1,&nm,&dn); |
dp_true_nf(ind,u,ps,1,&nm,(P *)&dn); |
mulq(simp[j]->dn,dn,&dn1); |
mulq(simp[j]->dn,dn,&dn1); |
MKDAlg(nm,dn1,simp[i]); |
MKDAlg(nm,dn1,simp[i]); |
} else |
} else |
simp[i] = 0; |
simp[i] = 0; |
} else { |
} else { |
dp_true_nf(ind,f,ps,1,&nm,&dn); |
dp_true_nf(ind,f,ps,1,&nm,(P *)&dn); |
MKDAlg(nm,dn,simp[i]); |
MKDAlg(nm,dn,simp[i]); |
} |
} |
if ( simp[i] ) { |
if ( simp[i] ) { |
Line 842 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
Line 845 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
for ( i = dim-1, mp0 = 0; i >= 0; i-- ) |
if ( solmat[i][0] ) { |
if ( solmat[i][0] ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
mp->c = (P)solmat[i][0]; |
mp->c = (Obj)solmat[i][0]; |
mp->dl = BDY(mb[i])->dl; |
mp->dl = BDY(mb[i])->dl; |
} |
} |
NEXT(mp) = 0; MKDP(nv,mp0,*inv); |
NEXT(mp) = 0; MKDP(nv,mp0,*inv); |
Line 857 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
Line 860 NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *s |
|
m = mb[cinfo[k]]; |
m = mb[cinfo[k]]; |
mp0 = 0; |
mp0 = 0; |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
chsgnq(dnsol,&dn1); mp->c = (P)dn1; |
chsgnq(dnsol,&dn1); mp->c = (Obj)dn1; |
mp->dl = BDY(m)->dl; |
mp->dl = BDY(m)->dl; |
/* skip the last parameter */ |
/* skip the last parameter */ |
for ( l = rank-2; l >= 0; l-- ) { |
for ( l = rank-2; l >= 0; l-- ) { |
if ( solmat[l][k] ) { |
if ( solmat[l][k] ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
mp->c = (P)solmat[l][k]; |
mp->c = (Obj)solmat[l][k]; |
mp->dl = BDY(mb[rinfo[l]])->dl; |
mp->dl = BDY(mb[rinfo[l]])->dl; |
} |
} |
} |
} |