GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include "typedef.h"1#include "matrix.h"2#include "tools.h"34/**************************************************************************\5@---------------------------------------------------------------------------6@---------------------------------------------------------------------------7@ FILE: gauss_mat.c8@---------------------------------------------------------------------------9@---------------------------------------------------------------------------10@11\**************************************************************************/1213/*{{{}}}*/14/*{{{ tgauss*/15/*16@-------------------------------------------------------------------17@ int tgauss(mat)18@19@ Integral Gauss-algorithm where the matrix itself is changed20@ The Return-value is the rank of the matrix. The matrix is not21@ shrinked to its rank-size.22@-------------------------------------------------------------------23*/2425int tgauss(mat)26matrix_TYP *mat;27{28int i,j,k,l;29int *nzero;30int **Z, *r, flag,ww, waste;31int rg, rows, cols, tmp, actrow;3233/* put_mat(mat,NULL,NULL,0); */34flag = waste = 0;35rows = mat->rows;36cols = mat->cols;37Z = mat->array.SZ;38mat->flags.Symmetric =39mat->flags.Diagonal = FALSE;40nzero = (int *)malloc((cols+1)*sizeof(int));41/*COUNTER++;*/42actrow = 0;43for (i = 0; i < cols; i++) {44rg = 0;45do {46/* put_mat(mat,NULL,NULL,0); */47/*48* Find the minimum of the non-zero entries of the i-th col49*/50flag = 0;51tmp = actrow;52ww = ((actrow < rows) && (Z[actrow][i] != 0)) ? Z[actrow][i] : 0;53for (j = actrow+1; j < rows; j++) {54if (Z[j][i] != 0) {55flag = 1;56if(ww != 0) {57if ( abs(Z[j][i]) < abs(ww)) {58ww = Z[j][i];59tmp = j;60}61} else {62ww = Z[j][i];63tmp = j;64}65}66}67/*===========================================================*\68|| Swap the tmp-row into the actrow-th rows and clear the ||69|| i-th column downwards. ||70\*===========================================================*/71if (ww != 0) rg = 1;72if (flag) {73if (tmp != actrow) {74r = Z[actrow]; Z[actrow] = Z[tmp]; Z[tmp] = r;75}76k = 0;77waste = 0;78for(j = i; j < cols; j++) {79if (Z[actrow][j] != 0) {80nzero[k++] = j;81}82}83nzero[k] = -1;84for(tmp = actrow+1; tmp < rows; tmp++)85if(Z[tmp][i] != 0) {86k = 0;87waste= min_div(Z[tmp][i], Z[actrow][i]);88/* printf("mindiv: %d\n",waste); */89while(nzero[k] >= 0) {90Z[tmp][nzero[k]] -= waste * Z[actrow][nzero[k]];91k++;92}93}94}95/*96* repeat the steps until every entry down from the i-th row97* is zero.98*/99} while(flag);100actrow += rg;101}102103/*104* determine the rank of the matrix105*/106for(i = 0; i < cols; i++) {107nzero[i] = 0;108}109i = rows-1;110tmp = 4*cols;111while((i >= 0) && (memcmp(Z[i],nzero,tmp) == 0)) {112i--;113}114i++;115rows = i;116117/*===========================================================*\118|| 03.02.92: Try to minimize the entries of the upper right ||119|| triangular matrix by doing the subtraction upwards ||120\*===========================================================*/121122memset(nzero,0,cols*sizeof(int));123for( i = 1; i < rows; i++) {124tmp = 0;125k = 0;126while(Z[i][tmp] == 0) {127tmp++;128}129for (j = tmp; j < cols; j++) {130if(Z[i][j] != 0 ) {131nzero[k++] = j;132}133}134for(j = i-1; j >= 0; j--) {135waste= min_div(Z[j][tmp],Z[i][tmp]);136if (waste != 0) {137for (l = 0; l <k; l++) {138Z[j][nzero[l]] -= waste * Z[i][nzero[l]];139}140/*put_mat(mat,NULL,NULL,0); */141}142}143}144free(nzero);145return(rows);146}147148149150151152/**************************************************************************\153@---------------------------------------------------------------------------154@ int row_gauss(M)155@ matrix_TYP *M;156@157@ integral gauss applied to the rows of M,158$ return is the rank of the matrix.159@ M is changed!160@---------------------------------------------------------------------------161@162\**************************************************************************/163int row_gauss(M)164matrix_TYP *M;165{166int i,j;167int step;168int a1,a2,gcd;169int tester, *v;170int spos = 0;171int x,y;172173for(step = 0; step < M->rows; step++)174{175tester = FALSE;176while(tester == FALSE)177{178i = step;179while(i<M->rows && M->array.SZ[i][spos] == 0)180i++;181if(i<M->rows)182{183tester = TRUE;184if(i != step)185{186v = M->array.SZ[i];187M->array.SZ[i] = M->array.SZ[step];188M->array.SZ[step] = v;189}190}191else192spos++;193if(spos == M->cols)194return(step);195}196for(i=step+1;i<M->rows;i++)197{198if(M->array.SZ[i][spos] != 0)199{200gcd_darstell(M->array.SZ[step][spos], M->array.SZ[i][spos], &a1, &a2, &gcd);201if(a1 == 0)202{203v = M->array.SZ[step];204M->array.SZ[step] = M->array.SZ[i];205M->array.SZ[i] = v;206j = a1; a1 = a2; a2 = j;207}208M->array.SZ[step][spos] /= gcd;209M->array.SZ[i][spos] /= gcd;210for(j=spos + 1; j<M->cols; j++)211{212x = M->array.SZ[step][j];213y = M->array.SZ[i][j];214M->array.SZ[step][j] = a1 * x + a2 * y;215M->array.SZ[i][j] = M->array.SZ[step][spos] * y - M->array.SZ[i][spos] * x;216}217M->array.SZ[step][spos] = gcd;218M->array.SZ[i][spos] = 0;219}220}221}222return(M->rows);223}224225/*}}} */226/*{{{ ggauss*/227/*228@-------------------------------------------------------------------229@ matrix_TYP *ggauss(mat)230@ matrix_TYP *mat;231@232@ Integral Gauss-algorithm where a copy of mat is changed233@ and the number of rows is shrinked to the rank of the matrix.234@-------------------------------------------------------------------235*/236matrix_TYP *ggauss(mat)237matrix_TYP *mat;238{239matrix_TYP *elt;240int rank;241242elt = copy_mat( mat );243/******************244rank = tgauss( elt );245******************/246rank = row_gauss( elt );247if(rank != elt->rows) {248real_mat( elt, rank, elt->cols);249}250return( elt );251}252253/*}}} */254255256