| version 1.8, 2004/12/06 01:15:18 |
version 1.10, 2005/01/23 14:03:47 |
|
|
| * 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/algnum.c,v 1.7 2004/12/02 13:48:43 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/algnum.c,v 1.9 2004/12/06 09:29:34 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "parse.h" |
#include "parse.h" |
| Line 54 void Pdefpoly(), Pnewalg(), Pmainalg(), Palgtorat(), P |
|
| Line 54 void Pdefpoly(), Pnewalg(), Pmainalg(), Palgtorat(), P |
|
| void Palg(), Palgv(), Pgetalgtree(); |
void Palg(), Palgv(), Pgetalgtree(); |
| void Pinvalg_le(); |
void Pinvalg_le(); |
| void Pset_field(),Palgtodalg(),Pdalgtoalg(); |
void Pset_field(),Palgtodalg(),Pdalgtoalg(); |
| |
void Pinv_or_split_dalg(); |
| |
|
| void mkalg(P,Alg *); |
void mkalg(P,Alg *); |
| int cmpalgp(P,P); |
int cmpalgp(P,P); |
| Line 68 struct ftab alg_tab[] = { |
|
| Line 69 struct ftab alg_tab[] = { |
|
| {"set_field",Pset_field,1}, |
{"set_field",Pset_field,1}, |
| {"algtodalg",Palgtodalg,1}, |
{"algtodalg",Palgtodalg,1}, |
| {"dalgtoalg",Pdalgtoalg,1}, |
{"dalgtoalg",Pdalgtoalg,1}, |
| |
{"inv_or_split_dalg",Pinv_or_split_dalg,1}, |
| {"invalg_le",Pinvalg_le,1}, |
{"invalg_le",Pinvalg_le,1}, |
| {"defpoly",Pdefpoly,1}, |
{"defpoly",Pdefpoly,1}, |
| {"newalg",Pnewalg,1}, |
{"newalg",Pnewalg,1}, |
| Line 99 void Pdalgtoalg(NODE arg,Alg *rp) |
|
| Line 101 void Pdalgtoalg(NODE arg,Alg *rp) |
|
| dalgtoalg((DAlg)ARG0(arg),rp); |
dalgtoalg((DAlg)ARG0(arg),rp); |
| } |
} |
| |
|
| |
NODE inv_or_split_dalg(DAlg,DAlg *); |
| |
NumberField get_numberfield(); |
| |
|
| |
void Pinv_or_split_dalg(NODE arg,Obj *rp) |
| |
{ |
| |
NODE gen,t,nd0,nd; |
| |
LIST list; |
| |
int l,i,j,k,n; |
| |
DP *ps,*ps1,*psw; |
| |
NumberField nf; |
| |
DAlg inv; |
| |
extern struct order_spec *dp_current_spec; |
| |
struct order_spec *current_spec; |
| |
|
| |
gen = inv_or_split_dalg((DAlg)ARG0(arg),&inv); |
| |
if ( !gen ) |
| |
*rp = (Obj)inv; |
| |
else { |
| |
nf = get_numberfield(); |
| |
current_spec = dp_current_spec; initd(nf->spec); |
| |
l = length(gen); |
| |
n = nf->n; |
| |
ps = nf->ps; |
| |
psw = (DP *)ALLOCA((n+l)*sizeof(DP)); |
| |
for ( i = j = 0; i < n; i++ ) { |
| |
for ( t = gen; t; t = NEXT(t) ) |
| |
if ( dp_redble(ps[i],(DP)BDY(t)) ) break; |
| |
if ( !t ) |
| |
psw[j++] = ps[i]; |
| |
} |
| |
nd0 = 0; |
| |
/* gen[0] < gen[1] < ... */ |
| |
/* psw[0] > psw[1] > ... */ |
| |
for ( i = j-1, t = gen; i >= 0 && t; ) { |
| |
NEXTNODE(nd0,nd); |
| |
if ( compd(CO,psw[i],(DP)BDY(t)) > 0 ) { |
| |
BDY(nd) = BDY(t); t = NEXT(t); |
| |
} else |
| |
BDY(nd) = (pointer)psw[i--]; |
| |
} |
| |
for ( ; i >= 0; i-- ) { |
| |
NEXTNODE(nd0,nd); BDY(nd) = (pointer)psw[i]; |
| |
} |
| |
for ( ; t; t = NEXT(t), k++ ) { |
| |
NEXTNODE(nd0,nd); BDY(nd) = BDY(t); |
| |
} |
| |
NEXT(nd) = 0; |
| |
MKLIST(list,nd0); |
| |
initd(current_spec); |
| |
*rp = (Obj)list; |
| |
} |
| |
} |
| |
|
| void Pnewalg(arg,rp) |
void Pnewalg(arg,rp) |
| NODE arg; |
NODE arg; |
| Alg *rp; |
Alg *rp; |
| Line 660 void get_algtree(Obj f,VL *r) |
|
| Line 715 void get_algtree(Obj f,VL *r) |
|
| break; |
break; |
| default: |
default: |
| *r = 0; |
*r = 0; |
| |
break; |
| |
} |
| |
} |
| |
|
| |
void algobjtorat(Obj f,Obj *r) |
| |
{ |
| |
Obj t; |
| |
DCP dc,dcr,dcr0; |
| |
P p,nm,dn; |
| |
R rat; |
| |
NODE b,s,s0; |
| |
VECT v; |
| |
MAT mat; |
| |
LIST list; |
| |
pointer *a; |
| |
pointer **m; |
| |
int len,row,col,i,j,l; |
| |
|
| |
if ( !f ) *r = 0; |
| |
else |
| |
switch ( OID(f) ) { |
| |
case O_N: |
| |
algtorat((Num)f,r); |
| |
break; |
| |
case O_P: |
| |
dcr0 = 0; |
| |
for ( dc = DC((P)f); dc; dc = NEXT(dc) ) { |
| |
NEXTDC(dcr0,dcr); |
| |
algobjtorat((Obj)COEF(dc),&t); |
| |
COEF(dcr) = (P)t; |
| |
DEG(dcr) = DEG(dc); |
| |
} |
| |
NEXT(dcr) = 0; MKP(VR((P)f),dcr0,p); *r = (Obj)p; |
| |
break; |
| |
case O_R: |
| |
algobjtorat((Obj)NM((R)f),&t); nm = (P)t; |
| |
algobjtorat((Obj)DN((R)f),&t); dn = (P)t; |
| |
MKRAT(nm,dn,0,rat); *r = (Obj)rat; |
| |
break; |
| |
case O_LIST: |
| |
s0 = 0; |
| |
for ( b = BDY((LIST)f); b; b = NEXT(b) ) { |
| |
NEXTNODE(s0,s); |
| |
algobjtorat((Obj)BDY(b),&t); |
| |
BDY(s) = (pointer)t; |
| |
} |
| |
NEXT(s) = 0; |
| |
MKLIST(list,s0); |
| |
*r = (Obj)list; |
| |
break; |
| |
case O_VECT: |
| |
l = ((VECT)f)->len; |
| |
a = BDY((VECT)f); |
| |
MKVECT(v,l); |
| |
for ( i = 0; i < l; i++ ) { |
| |
algobjtorat((Obj)a[i],&t); |
| |
BDY(v)[i] = (pointer)t; |
| |
} |
| |
*r = (Obj)v; |
| |
break; |
| |
case O_MAT: |
| |
row = ((MAT)f)->row; col = ((MAT)f)->col; |
| |
m = BDY((MAT)f); |
| |
MKMAT(mat,row,col); |
| |
for ( i = 0; i < row; i++ ) |
| |
for ( j = 0; j < col; j++ ) { |
| |
algobjtorat((Obj)m[i][j],&t); |
| |
BDY(mat)[i][j] = (pointer)t; |
| |
} |
| |
*r = (Obj)mat; |
| |
break; |
| |
default: |
| |
*r = f; |
| break; |
break; |
| } |
} |
| } |
} |