| version 1.65, 2006/10/12 08:20:37 |
version 1.68, 2007/09/06 02:23:40 |
|
|
| * non-exclusive and royalty-free license to use, copy, modify and |
* non-exclusive and royalty-free license to use, copy, modify and |
| * redistribute, solely for non-commercial and non-profit purposes, the |
* redistribute, solely for non-commercial and non-profit purposes, the |
| * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and |
* computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and |
| * conditions of this Agreement. For the avoidance of doubt, you acquire |
* conditions of this Agreement. For the avoidance of doubt, you acquire * only a limited right to use the SOFTWARE hereunder, and FLL or any |
| * only a limited right to use the SOFTWARE hereunder, and FLL or any |
|
| * third party developer retains all rights, including but not limited to |
* third party developer retains all rights, including but not limited to |
| * copyrights, in and to the SOFTWARE. |
* copyrights, in and to the SOFTWARE. |
| * |
* |
|
|
| * 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.64 2006/06/13 04:13:26 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.67 2007/08/21 23:53:00 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "base.h" |
#include "base.h" |
| Line 68 void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest( |
|
| Line 67 void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest( |
|
| void Pdp_set_sugar(); |
void Pdp_set_sugar(); |
| void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv(); |
void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv(); |
| void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat(); |
void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat(); |
| void Pdp_nf(),Pdp_true_nf(); |
void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(); |
| void Pdp_nf_mod(),Pdp_true_nf_mod(); |
void Pdp_nf_mod(),Pdp_true_nf_mod(); |
| void Pdp_criB(),Pdp_nelim(); |
void Pdp_criB(),Pdp_nelim(); |
| void Pdp_minp(),Pdp_sp_mod(); |
void Pdp_minp(),Pdp_sp_mod(); |
| Line 100 void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
|
| Line 99 void Pnd_weyl_gr(),Pnd_weyl_gr_trace(); |
|
| void Pnd_nf(); |
void Pnd_nf(); |
| void Pdp_initial_term(); |
void Pdp_initial_term(); |
| void Pdp_order(); |
void Pdp_order(); |
| |
void Pdp_inv_or_split(); |
| |
void Pdp_compute_last_w(); |
| |
|
| LIST dp_initial_term(); |
LIST dp_initial_term(); |
| LIST dp_order(); |
LIST dp_order(); |
| Line 133 struct ftab dp_tab[] = { |
|
| Line 134 struct ftab dp_tab[] = { |
|
| {"dp_nf",Pdp_nf,4}, |
{"dp_nf",Pdp_nf,4}, |
| {"dp_nf_f",Pdp_nf_f,4}, |
{"dp_nf_f",Pdp_nf_f,4}, |
| {"dp_true_nf",Pdp_true_nf,4}, |
{"dp_true_nf",Pdp_true_nf,4}, |
| |
{"dp_true_nf_marked",Pdp_true_nf_marked,4}, |
| {"dp_nf_mod",Pdp_nf_mod,5}, |
{"dp_nf_mod",Pdp_nf_mod,5}, |
| {"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
{"dp_true_nf_mod",Pdp_true_nf_mod,5}, |
| {"dp_lnf_mod",Pdp_lnf_mod,3}, |
{"dp_lnf_mod",Pdp_lnf_mod,3}, |
| Line 185 struct ftab dp_tab[] = { |
|
| Line 187 struct ftab dp_tab[] = { |
|
| {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4}, |
| |
|
| /* misc */ |
/* misc */ |
| |
{"dp_inv_or_split",Pdp_inv_or_split,3}, |
| {"dp_set_weight",Pdp_set_weight,-1}, |
{"dp_set_weight",Pdp_set_weight,-1}, |
| {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1}, |
| {0,0,0}, |
{0,0,0}, |
| Line 245 struct ftab dp_supp_tab[] = { |
|
| Line 248 struct ftab dp_supp_tab[] = { |
|
| {"dp_idiv",Pdp_idiv,2}, |
{"dp_idiv",Pdp_idiv,2}, |
| {"dp_tdiv",Pdp_tdiv,2}, |
{"dp_tdiv",Pdp_tdiv,2}, |
| {"dp_minp",Pdp_minp,2}, |
{"dp_minp",Pdp_minp,2}, |
| |
{"dp_compute_last_w",Pdp_compute_last_w,5}, |
| |
|
| {0,0,0} |
{0,0,0} |
| }; |
}; |
| |
|
| |
NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2); |
| |
|
| |
void Pdp_compute_last_w(NODE arg,LIST *rp) |
| |
{ |
| |
NODE g,gh,r; |
| |
VECT w,rv; |
| |
LIST l; |
| |
MAT w1,w2; |
| |
int row1,row2,i,j,n; |
| |
int *v; |
| |
int **m1,**m2; |
| |
Q q; |
| |
|
| |
g = (NODE)BDY((LIST)ARG0(arg)); |
| |
gh = (NODE)BDY((LIST)ARG1(arg)); |
| |
w = (VECT)ARG2(arg); |
| |
w1 = (MAT)ARG3(arg); |
| |
w2 = (MAT)ARG4(arg); |
| |
n = w1->col; |
| |
row1 = w1->row; |
| |
row2 = w2->row; |
| |
if ( w ) { |
| |
v = W_ALLOC(n); |
| |
for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]); |
| |
} else v = 0; |
| |
m1 = almat(row1,n); |
| |
for ( i = 0; i < row1; i++ ) |
| |
for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]); |
| |
m2 = almat(row2,n); |
| |
for ( i = 0; i < row2; i++ ) |
| |
for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]); |
| |
r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2); |
| |
if ( !r ) *rp = 0; |
| |
else { |
| |
MKVECT(rv,n); |
| |
for ( i = 0; i < n; i++ ) { |
| |
STOQ(v[i],q); rv->body[i] = (pointer)q; |
| |
} |
| |
MKLIST(l,r); |
| |
r = mknode(2,rv,l); |
| |
MKLIST(*rp,r); |
| |
} |
| |
} |
| |
|
| |
void Pdp_inv_or_split(arg,rp) |
| |
NODE arg; |
| |
Obj *rp; |
| |
{ |
| |
NODE gb,newgb; |
| |
DP f,inv; |
| |
struct order_spec *spec; |
| |
LIST list; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_inv_or_split"); |
| |
if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) ) |
| |
error("dp_inv_or_split : invalid order specification"); |
| |
gb = BDY((LIST)ARG0(arg)); |
| |
f = (DP)ARG1(arg); |
| |
newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv); |
| |
if ( !newgb ) { |
| |
/* invertible */ |
| |
*rp = (Obj)inv; |
| |
} else { |
| |
MKLIST(list,newgb); |
| |
*rp = (Obj)list; |
| |
} |
| |
} |
| |
|
| void Pdp_sort(arg,rp) |
void Pdp_sort(arg,rp) |
| NODE arg; |
NODE arg; |
| DP *rp; |
DP *rp; |
|
|
| b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg)); |
| full = (Q)ARG3(arg) ? 1 : 0; |
full = (Q)ARG3(arg) ? 1 : 0; |
| dp_true_nf(b,g,ps,full,&nm,&dn); |
dp_true_nf(b,g,ps,full,&nm,&dn); |
| |
} |
| |
NEWNODE(n); BDY(n) = (pointer)nm; |
| |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
| |
NEXT(NEXT(n)) = 0; MKLIST(*rp,n); |
| |
} |
| |
|
| |
void Pdp_true_nf_marked(arg,rp) |
| |
NODE arg; |
| |
LIST *rp; |
| |
{ |
| |
NODE b,n; |
| |
DP *ps,*hps; |
| |
DP g; |
| |
DP nm; |
| |
P dn; |
| |
int full; |
| |
|
| |
do_weyl = 0; dp_fcoeffs = 0; |
| |
asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked"); |
| |
asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked"); |
| |
asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked"); |
| |
asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked"); |
| |
if ( !(g = (DP)ARG1(arg)) ) { |
| |
nm = 0; dn = (P)ONE; |
| |
} else { |
| |
b = BDY((LIST)ARG0(arg)); |
| |
ps = (DP *)BDY((VECT)ARG2(arg)); |
| |
hps = (DP *)BDY((VECT)ARG3(arg)); |
| |
dp_true_nf_marked(b,g,ps,hps,&nm,&dn); |
| } |
} |
| NEWNODE(n); BDY(n) = (pointer)nm; |
NEWNODE(n); BDY(n) = (pointer)nm; |
| NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |
NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn; |