version 1.17, 2003/01/04 09:06:16 |
version 1.23, 2004/07/30 07:34:40 |
|
|
* 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/fctr.c,v 1.16 2002/10/31 03:59:50 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/fctr.c,v 1.22 2004/05/14 09:20:56 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
P *rp; |
P *rp; |
{ |
{ |
DCP dc; |
DCP dc; |
|
MP mp; |
int m; |
int m; |
|
Obj obj; |
P p,p1; |
P p,p1; |
P *l; |
P *l; |
V v; |
V v; |
|
|
asir_assert(ARG0(arg),O_P,"sfcont"); |
obj = (Obj)ARG0(arg); |
p = (P)ARG0(arg); |
if ( !obj || NUM(obj) ) |
if ( NUM(p) ) |
*rp = (P)obj; |
*rp = p; |
else if ( OID(obj) == O_P ) { |
else { |
p = (P)obj; |
if ( argc(arg) == 2 ) { |
if ( argc(arg) == 2 ) { |
v = VR((P)ARG1(arg)); |
v = VR((P)ARG1(arg)); |
change_mvar(CO,p,v,&p1); |
change_mvar(CO,p,v,&p1); |
|
|
for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ ) |
for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ ) |
l[m] = COEF(dc); |
l[m] = COEF(dc); |
gcdsf(CO,l,m,rp); |
gcdsf(CO,l,m,rp); |
|
} else if ( OID(obj) == O_DP ) { |
|
for ( m = 0, mp = BDY((DP)obj); mp; mp = NEXT(mp), m++ ); |
|
l = (P *)ALLOCA(m*sizeof(P)); |
|
for ( m = 0, mp = BDY((DP)obj); mp; mp = NEXT(mp), m++) |
|
l[m] = mp->c; |
|
gcdsf(CO,l,m,rp); |
} |
} |
} |
} |
|
|
void Pptozp(arg,rp) |
void Pptozp(arg,rp) |
NODE arg; |
NODE arg; |
P *rp; |
Obj *rp; |
{ |
{ |
Q t; |
Q t; |
|
NODE tt,p; |
|
NODE n,n0; |
|
char *key; |
|
P pp; |
|
LIST list; |
|
int get_factor=0; |
|
|
asir_assert(ARG0(arg),O_P,"ptozp"); |
asir_assert(ARG0(arg),O_P,"ptozp"); |
ptozp((P)ARG0(arg),1,&t,rp); |
|
|
/* analyze the option */ |
|
if ( current_option ) { |
|
for ( tt = current_option; tt; tt = NEXT(tt) ) { |
|
p = BDY((LIST)BDY(tt)); |
|
key = BDY((STRING)BDY(p)); |
|
/* value = (Obj)BDY(NEXT(p)); */ |
|
if ( !strcmp(key,"factor") ) get_factor=1; |
|
else { |
|
error("ptozp: unknown option."); |
|
} |
|
} |
|
} |
|
|
|
ptozp((P)ARG0(arg),1,&t,&pp); |
|
|
|
/* printexpr(NULL,t); */ |
|
/* if the option factor is given, then it returns the answer |
|
in the format [zpoly, num] where num*zpoly is equal to the argument.*/ |
|
if (get_factor) { |
|
n0 = mknode(2,pp,t); |
|
MKLIST(list,n0); |
|
*rp = (Obj)list; |
|
} else |
|
*rp = (Obj)pp; |
} |
} |
|
|
void Pafctr(arg,rp) |
void Pafctr(arg,rp) |
|
|
|
|
UM *resberle(); |
UM *resberle(); |
|
|
|
void reduce_sfdc(DCP sfdc, DCP *dc); |
|
|
void Pmodfctr(arg,rp) |
void Pmodfctr(arg,rp) |
NODE arg; |
NODE arg; |
LIST *rp; |
LIST *rp; |
{ |
{ |
DCP dc; |
DCP dc,dcu; |
int mod; |
int mod,i,t; |
|
P p; |
|
Obj u; |
|
VL vl; |
|
|
mod = QTOS((Q)ARG1(arg)); |
mod = QTOS((Q)ARG1(arg)); |
if ( mod < 0 ) |
if ( mod < 0 ) |
error("modfctr : invalid modulus"); |
error("modfctr : invalid modulus"); |
modfctrp(ARG0(arg),mod,NEWDDD,&dc); |
p = (P)ARG0(arg); |
|
clctv(CO,p,&vl); |
|
if ( !vl ) { |
|
NEWDC(dc); COEF(dc) = p; DEG(dc) = ONE; NEXT(dc) = 0; |
|
} else if ( !NEXT(vl) ) |
|
modfctrp(ARG0(arg),mod,NEWDDD,&dc); |
|
else { |
|
/* XXX 16384 should be replaced by a macro */ |
|
for ( i = 1, t = 1; t*mod < 16384; t *= mod, i++ ); |
|
current_ff = FF_GFS; |
|
setmod_sf(mod,i); |
|
simp_ff((Obj)p,&u); |
|
mfctrsf(CO,(P)u,&dcu); |
|
reduce_sfdc(dcu,&dc); |
|
} |
if ( !dc ) { |
if ( !dc ) { |
NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0; |
NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0; |
} |
} |
|
|
for ( i = 0; i < n; i++ ) |
for ( i = 0; i < n; i++ ) |
umtop(v,r[i],(P *)&BDY(result)[i]); |
umtop(v,r[i],(P *)&BDY(result)[i]); |
*rp = result; |
*rp = result; |
|
} |
|
|
|
void reduce_sfdc(DCP sfdc,DCP *dcr) |
|
{ |
|
P c,t,s,u,f; |
|
DCP dc0,dc,tdc; |
|
DCP *a; |
|
int i,j,n; |
|
|
|
if ( !current_gfs_ext ) { |
|
/* we simply apply sfptop() */ |
|
for ( dc0 = 0; sfdc; sfdc = NEXT(sfdc) ) { |
|
NEXTDC(dc0,dc); |
|
DEG(dc) = DEG(sfdc); |
|
sfptop(COEF(sfdc),&COEF(dc)); |
|
} |
|
NEXT(dc) = 0; |
|
*dcr = dc0; |
|
return; |
|
} |
|
|
|
if ( NUM(COEF(sfdc)) ) { |
|
sfptop(COEF(sfdc),&c); |
|
sfdc = NEXT(sfdc); |
|
} else |
|
c = (P)ONE; |
|
|
|
for ( n = 0, tdc = sfdc; tdc; tdc = NEXT(tdc), n++ ); |
|
a = (DCP *)ALLOCA(n*sizeof(DCP)); |
|
for ( i = 0, tdc = sfdc; i < n; tdc = NEXT(tdc), i++ ) |
|
a[i] = tdc; |
|
|
|
dc0 = 0; NEXTDC(dc0,dc); DEG(dc) = ONE; COEF(dc) = c; |
|
for ( i = 0; i < n; i++ ) { |
|
if ( !a[i] ) |
|
continue; |
|
t = COEF(a[i]); |
|
f = t; |
|
while ( 1 ) { |
|
sf_galois_action(t,ONE,&s); |
|
for ( j = i; j < n; j++ ) |
|
if ( a[j] && !compp(CO,s,COEF(a[j])) ) |
|
break; |
|
if ( j == n ) |
|
error("reduce_sfdc : cannot happen"); |
|
if ( j == i ) { |
|
NEXTDC(dc0,dc); DEG(dc) = DEG(a[i]); |
|
sfptop(f,&COEF(dc)); |
|
break; |
|
} else { |
|
mulp(CO,f,s,&u); f = u; |
|
t = s; |
|
a[j] = 0; |
|
} |
|
} |
|
} |
|
*dcr = dc0; |
} |
} |