===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/array.c,v
retrieving revision 1.24
retrieving revision 1.26
diff -u -p -r1.24 -r1.26
--- OpenXM_contrib2/asir2000/builtin/array.c	2001/10/09 01:36:05	1.24
+++ OpenXM_contrib2/asir2000/builtin/array.c	2002/02/06 00:55:03	1.26
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.23 2001/10/01 01:58:01 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.25 2001/12/20 08:18:26 noro Exp $
 */
 #include "ca.h"
 #include "base.h"
@@ -64,6 +64,7 @@ void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(
 void Pinvmat();
 void Pnewbytearray();
 
+void Pgeneric_gauss_elim();
 void Pgeneric_gauss_elim_mod();
 
 void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat();
@@ -80,11 +81,14 @@ void Pirredpoly_up2();
 void Pnbpoly_up2();
 void Pqsort();
 void Pexponent_vector();
+void Pmat_swap_row_destructive();
+void Pmat_swap_col_destructive();
 
 struct ftab array_tab[] = {
 	{"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4},
 	{"lu_gfmmat",Plu_gfmmat,2},
 	{"mat_to_gfmmat",Pmat_to_gfmmat,2},
+	{"generic_gauss_elim",Pgeneric_gauss_elim,1},
 	{"generic_gauss_elim_mod",Pgeneric_gauss_elim_mod,2},
 	{"newvect",Pnewvect,-2},
 	{"vector",Pnewvect,-2},
@@ -113,6 +117,8 @@ struct ftab array_tab[] = {
 	{"x962_irredpoly_up2",Px962_irredpoly_up2,2},
 	{"irredpoly_up2",Pirredpoly_up2,2},
 	{"nbpoly_up2",Pnbpoly_up2,2},
+	{"mat_swap_row_destructive",Pmat_swap_row_destructive,3},
+	{"mat_swap_col_destructive",Pmat_swap_col_destructive,3},
 	{0,0,0},
 };
 
@@ -635,6 +641,45 @@ void Pinvmat(NODE arg,LIST *rp)
 		B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
 */
 
+void Pgeneric_gauss_elim(NODE arg,LIST *rp)
+{
+	NODE n0;
+	MAT m,nm;
+	int *ri,*ci;
+	VECT rind,cind;
+	Q dn,q;
+	int i,j,k,l,row,col,t,rank;
+
+	asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim");
+	m = (MAT)ARG0(arg);
+	row = m->row; col = m->col;
+	rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
+	t = col-rank;
+	MKVECT(rind,rank);
+	MKVECT(cind,t);
+	for ( i = 0; i < rank; i++ ) {
+		STOQ(ri[i],q);
+		BDY(rind)[i] = (pointer)q;
+	}
+	for ( i = 0; i < t; i++ ) {
+		STOQ(ci[i],q);
+		BDY(cind)[i] = (pointer)q;
+	}
+	n0 = mknode(4,nm,dn,rind,cind);
+	MKLIST(*rp,n0);
+}
+
+/*
+	input : a row x col matrix A
+		A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...
+
+	output : [B,R,C]
+		B : a rank(A) x col-rank(A) matrix
+		R : a vector of length rank(A)
+		C : a vector of length col-rank(A)
+		B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
+*/
+
 void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
 {
 	NODE n0;
@@ -2185,6 +2230,48 @@ void Pirredpoly_up2(NODE arg,GF2N *rp)
 		*rp = 0;
 }
 
+void Pmat_swap_row_destructive(NODE arg, MAT *m)
+{
+	int i1,i2;
+	pointer *t;
+	MAT mat;
+
+	asir_assert(ARG0(arg),O_MAT,"mat_swap_row_destructive");
+	asir_assert(ARG1(arg),O_N,"mat_swap_row_destructive");
+	asir_assert(ARG2(arg),O_N,"mat_swap_row_destructive");
+	mat = (MAT)ARG0(arg);
+	i1 = QTOS((Q)ARG1(arg));
+	i2 = QTOS((Q)ARG2(arg));
+	if ( i1 < 0 || i2 < 0 || i1 >= mat->row || i2 >= mat->row )
+		error("mat_swap_row_destructive : Out of range");
+	t = mat->body[i1];
+	mat->body[i1] = mat->body[i2];
+	mat->body[i2] = t;
+	*m = mat;
+}
+
+void Pmat_swap_col_destructive(NODE arg, MAT *m)
+{
+	int j1,j2,i,n;
+	pointer *mi;
+	pointer t;
+	MAT mat;
+
+	asir_assert(ARG0(arg),O_MAT,"mat_swap_col_destructive");
+	asir_assert(ARG1(arg),O_N,"mat_swap_col_destructive");
+	asir_assert(ARG2(arg),O_N,"mat_swap_col_destructive");
+	mat = (MAT)ARG0(arg);
+	j1 = QTOS((Q)ARG1(arg));
+	j2 = QTOS((Q)ARG2(arg));
+	if ( j1 < 0 || j2 < 0 || j1 >= mat->col || j2 >= mat->col )
+		error("mat_swap_col_destructive : Out of range");
+	n = mat->row;
+	for ( i = 0; i < n; i++ ) {
+		mi = mat->body[i];
+		t = mi[j1]; mi[j1] = mi[j2]; mi[j2] = t;
+	}
+	*m = mat;
+}
 /*
  * f = type 'type' normal polynomial of degree m if exists
  * IEEE P1363 A.7.2