version 1.68, 2015/08/14 13:51:54 |
version 1.71, 2017/02/21 09:20:23 |
|
|
* 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.67 2015/08/08 14:19:41 fujimoto Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.70 2017/01/08 03:05:39 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
|
|
extern int DP_Print; /* XXX */ |
extern int DP_Print; /* XXX */ |
|
|
|
|
void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm(); |
void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm(), Ptriangleq(); |
void Pinvmat(); |
void Pinvmat(); |
void Pnewbytearray(),Pmemoryplot_to_coord(); |
void Pnewbytearray(),Pmemoryplot_to_coord(); |
|
|
void Pgeneric_gauss_elim(); |
void Pgeneric_gauss_elim(); |
void Pgeneric_gauss_elim_mod(); |
void Pgeneric_gauss_elim_mod(); |
|
|
|
void Pindep_rows_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(), Pltov(); |
void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(), Pltov(); |
void Pgeninv_sf_swap(); |
void Pgeninv_sf_swap(); |
Line 108 struct ftab array_tab[] = { |
|
Line 110 struct ftab array_tab[] = { |
|
{"mat_to_gfmmat",Pmat_to_gfmmat,2}, |
{"mat_to_gfmmat",Pmat_to_gfmmat,2}, |
{"generic_gauss_elim",Pgeneric_gauss_elim,1}, |
{"generic_gauss_elim",Pgeneric_gauss_elim,1}, |
{"generic_gauss_elim_mod",Pgeneric_gauss_elim_mod,2}, |
{"generic_gauss_elim_mod",Pgeneric_gauss_elim_mod,2}, |
|
{"indep_rows_mod",Pindep_rows_mod,2}, |
{"newvect",Pnewvect,-2}, |
{"newvect",Pnewvect,-2}, |
{"vect",Pvect,-99999999}, |
{"vect",Pvect,-99999999}, |
{"vector",Pnewvect,-2}, |
{"vector",Pnewvect,-2}, |
Line 148 struct ftab array_tab[] = { |
|
Line 151 struct ftab array_tab[] = { |
|
{"mat_col",Pmat_col,2}, |
{"mat_col",Pmat_col,2}, |
{"lusolve_prep",Plusolve_prep,1}, |
{"lusolve_prep",Plusolve_prep,1}, |
{"lusolve_main",Plusolve_main,1}, |
{"lusolve_main",Plusolve_main,1}, |
|
{"triangleq",Ptriangleq,1}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
Line 1172 void Pgeneric_gauss_elim(NODE arg,LIST *rp) |
|
Line 1176 void Pgeneric_gauss_elim(NODE arg,LIST *rp) |
|
MKLIST(*rp,n0); |
MKLIST(*rp,n0); |
} |
} |
|
|
|
void Pindep_rows_mod(NODE arg,VECT *rp) |
|
{ |
|
MAT m,mat; |
|
VECT rind; |
|
Q **tmat; |
|
int **wmat,**row0; |
|
Q *rib; |
|
int *rowstat,*p; |
|
Q q; |
|
int md,i,j,k,l,row,col,t,rank; |
|
|
|
asir_assert(ARG0(arg),O_MAT,"indep_rows_mod"); |
|
asir_assert(ARG1(arg),O_N,"indep_rows_mod"); |
|
m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg)); |
|
row = m->row; col = m->col; tmat = (Q **)m->body; |
|
wmat = (int **)almat(row,col); |
|
|
|
row0 = (int **)ALLOCA(row*sizeof(int *)); |
|
for ( i = 0; i < row; i++ ) row0[i] = wmat[i]; |
|
|
|
rowstat = (int *)MALLOC_ATOMIC(row*sizeof(int)); |
|
for ( i = 0; i < row; i++ ) |
|
for ( j = 0; j < col; j++ ) |
|
if ( q = (Q)tmat[i][j] ) { |
|
t = rem(NM(q),md); |
|
if ( t && SGN(q) < 0 ) |
|
t = (md - t) % md; |
|
wmat[i][j] = t; |
|
} else |
|
wmat[i][j] = 0; |
|
rank = indep_rows_mod(wmat,row,col,md,rowstat); |
|
|
|
MKVECT(rind,rank); |
|
rib = (Q *)rind->body; |
|
for ( j = 0; j < rank; j++ ) { |
|
STOQ(rowstat[j],rib[j]); |
|
} |
|
*rp = rind; |
|
} |
|
|
/* |
/* |
input : a row x col matrix A |
input : a row x col matrix A |
A[I] <-> A[I][0]*x_0+A[I][1]*x_1+... |
A[I] <-> A[I][0]*x_0+A[I][1]*x_1+... |
Line 2316 void red_by_vect_sf(int m,unsigned int *p,unsigned int |
|
Line 2360 void red_by_vect_sf(int m,unsigned int *p,unsigned int |
|
*p = _addsf(_mulsf(*r,hc),*p); |
*p = _addsf(_mulsf(*r,hc),*p); |
} |
} |
|
|
|
extern GZ current_mod_lf; |
|
extern int current_mod_lf_size; |
|
|
|
void red_by_vect_lf(mpz_t *p,mpz_t *r,mpz_t hc,int len) |
|
{ |
|
mpz_set_ui(*p++,0); r++; len--; |
|
for ( ; len; len--, r++, p++ ) { |
|
mpz_addmul(*p,*r,hc); |
|
#if 0 |
|
if ( mpz_size(*p) > current_mod_lf_size ) |
|
mpz_mod(*p,*p,BDY(current_mod_lf)); |
|
#endif |
|
} |
|
} |
|
|
|
|
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 2464 int generic_gauss_elim_mod2(int **mat0,int row,int col |
|
Line 2524 int generic_gauss_elim_mod2(int **mat0,int row,int col |
|
return rank; |
return rank; |
} |
} |
|
|
|
int indep_rows_mod(int **mat0,int row,int col,int md,int *rowstat) |
|
{ |
|
int i,j,k,l,inv,a,rank; |
|
unsigned int *t,*pivot,*pk; |
|
unsigned int **mat; |
|
|
|
for ( i = 0; i < row; i++ ) rowstat[i] = i; |
|
mat = (unsigned int **)mat0; |
|
for ( rank = 0, j = 0; j < col; j++ ) { |
|
for ( i = rank; i < row; i++ ) |
|
mat[i][j] %= md; |
|
for ( i = rank; i < row; i++ ) |
|
if ( mat[i][j] ) |
|
break; |
|
if ( i == row ) continue; |
|
if ( i != rank ) { |
|
t = mat[i]; mat[i] = mat[rank]; mat[rank] = t; |
|
k = rowstat[i]; rowstat[i] = rowstat[rank]; rowstat[rank] = k; |
|
} |
|
pivot = mat[rank]; |
|
inv = invm(pivot[j],md); |
|
for ( k = j, pk = pivot+k; k < col; k++, pk++ ) |
|
if ( *pk ) { |
|
if ( *pk >= (unsigned int)md ) |
|
*pk %= md; |
|
DMAR(*pk,inv,0,md,*pk) |
|
} |
|
for ( i = rank+1; i < row; i++ ) { |
|
t = mat[i]; |
|
if ( a = t[j] ) |
|
red_by_vect(md,t+j,pivot+j,md-a,col-j); |
|
} |
|
rank++; |
|
} |
|
return rank; |
|
} |
|
|
int generic_gauss_elim_sf(int **mat0,int row,int col,int md,int *colstat) |
int generic_gauss_elim_sf(int **mat0,int row,int col,int md,int *colstat) |
{ |
{ |
int i,j,k,l,inv,a,rank; |
int i,j,k,l,inv,a,rank; |
Line 3750 void Pmat_col(NODE arg,VECT *rp) |
|
Line 3847 void Pmat_col(NODE arg,VECT *rp) |
|
BDY(vect)[i] = BDY(mat)[i][j]; |
BDY(vect)[i] = BDY(mat)[i][j]; |
} |
} |
*rp = vect; |
*rp = vect; |
|
} |
|
|
|
NODE triangleq(NODE e) |
|
{ |
|
int n,i,k; |
|
V v; |
|
VL vl; |
|
P *p; |
|
NODE r,r1; |
|
|
|
n = length(e); |
|
p = (P *)MALLOC(n*sizeof(P)); |
|
for ( i = 0; i < n; i++, e = NEXT(e) ) p[i] = (P)BDY(e); |
|
i = 0; |
|
while ( 1 ) { |
|
for ( ; i < n && !p[i]; i++ ); |
|
if ( i == n ) break; |
|
if ( OID(p[i]) == O_N ) return 0; |
|
v = p[i]->v; |
|
for ( k = i+1; k < n; k++ ) |
|
if ( p[k] ) { |
|
if ( OID(p[k]) == O_N ) return 0; |
|
if ( p[k]->v == v ) p[k] = 0; |
|
} |
|
i++; |
|
} |
|
for ( r = 0, i = 0; i < n; i++ ) { |
|
if ( p[i] ) { |
|
MKNODE(r1,p[i],r); r = r1; |
|
} |
|
} |
|
return r; |
|
} |
|
|
|
void Ptriangleq(NODE arg,LIST *rp) |
|
{ |
|
NODE ret; |
|
|
|
asir_assert(ARG0(arg),O_LIST,"sparseleq"); |
|
ret = triangleq(BDY((LIST)ARG0(arg))); |
|
MKLIST(*rp,ret); |
} |
} |