/* Perform an in-situ LU decomposition of a user's matrix.
* Return the pivot descriptor.
*/
decNumber *matrix_lu_decomp(decNumber *r, const decNumber *m) {
unsigned char pivots[MAX_SQUARE];
int i, sign, n;
decNumber t, u;
decimal128 mat[MAX_SQUARE*MAX_SQUARE];
decimal64 *base;
n = matrix_lu_check(m, mat, &base);
if (n == 0)
return NULL;
sign = LU_decomposition(mat, pivots, n);
if (sign == 0) {
err(ERR_SINGULAR);
return NULL;
}
/* Build the pivot number */
decNumberZero(r);
for (i=0; i<n; i++) {
int_to_dn(&t, pivots[i]);
dn_mulpow10(&u, r, 1);
dn_add(r, &u, &t);
}
/* Copy the result back over the matrix */
for (i=0; i<n*n; i++) {
packed_from_packed128(base+i, mat+i);
}
return r;
}
/* Invert a matrix in situ.
* Do this by calculating the LU decomposition and solving lots of systems
* of linear equations.
*/
void matrix_inverse(enum nilop op) {
decimal128 mat[MAX_SQUARE*MAX_SQUARE];
decNumber x[MAX_SQUARE];
unsigned char pivots[MAX_SQUARE];
int i, j, n;
decimal64 *base;
const decimal64 *b[MAX_SQUARE];
getX(x);
n = matrix_lu_check(x, mat, &base);
if (n == 0)
return;
i = LU_decomposition(mat, pivots, n);
if (i == 0) {
err(ERR_SINGULAR);
return;
}
for (i=0; i<n; i++) {
for (j=0; j<n; j++)
b[j] = (i==j) ? (decimal64 *) get_const(OP_ONE, 0) : (decimal64 *) get_const(OP_ZERO, 0);
matrix_pivoting_solve(mat, b, pivots, x, n);
for (j=0; j<n; j++)
packed_from_number(base + matrix_idx(j, i, n), x+j);
}
}
/*************************************************************************
Subroutine to multiply the inverse of a square matrix and
by another matrix without computing the inverse
*************************************************************************/
void inverse_matrix_multiply (int nrows1, float **matrix1, int ncols2,
int nrows2, float **matrix2, float **out_matrix)
/*************************************************************************
Input Parameters:
nrows1 number of rows (and columns) of matrix to invert
matrix1 square matrix to invert
ncols2 number of coulmns of second matrix
nrows2 number of rows of second matrix
matrix second matrix (multiplicator)
Output Parameters:
out_matrix matrix containing the product of the inverse of the first
matrix by the second one.
Note:
matrix1 and matrix2 are not destroyed (not clobbered)
*************************************************************************
Credits:
Adapted from discussions in Numerical Recipes in C by Gabriel Alvarez (1995)
*************************************************************************/
{
int i,j; /* loop counters for rows and coulmns */
float d; /* to use in LU decomposition */
int *idx; /* to record permutations by partial pivoting*/
float **scratch1; /* array to hold input matrix1 */
float *scratch2; /* vector to hold column of input matrix2 */
/* allocate working space */
idx = alloc1int(nrows1);
scratch1 = alloc2float(nrows1,nrows1);
scratch2 = alloc1float(nrows2);
/* copy input matrix1 to scratch to avoid clobbering */
for (i=0; i<nrows1; i++)
for (j=0; j<nrows1; j++)
scratch1[i][j]=matrix1[i][j];
/* do the LU decomposition */
LU_decomposition (nrows1, scratch1, idx, &d);
/* find inverse by columns */
for (j=0; j<ncols2; j++) {
/* copy column of second input matrix to scratch vector */
for (i=0; i<nrows2; i++) scratch2[i]=matrix2[i][j];
/* do backward substitution */
backward_substitution (nrows1, scratch1, idx, scratch2);
/* copy results to output matrix */
for (i=0; i<nrows1; i++) out_matrix[i][j] = scratch2[i];
}
/* free allocated space */
free2float(scratch1);
free1float(scratch2);
}
/************************************************************************
Subroutine to invert a square non-singular matrix via LU
decomposition. The original matrix is clobbered with the inverse
************************************************************************/
void inverse_matrix (int nrows, float **matrix)
/************************************************************************
Input:
nrows number of rows (and columns) in matrix to invert
matrix square, non-singular matrix to invert
Output:
matrix inverted matrix
************************************************************************
Credits:
Adapted from discussions in Numerical Recipes by Gabriel Alvarez (1995)
************************************************************************/
{
int i,j; /* loop counters */
float d; /* +/-1 depending on row interchanges even/odd*/
int *idx; /* vector of row permutations */
float *column; /* unit vector for backward substitution*/
float **inverse; /* array to hold the inverse matrix */
/* allocate working space */
idx = alloc1int(nrows);
column = alloc1float(nrows);
inverse = alloc2float(nrows,nrows);
/* first, do the LU decomposition of input matrix */
LU_decomposition (nrows, matrix, idx, &d);
/* find inverse by columns */
for (j=0; j<nrows; j++) {
/* unit vector corresponding to current column */
for (i=0; i<nrows; i++) column[i]=0.0;
column[j]=1.0;
/* backward substitution column by column */
backward_substitution (nrows, matrix, idx, column);
/* compute inverse matrix column by column */
for (i=0; i<nrows; i++)
inverse[i][j]=column[i];
}
/* clobber original matrix with its inverse */
for (i=0; i<nrows; i++)
for (j=0; j<nrows; j++)
matrix[i][j]=inverse[i][j];
/* free allocated space */
free1int(idx);
free1float(column);
free2float(inverse);
}
/* Calculate the determinant of a matrix by performing the LU decomposition
* and multiplying the diagonal elements of the upper triangular portion.
* Also adjust for the parity of the number of pivots.
*/
decNumber *matrix_determinant(decNumber *r, const decNumber *m) {
int n, i;
decimal128 mat[MAX_SQUARE*MAX_SQUARE];
decNumber t;
n = matrix_lu_check(m, mat, NULL);
if (n == 0)
return NULL;
i = LU_decomposition(mat, NULL, n);
int_to_dn(r, i);
for (i=0; i<n; i++) {
matrix_get128(&t, mat, i, i, n);
dn_multiply(r, r, &t);
}
return r;
}
/* Solve a system of linear equations Ac = b
*/
decNumber *matrix_linear_eqn(decNumber *r, const decNumber *a, const decNumber *b, const decNumber *c) {
int n, i, brows, bcols, creg;
decimal128 mat[MAX_SQUARE*MAX_SQUARE];
decimal64 *bbase, *cbase;
decNumber cv[MAX_SQUARE];
unsigned char pivots[MAX_SQUARE];
const decimal64 *bv[MAX_SQUARE];
n = matrix_lu_check(a, mat, NULL);
if (n == 0)
return NULL;
bbase = matrix_decomp(b, &brows, &bcols);
if (bbase == NULL)
return NULL;
if (brows != n || bcols != 1) {
err(ERR_MATRIX_DIM);
return NULL;
}
creg = dn_to_int(c);
if (matrix_descriptor(r, creg, n, 1) == 0)
return NULL;
cbase = &(get_reg_n(creg)->s);
/* Everything is happy so far -- decompose */
i = LU_decomposition(mat, pivots, n);
if (i == 0) {
err(ERR_SINGULAR);
return NULL;
}
/* And solve */
for (i=0; i<n; i++)
bv[i] = bbase + i;
matrix_pivoting_solve(mat, bv, pivots, cv, n);
for (i=0; i<n; i++)
packed_from_number(cbase+i, cv+i);
return r;
}
