version 1.90, 2013/09/09 09:47:09 |
version 1.94, 2015/01/13 00:54:54 |
|
|
* 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.89 2013/09/09 07:29:25 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.93 2014/10/10 09:02:24 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 56 extern int dp_order_pair_length; |
|
Line 56 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; |
extern struct modorder_spec *dp_current_modspec; |
|
extern int nd_rref2; |
|
|
int do_weyl; |
int do_weyl; |
|
|
Line 109 void Pdp_get_denomlist(); |
|
Line 110 void Pdp_get_denomlist(); |
|
void Pdp_symb_add(); |
void Pdp_symb_add(); |
void Pdp_mono_raddec(); |
void Pdp_mono_raddec(); |
void Pdp_mono_reduce(); |
void Pdp_mono_reduce(); |
|
void Pdp_rref2(); |
|
|
LIST dp_initial_term(); |
LIST dp_initial_term(); |
LIST dp_order(); |
LIST dp_order(); |
Line 165 struct ftab dp_tab[] = { |
|
Line 167 struct ftab dp_tab[] = { |
|
{"nd_gr_trace",Pnd_gr_trace,5}, |
{"nd_gr_trace",Pnd_gr_trace,5}, |
{"nd_f4_trace",Pnd_f4_trace,5}, |
{"nd_f4_trace",Pnd_f4_trace,5}, |
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
{"nd_gr_postproc",Pnd_gr_postproc,5}, |
#if 0 |
|
{"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5}, |
{"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5}, |
#endif |
|
{"nd_btog",Pnd_btog,-6}, |
{"nd_btog",Pnd_btog,-6}, |
{"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, |
{"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5}, |
{"nd_weyl_gr",Pnd_weyl_gr,4}, |
{"nd_weyl_gr",Pnd_weyl_gr,4}, |
Line 277 struct ftab dp_supp_tab[] = { |
|
Line 277 struct ftab dp_supp_tab[] = { |
|
{"dp_mono_raddec",Pdp_mono_raddec,2}, |
{"dp_mono_raddec",Pdp_mono_raddec,2}, |
{"dp_mono_reduce",Pdp_mono_reduce,2}, |
{"dp_mono_reduce",Pdp_mono_reduce,2}, |
|
|
|
{"dp_rref2",Pdp_rref2,2}, |
|
|
{0,0,0} |
{0,0,0} |
}; |
}; |
|
|
|
|
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); |
asir_assert(p1,O_DP,"dp_symb_add"); |
asir_assert(p1,O_DP,"dp_symb_add"); |
asir_assert(p2,O_DP,"dp_symb_add"); |
asir_assert(p2,O_DP,"dp_symb_add"); |
|
if ( !p1 ) { *rp = p2; return; } |
|
else if ( !p2 ) { *rp = p1; return; } |
if ( p1->nv != p2->nv ) |
if ( p1->nv != p2->nv ) |
error("dp_sumb_add : invalid input"); |
error("dp_sumb_add : invalid input"); |
nv = p1->nv; |
nv = p1->nv; |
|
|
struct order_spec *ord; |
struct order_spec *ord; |
|
|
do_weyl = 0; |
do_weyl = 0; |
|
nd_rref2 = 0; |
asir_assert(ARG0(arg),O_LIST,"nd_f4"); |
asir_assert(ARG0(arg),O_LIST,"nd_f4"); |
asir_assert(ARG1(arg),O_LIST,"nd_f4"); |
asir_assert(ARG1(arg),O_LIST,"nd_f4"); |
asir_assert(ARG2(arg),O_N,"nd_f4"); |
asir_assert(ARG2(arg),O_N,"nd_f4"); |
|
|
homo = retdp = 0; |
homo = retdp = 0; |
if ( get_opt("homo",&val) && val ) homo = 1; |
if ( get_opt("homo",&val) && val ) homo = 1; |
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; |
nd_gr(f,v,m,homo,retdp,1,ord,rp); |
nd_gr(f,v,m,homo,retdp,1,ord,rp); |
} |
} |
|
|
|
|
nd_gr_postproc(f,v,m,ord,do_check,rp); |
nd_gr_postproc(f,v,m,ord,do_check,rp); |
} |
} |
|
|
#if 0 |
|
void Pnd_gr_recompute_trace(arg,rp) |
void Pnd_gr_recompute_trace(arg,rp) |
NODE arg; |
NODE arg; |
LIST *rp; |
LIST *rp; |
|
|
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); |
} |
} |
#endif |
|
|
|
Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos); |
Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos); |
Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist); |
Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist); |
|
|
} |
} |
} |
} |
|
|
VECT current_top_weight_vector_obj; |
extern Obj current_top_weight; |
N *current_top_weight_vector; |
extern Obj nd_top_weight; |
|
|
void Pdp_set_top_weight(arg,rp) |
void Pdp_set_top_weight(NODE arg,Obj *rp) |
NODE arg; |
|
VECT *rp; |
|
{ |
{ |
VECT v; |
VECT v; |
int i,n; |
MAT m; |
|
Obj obj; |
|
int i,j,n,id,row,col; |
|
Q *mi; |
NODE node; |
NODE node; |
|
|
if ( !arg ) |
if ( !arg ) |
*rp = current_top_weight_vector_obj; |
*rp = current_top_weight; |
else if ( !ARG0(arg) ) { |
else if ( !ARG0(arg) ) { |
current_top_weight_vector = 0; |
reset_top_weight(); |
current_top_weight_vector_obj = 0; |
|
*rp = 0; |
*rp = 0; |
} else { |
} else { |
if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST ) |
id = OID(ARG0(arg)); |
|
if ( id != O_VECT && id != O_MAT && id != O_LIST ) |
error("dp_set_top_weight : invalid argument"); |
error("dp_set_top_weight : invalid argument"); |
if ( OID(ARG0(arg)) == O_VECT ) |
if ( id == O_LIST ) { |
v = (VECT)ARG0(arg); |
|
else { |
|
node = (NODE)BDY((LIST)ARG0(arg)); |
node = (NODE)BDY((LIST)ARG0(arg)); |
n = length(node); |
n = length(node); |
MKVECT(v,n); |
MKVECT(v,n); |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
for ( i = 0; i < n; i++, node = NEXT(node) ) |
BDY(v)[i] = BDY(node); |
BDY(v)[i] = BDY(node); |
|
obj = v; |
|
} else |
|
obj = ARG0(arg); |
|
if ( OID(obj) == O_VECT ) { |
|
v = (VECT)obj; |
|
for ( i = 0; i < v->len; i++ ) |
|
if ( !INT(BDY(v)[i]) || (BDY(v)[i] && SGN((Q)BDY(v)[i]) < 0) ) |
|
error("dp_set_top_weight : each element must be a non-negative integer"); |
|
} else { |
|
m = (MAT)obj; row = m->row; col = m->col; |
|
for ( i = 0; i < row; i++ ) |
|
for ( j = 0, mi = (Q *)BDY(m)[i]; j < col; j++ ) |
|
if ( !INT(mi[j]) || (mi[j] && SGN((Q)mi[j]) < 0) ) |
|
error("dp_set_top_weight : each element must be a non-negative integer"); |
} |
} |
for ( i = 0; i < v->len; i++ ) |
current_top_weight = obj; |
if ( !INT(BDY(v)[i]) || (BDY(v)[i] && SGN((Q)BDY(v)[i]) < 0) ) |
nd_top_weight = obj; |
error("dp_set_top_weight : each element must be a non-negative integer"); |
*rp = current_top_weight; |
current_top_weight_vector_obj = v; |
|
current_top_weight_vector = (N *)MALLOC(v->len*sizeof(N)); |
|
for ( i = 0; i < v->len; i++ ) { |
|
current_top_weight_vector[i] = !BDY(v)[i]?0:NM((Q)BDY(v)[i]); |
|
} |
|
*rp = current_top_weight_vector_obj; |
|
} |
} |
} |
} |
|
|
Line 2790 void Pdp_mono_reduce(NODE arg,LIST *rp) |
|
Line 2801 void Pdp_mono_reduce(NODE arg,LIST *rp) |
|
MKLIST(*rp,r0); |
MKLIST(*rp,r0); |
} |
} |
|
|
|
#define BLEN (8*sizeof(unsigned long)) |
|
|
|
void showmat2(unsigned long **a,int row,int col) |
|
{ |
|
int i,j; |
|
|
|
for ( i = 0; i < row; i++, putchar('\n') ) |
|
for ( j = 0; j < col; j++ ) |
|
if ( a[i][j/BLEN] & (1L<<(j%BLEN)) ) putchar('1'); |
|
else putchar('0'); |
|
} |
|
|
|
int rref2(unsigned long **a,int row,int col) |
|
{ |
|
int i,j,k,l,s,wcol,wj; |
|
unsigned long bj; |
|
unsigned long *ai,*ak,*as,*t; |
|
int *pivot; |
|
|
|
wcol = (col+BLEN-1)/BLEN; |
|
pivot = (int *)MALLOC_ATOMIC(row*sizeof(int)); |
|
i = 0; |
|
for ( j = 0; j < col; j++ ) { |
|
wj = j/BLEN; bj = 1L<<(j%BLEN); |
|
for ( k = i; k < row; k++ ) |
|
if ( a[k][wj] & bj ) break; |
|
if ( k == row ) continue; |
|
pivot[i] = j; |
|
if ( k != i ) { |
|
t = a[i]; a[i] = a[k]; a[k] = t; |
|
} |
|
ai = a[i]; |
|
for ( k = i+1; k < row; k++ ) { |
|
ak = a[k]; |
|
if ( ak[wj] & bj ) { |
|
for ( l = wj; l < wcol; l++ ) |
|
ak[l] ^= ai[l]; |
|
} |
|
} |
|
i++; |
|
} |
|
for ( k = i-1; k >= 0; k-- ) { |
|
j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN); |
|
ak = a[k]; |
|
for ( s = 0; s < k; s++ ) { |
|
as = a[s]; |
|
if ( as[wj] & bj ) { |
|
for ( l = wj; l < wcol; l++ ) |
|
as[l] ^= ak[l]; |
|
} |
|
} |
|
} |
|
return i; |
|
} |
|
|
|
void Pdp_rref2(NODE arg,VECT *rp) |
|
{ |
|
VECT f,term,ret; |
|
int row,col,wcol,size,nv,i,j,rank,td; |
|
unsigned long **mat; |
|
unsigned long *v; |
|
DL d; |
|
DL *t; |
|
DP dp; |
|
MP m,m0; |
|
|
|
f = (VECT)ARG0(arg); |
|
row = f->len; |
|
term = (VECT)ARG1(arg); |
|
col = term->len; |
|
mat = (unsigned long **)MALLOC(row*sizeof(unsigned long *)); |
|
size = sizeof(unsigned long)*((col+BLEN-1)/BLEN); |
|
nv = ((DP)term->body[0])->nv; |
|
t = (DL *)MALLOC(col*sizeof(DL)); |
|
for ( i = 0; i < col; i++ ) t[i] = BDY((DP)BDY(term)[i])->dl; |
|
for ( i = 0; i < row; i++ ) { |
|
v = mat[i] = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size); |
|
bzero(v,size); |
|
for ( j = 0, m = BDY((DP)BDY(f)[i]); m; m = NEXT(m) ) { |
|
d = m->dl; |
|
for ( ; !dl_equal(nv,d,t[j]); j++ ); |
|
v[j/BLEN] |= 1L <<(j%BLEN); |
|
} |
|
} |
|
rank = rref2(mat,row,col); |
|
MKVECT(ret,rank); |
|
*rp = ret; |
|
for ( i = 0; i < rank; i++ ) { |
|
v = mat[i]; |
|
m0 = 0; |
|
td = 0; |
|
for ( j = 0; j < col; j++ ) { |
|
if ( v[j/BLEN] & (1L<<(j%BLEN)) ) { |
|
NEXTMP(m0,m); |
|
m->dl = t[j]; |
|
m->c = (P)ONE; |
|
td = MAX(td,m->dl->td); |
|
} |
|
} |
|
NEXT(m) = 0; |
|
MKDP(nv,m0,dp); |
|
dp->sugar = td; |
|
BDY(ret)[i] = (pointer)dp; |
|
} |
|
} |
|
|
LIST remove_zero_from_list(LIST l) |
LIST remove_zero_from_list(LIST l) |
{ |
{ |
NODE n,r0,r; |
NODE n,r0,r; |
Line 2972 int get_opt(char *key0,Obj *r) { |
|
Line 3089 int get_opt(char *key0,Obj *r) { |
|
} |
} |
return 0; |
return 0; |
} |
} |
|
|