version 1.27, 2003/01/06 01:16:37 |
version 1.31, 2003/07/01 08:12:37 |
|
|
* 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.26 2002/02/06 00:55:03 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.30 2003/06/10 16:54:13 saito Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "base.h" |
#include "base.h" |
|
|
void Pexponent_vector(); |
void Pexponent_vector(); |
void Pmat_swap_row_destructive(); |
void Pmat_swap_row_destructive(); |
void Pmat_swap_col_destructive(); |
void Pmat_swap_col_destructive(); |
|
void Pvect(); |
|
void Pmat(); |
|
void Pmatc(); |
|
|
struct ftab array_tab[] = { |
struct ftab array_tab[] = { |
{"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4}, |
{"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4}, |
Line 92 struct ftab array_tab[] = { |
|
Line 95 struct ftab array_tab[] = { |
|
{"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}, |
{"newvect",Pnewvect,-2}, |
{"newvect",Pnewvect,-2}, |
|
{"vect",Pvect,-99999999}, |
{"vector",Pnewvect,-2}, |
{"vector",Pnewvect,-2}, |
{"exponent_vector",Pexponent_vector,-99999999}, |
{"exponent_vector",Pexponent_vector,-99999999}, |
{"newmat",Pnewmat,-3}, |
{"newmat",Pnewmat,-3}, |
{"matrix",Pnewmat,-3}, |
{"matrix",Pnewmat,-3}, |
|
{"mat",Pmat,-99999999}, |
|
{"matr",Pmat,-99999999}, |
|
{"matc",Pmatc,-99999999}, |
{"newbytearray",Pnewbytearray,-2}, |
{"newbytearray",Pnewbytearray,-2}, |
{"sepmat_destructive",Psepmat_destructive,2}, |
{"sepmat_destructive",Psepmat_destructive,2}, |
{"sepvect",Psepvect,2}, |
{"sepvect",Psepvect,2}, |
Line 355 void Pnewvect(NODE arg,VECT *rp) |
|
Line 362 void Pnewvect(NODE arg,VECT *rp) |
|
*rp = vect; |
*rp = vect; |
} |
} |
|
|
|
void Pvect(NODE arg,VECT *rp) { |
|
int len,i,r; |
|
VECT vect; |
|
pointer *vb; |
|
NODE tn; |
|
|
|
if ( !arg ) { |
|
*rp =0; |
|
return; |
|
} |
|
|
|
for (len = 0, tn = arg; tn; tn = NEXT(tn), len++); |
|
if ( len == 1 ) { |
|
if ( ARG0(arg) != 0 ) { |
|
switch ( OID(ARG0(arg)) ) { |
|
case O_VECT: |
|
*rp = ARG0(arg); |
|
return; |
|
case O_LIST: |
|
for ( len = 0, tn = ARG0(arg); tn; tn = NEXT(tn), len++ ); |
|
MKVECT(vect,len-1); |
|
for ( i = 0, tn = BDY((LIST)ARG0(arg)), vb =BDY(vect); |
|
tn; i++, tn = NEXT(tn) ) |
|
vb[i] = (pointer)BDY(tn); |
|
*rp=vect; |
|
return; |
|
} |
|
} |
|
} |
|
MKVECT(vect,len); |
|
for ( i = 0, tn = arg, vb = BDY(vect); tn; i++, tn = NEXT(tn) ) |
|
vb[i] = (pointer)BDY(tn); |
|
*rp = vect; |
|
} |
|
|
void Pexponent_vector(NODE arg,DP *rp) |
void Pexponent_vector(NODE arg,DP *rp) |
{ |
{ |
nodetod(arg,rp); |
nodetod(arg,rp); |
Line 437 void Pnewmat(NODE arg,MAT *rp) |
|
Line 479 void Pnewmat(NODE arg,MAT *rp) |
|
*rp = m; |
*rp = m; |
} |
} |
|
|
|
void Pmat(NODE arg, MAT *rp) |
|
{ |
|
int row,col; |
|
int i; |
|
MAT m; |
|
pointer **mb; |
|
pointer *ent; |
|
NODE tn, sn; |
|
VECT v; |
|
|
|
if ( !arg ) { |
|
*rp =0; |
|
return; |
|
} |
|
|
|
for (row = 0, tn = arg; tn; tn = NEXT(tn), row++); |
|
if ( row == 1 ) { |
|
if ( OID(ARG0(arg)) == O_MAT ) { |
|
*rp=ARG0(arg); |
|
return; |
|
} else if ( !(OID(ARG0(arg)) == O_LIST || OID(ARG0(arg)) == O_VECT)) { |
|
error("mat : invalid argument"); |
|
} |
|
} |
|
if ( OID(ARG0(arg)) == O_VECT ) { |
|
v = ARG0(arg); |
|
col = v->len; |
|
} else if ( OID(ARG0(arg)) == O_LIST ) { |
|
for (col = 0, tn = BDY((LIST)ARG0(arg)); tn ; tn = NEXT(tn), col++); |
|
} else { |
|
error("mat : invalid argument"); |
|
} |
|
|
|
MKMAT(m,row,col); |
|
for (row = 0, tn = arg, mb = BDY(m); tn; tn = NEXT(tn), row++) { |
|
if ( BDY(tn) == 0 ) { |
|
error("mat : invalid argument"); |
|
} else if ( OID(BDY(tn)) == O_VECT ) { |
|
v = tn->body; |
|
ent = BDY(v); |
|
for (i = 0; i < v->len; i++ ) mb[row][i] = (Obj)ent[i]; |
|
} else if ( OID(BDY(tn)) == O_LIST ) { |
|
for (col = 0, sn = BDY((LIST)BDY(tn)); sn; col++, sn = NEXT(sn) ) |
|
mb[row][col] = (pointer)BDY(sn); |
|
} else { |
|
error("mat : invalid argument"); |
|
} |
|
} |
|
*rp = m; |
|
} |
|
|
|
void Pmatc(NODE arg, MAT *rp) |
|
{ |
|
int row,col; |
|
int i; |
|
MAT m; |
|
pointer **mb; |
|
pointer *ent; |
|
NODE tn, sn; |
|
VECT v; |
|
|
|
if ( !arg ) { |
|
*rp =0; |
|
return; |
|
} |
|
|
|
for (col = 0, tn = arg; tn; tn = NEXT(tn), col++); |
|
if ( col == 1 ) { |
|
if ( OID(ARG0(arg)) == O_MAT ) { |
|
*rp=ARG0(arg); |
|
return; |
|
} else if ( !(OID(ARG0(arg)) == O_LIST || OID(ARG0(arg)) == O_VECT)) { |
|
error("matc : invalid argument"); |
|
} |
|
} |
|
if ( OID(ARG0(arg)) == O_VECT ) { |
|
v = ARG0(arg); |
|
row = v->len; |
|
} else if ( OID(ARG0(arg)) == O_LIST ) { |
|
for (row = 0, tn = BDY((LIST)ARG0(arg)); tn ; tn = NEXT(tn), row++); |
|
} else { |
|
error("matc : invalid argument"); |
|
} |
|
|
|
MKMAT(m,row,col); |
|
for (col = 0, tn = arg, mb = BDY(m); tn; tn = NEXT(tn), col++) { |
|
if ( BDY(tn) == 0 ) { |
|
error("matc : invalid argument"); |
|
} else if ( OID(BDY(tn)) == O_VECT ) { |
|
v = tn->body; |
|
ent = BDY(v); |
|
for (i = 0; i < v->len; i++ ) mb[i][col] = (Obj)ent[i]; |
|
} else if ( OID(BDY(tn)) == O_LIST ) { |
|
for (row = 0, sn = BDY((LIST)BDY(tn)); sn; row++, sn = NEXT(sn) ) |
|
mb[row][col] = (pointer)BDY(sn); |
|
} else { |
|
error("matc : invalid argument"); |
|
} |
|
} |
|
*rp = m; |
|
} |
|
|
void Pvtol(NODE arg,LIST *rp) |
void Pvtol(NODE arg,LIST *rp) |
{ |
{ |
NODE n,n1; |
NODE n,n1; |
Line 809 int gauss_elim_mod(int **mat,int row,int col,int md) |
|
Line 953 int gauss_elim_mod(int **mat,int row,int col,int md) |
|
} |
} |
|
|
struct oEGT eg_mod,eg_elim,eg_elim1,eg_elim2,eg_chrem,eg_gschk,eg_intrat,eg_symb; |
struct oEGT eg_mod,eg_elim,eg_elim1,eg_elim2,eg_chrem,eg_gschk,eg_intrat,eg_symb; |
|
struct oEGT eg_conv; |
|
|
int generic_gauss_elim(MAT mat,MAT *nm,Q *dn,int **rindp,int **cindp) |
int generic_gauss_elim(MAT mat,MAT *nm,Q *dn,int **rindp,int **cindp) |
{ |
{ |