version 1.31, 2003/07/01 08:12:37 |
version 1.34, 2003/11/27 02:20:51 |
|
|
* 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/array.c,v 1.30 2003/06/10 16:54:13 saito Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.33 2003/11/08 01:12:02 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
Line 68 void Pgeneric_gauss_elim(); |
|
Line 68 void Pgeneric_gauss_elim(); |
|
void Pgeneric_gauss_elim_mod(); |
void Pgeneric_gauss_elim_mod(); |
|
|
void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat(); |
void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat(); |
void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(); |
void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(), Pltov(); |
void Pgeninv_sf_swap(); |
void Pgeninv_sf_swap(); |
void sepvect(); |
void sepvect(); |
void Pmulmat_gf2n(); |
void Pmulmat_gf2n(); |
Line 108 struct ftab array_tab[] = { |
|
Line 108 struct ftab array_tab[] = { |
|
{"sepvect",Psepvect,2}, |
{"sepvect",Psepvect,2}, |
{"qsort",Pqsort,-2}, |
{"qsort",Pqsort,-2}, |
{"vtol",Pvtol,1}, |
{"vtol",Pvtol,1}, |
|
{"ltov",Pltov,1}, |
{"size",Psize,1}, |
{"size",Psize,1}, |
{"det",Pdet,-2}, |
{"det",Pdet,-2}, |
{"invmat",Pinvmat,-2}, |
{"invmat",Pinvmat,-2}, |
Line 159 void Pqsort(NODE arg,VECT *rp) |
|
Line 160 void Pqsort(NODE arg,VECT *rp) |
|
NODE n; |
NODE n; |
P p; |
P p; |
V v; |
V v; |
|
FUNC func; |
|
|
asir_assert(ARG0(arg),O_VECT,"qsort"); |
asir_assert(ARG0(arg),O_VECT,"qsort"); |
vect = (VECT)ARG0(arg); |
vect = (VECT)ARG0(arg); |
Line 169 void Pqsort(NODE arg,VECT *rp) |
|
Line 171 void Pqsort(NODE arg,VECT *rp) |
|
if ( !p || OID(p)!=2 ) |
if ( !p || OID(p)!=2 ) |
error("qsort : invalid argument"); |
error("qsort : invalid argument"); |
v = VR(p); |
v = VR(p); |
if ( (int)v->attr != V_SR ) |
gen_searchf(NAME(v),&func); |
error("qsort : no such function"); |
if ( !func ) { |
generic_comp_obj_func = (FUNC)v->priv; |
if ( (int)v->attr != V_SR ) |
|
error("qsort : no such function"); |
|
func = (FUNC)v->priv; |
|
} |
|
generic_comp_obj_func = func; |
MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n); |
MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n); |
qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj); |
qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj); |
} |
} |
Line 596 void Pvtol(NODE arg,LIST *rp) |
|
Line 602 void Pvtol(NODE arg,LIST *rp) |
|
MKLIST(*rp,n); |
MKLIST(*rp,n); |
} |
} |
|
|
|
void Pltov(NODE arg,VECT *rp) |
|
{ |
|
NODE n; |
|
VECT v; |
|
int len,i; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"ltov"); |
|
n = (NODE)BDY((LIST)ARG0(arg)); |
|
len = length(n); |
|
MKVECT(v,len); |
|
for ( i = 0; i < len; i++, n = NEXT(n) ) |
|
BDY(v)[i] = BDY(n); |
|
*rp = v; |
|
} |
|
|
void Premainder(NODE arg,Obj *rp) |
void Premainder(NODE arg,Obj *rp) |
{ |
{ |
Obj a; |
Obj a; |
Line 1576 void red_by_vect(int m,unsigned int *p,unsigned int *r |
|
Line 1597 void red_by_vect(int m,unsigned int *p,unsigned int *r |
|
} |
} |
} |
} |
|
|
|
void red_by_vect_sf(int m,unsigned int *p,unsigned int *r,unsigned int hc,int len) |
|
{ |
|
*p++ = 0; r++; len--; |
|
for ( ; len; len--, r++, p++ ) |
|
if ( *r ) |
|
*p = _addsf(_mulsf(*r,hc),*p); |
|
} |
|
|
extern unsigned int **psca; |
extern unsigned int **psca; |
|
|
void reduce_sp_by_red_mod_compress (int *sp,CDP *redmat,int *ind, |
void reduce_sp_by_red_mod_compress (int *sp,CDP *redmat,int *ind, |
Line 1660 int generic_gauss_elim_mod(int **mat0,int row,int col, |
|
Line 1689 int generic_gauss_elim_mod(int **mat0,int row,int col, |
|
if ( t[k] >= (unsigned int)md ) |
if ( t[k] >= (unsigned int)md ) |
t[k] %= md; |
t[k] %= md; |
l++; |
l++; |
|
} |
|
return rank; |
|
} |
|
|
|
int generic_gauss_elim_sf(int **mat0,int row,int col,int md,int *colstat) |
|
{ |
|
int i,j,k,l,inv,a,rank; |
|
unsigned int *t,*pivot,*pk; |
|
unsigned int **mat; |
|
|
|
mat = (unsigned int **)mat0; |
|
for ( rank = 0, j = 0; j < col; j++ ) { |
|
for ( i = rank; i < row; i++ ) |
|
if ( mat[i][j] ) |
|
break; |
|
if ( i == row ) { |
|
colstat[j] = 0; |
|
continue; |
|
} else |
|
colstat[j] = 1; |
|
if ( i != rank ) { |
|
t = mat[i]; mat[i] = mat[rank]; mat[rank] = t; |
|
} |
|
pivot = mat[rank]; |
|
inv = _invsf(pivot[j]); |
|
for ( k = j, pk = pivot+k; k < col; k++, pk++ ) |
|
if ( *pk ) |
|
*pk = _mulsf(*pk,inv); |
|
for ( i = rank+1; i < row; i++ ) { |
|
t = mat[i]; |
|
if ( a = t[j] ) |
|
red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j); |
|
} |
|
rank++; |
|
} |
|
for ( j = col-1, l = rank-1; j >= 0; j-- ) |
|
if ( colstat[j] ) { |
|
pivot = mat[l]; |
|
for ( i = 0; i < l; i++ ) { |
|
t = mat[i]; |
|
if ( a = t[j] ) |
|
red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j); |
|
} |
|
l--; |
} |
} |
return rank; |
return rank; |
} |
} |