void
matrix_ADJUST(Matrix *xx, index_t kk)
{
// A function needed to sweep a matrix. See Goodnight,
// 33(3) Am. Stat. 149 (1979) for complete explanation.
// Function performs ADJUST(kk) on matrix xx.
index_t ii, jj;
double aa, aa_kk, aa_ik;
index_t nrow_xx = numrows(xx);
index_t ncol_xx = numcols(xx);
// Adjust row kk.
aa_kk = matrix_get_element(xx, kk, kk);
for (jj=(kk+1); jj<ncol_xx; jj++){
aa = matrix_get_element(xx, kk, jj);
matrix_set_element(xx, kk, jj, aa/aa_kk);
}
matrix_set_element(xx, kk, kk, 1.0);
// Adjust rows != kk.
for (ii=0; ii<nrow_xx; ii++){
if (ii == kk)
continue;
aa_ik = matrix_get_element(xx, ii, kk);
matrix_set_element(xx, ii, kk, 0.0);
for (jj=(kk+1); jj<ncol_xx; jj++){
aa = matrix_get_element(xx, ii, jj);
matrix_set_element(xx, ii, jj, aa-(aa_ik * matrix_get_element(xx, kk, jj)));
}
}
}
void
matrix_subtract(Matrix *xx, Matrix *yy, Matrix *zz)
{
// In R notation, implements zz <- xx - yy
index_t ii, jj, nrow_xx = numrows(xx), ncol_xx = numcols(xx);
for (ii=0; ii<nrow_xx; ii++)
for (jj=0; jj<ncol_xx; jj++)
matrix_set_element(zz, ii, jj, matrix_get_element(xx, ii, jj) - matrix_get_element(yy, ii, jj));
return;
}
double matrix_quadform(Matrix *x, Matrix *A, Matrix *y)
{
// Computes x^{T}Ay
index_t i,j, nrowy=numrows(y), nrowx=numrows(x);
double ret=0.0;
if ((nrowy!=numcols(A)) || (nrowx!=numrows(A)))
error("Incompatible dims in matrix_quadform()");
for (i=0; i<nrowx; i++)
for (j=0; j<nrowy; j++)
ret += (matrix_get_element(x,i,0)*matrix_get_element(A,i,j)*matrix_get_element(y,j,0));
return ret;
}
/* append matrices vertically: C = [A; B] */
void append_matrices_vertically(mat *A, mat *B, mat *C){
int i,j;
for(i=0; i<A->nrows; i++){
for(j=0; j<A->ncols; j++){
matrix_set_element(C,i,j,matrix_get_element(A,i,j));
}
}
for(i=0; i<B->nrows; i++){
for(j=0; j<B->ncols; j++){
matrix_set_element(C,A->nrows+i,j,matrix_get_element(B,i,j));
}
}
}
/* Performs [Q,R] = qr(M,'0') compact QR factorization
M is mxn ; Q is mxn ; R is min(m,n) x min(m,n) */
void compact_QR_factorization(mat *M, mat *Q, mat *R){
int i,j,m,n,k;
m = M->nrows; n = M->ncols;
k = min(m,n);
mat *R_full = matrix_new(m,n);
matrix_copy(R_full,M);
vec *tau = vector_new(m);
// get R
//LAPACKE_dgeqrf(CblasRowMajor, m, n, R_full->d, n, tau->d);
culaDgeqrf(m, n, R_full->d, m, tau->d);
for(i=0; i<k; i++){
for(j=0; j<k; j++){
if(j>=i){
matrix_set_element(R,i,j,matrix_get_element(R_full,i,j));
}
}
}
// get Q
matrix_copy(Q,R_full);
//LAPACKE_dorgqr(CblasRowMajor, m, n, n, Q->d, n, tau->d);
culaDorgqr(m, n, n, Q->d, m, tau->d);
// clean up
matrix_delete(R_full);
vector_delete(tau);
}
/* build transpose of matrix : Mt = M^T */
void matrix_build_transpose(mat *Mt, mat *M){
int i,j;
for(i=0; i<(M->nrows); i++){
for(j=0; j<(M->ncols); j++){
matrix_set_element(Mt,j,i,matrix_get_element(M,i,j));
}
}
}
/* copy contents of mat S to D */
void matrix_copy_first_columns_with_param(mat *D, mat *S, int num_columns){
int i,j;
for(i=0; i<(S->nrows); i++){
for(j=0; j<num_columns; j++){
matrix_set_element(D,i,j,matrix_get_element(S,i,j));
}
}
}
/* A = A - u*v where u is a column vec and v is a row vec */
void matrix_sub_column_times_row_vector(mat *A, vec *u, vec *v){
int i,j;
#pragma omp parallel for shared(A,u,v) private(j)
for(i=0; i<(A->nrows); i++){
for(j=0; j<(A->ncols); j++){
matrix_set_element(A,i,j,matrix_get_element(A,i,j) - vector_get_element(u,i)*vector_get_element(v,j));
}
}
}
/* M_out = M(:,k+1:end) */
void matrix_copy_all_rows_and_last_columns_from_indexk(mat *M_out, mat *M, int k){
int i,j,i_out,j_out;
for(i=0; i<(M->nrows); i++){
for(j=k; j<(M->ncols); j++){
i_out = i; j_out = j - k;
matrix_set_element(M_out,i_out,j_out,matrix_get_element(M,i,j));
}
}
}
/* copy the first k rows and columns of M into M_out is kxk where k = M_out->ncols (M_out pre-initialized)
M_out = M(1:k,1:k) */
void matrix_copy_first_k_rows_and_columns(mat *M_out, mat *M){
int i,j,k;
k = M_out->ncols;
for(i=0; i<k; i++){
for(j=0; j<k; j++){
matrix_set_element(M_out,i,j,matrix_get_element(M,i,j));
}
}
}
void
matrix_transpose_same(Matrix *xx)
{
// In R notation, xx<-t(xx), but ONLY FOR SQUARE xx.
// Second function written for speed.
double aa;
index_t ii, jj, nrow_xx = numrows(xx), ncol_xx = numcols(xx);
for (ii=0; ii<nrow_xx; ii++){
for (jj=(ii+1); jj<ncol_xx; jj++){
aa = matrix_get_element(xx, ii, jj);
matrix_set_element(xx, ii, jj, matrix_get_element(xx, jj, ii));
matrix_set_element(xx, jj, ii, aa);
}
}
return;
}
/* invert diagonal matrix */
void invert_diagonal_matrix(mat *Dinv, mat *D){
int i;
#pragma omp parallel shared(D,Dinv) private(i)
{
#pragma omp parallel for
for(i=0; i<(D->nrows); i++){
matrix_set_element(Dinv,i,i,1.0/(matrix_get_element(D,i,i)));
}
}
}
/* extract column of a matrix into a vector */
void matrix_get_col(mat *M, int j, vec *column_vec){
int i;
#pragma omp parallel shared(column_vec,M,j) private(i)
{
#pragma omp parallel for
for(i=0; i<M->nrows; i++){
vector_set_element(column_vec,i,matrix_get_element(M,i,j));
}
}
}
/* extract row i of a matrix into a vector */
void matrix_get_row(mat *M, int i, vec *row_vec){
int j;
#pragma omp parallel shared(row_vec,M,i) private(j)
{
#pragma omp parallel for
for(j=0; j<M->ncols; j++){
vector_set_element(row_vec,j,matrix_get_element(M,i,j));
}
}
}
void
matrix_cholesky(Matrix *xx, Matrix *yy)
{
// Sets yy equal to the cholesky decomp of xx. Note per the definition,
// the cholesky decomp is an upper triangular matrix.
index_t kk, jj;
double aa;
matrix_get_set_block(yy, 0, numrows(yy)-1, 0, numcols(yy)-1, xx, 0, numrows(xx)-1, 0, numcols(xx)-1);
for (kk=0; kk<(numrows(yy)-1); kk++){
matrix_DOOLITTLE(yy, kk);
aa = matrix_get_element(yy, kk, kk);
for (jj=kk; jj<numcols(yy); jj++){
matrix_set_element(yy, kk, jj, matrix_get_element(yy, kk, jj)/sqrt(aa));
}
}
matrix_set_element(yy, numcols(yy)-1, numcols(yy)-1,
sqrt(matrix_get_element(yy, numcols(yy)-1, numcols(yy)-1)));
}
/* Mout = M((k+1):end,(k+1):end) in matlab notation */
void fill_matrix_from_lower_right_corner(mat *M, int k, mat *M_out){
int i,j,i_out,j_out;
for(i=k; i<M->nrows; i++){
for(j=k; j<M->ncols; j++){
i_out = i-k;
j_out = j-k;
//printf("setting element %d, %d of M_out\n", i_out, j_out);
matrix_set_element(M_out,i_out,j_out,matrix_get_element(M,i,j));
}
}
}
void matrix_print(mat * M){
int i,j;
double val;
for(i=0; i<M->nrows; i++){
for(j=0; j<M->ncols; j++){
val = matrix_get_element(M, i, j);
printf("%f ", val);
}
printf("\n");
}
}
double get_matrix_column_norm_squared(mat *M, int colnum){
int i, m, n;
double val,colnorm;
m = M->nrows;
n = M->ncols;
colnorm = 0;
for(i=0; i<m; i++){
val = matrix_get_element(M,i,colnum);
colnorm += val*val;
}
return colnorm;
}
/* copy only upper triangular matrix part as for symmetric matrix */
void matrix_copy_symmetric(mat *S, mat *M){
int i,j,n,m;
m = M->nrows;
n = M->ncols;
for(i=0; i<m; i++){
for(j=0; j<n; j++){
if(j>=i){
matrix_set_element(S,i,j,matrix_get_element(M,i,j));
}
}
}
}
void
matrix_DOOLITTLE(Matrix *xx, index_t kk)
{
// A function needed to find the determinant and to
// find the cholesky decomposition of a matrix. See Goodnight,
// 33(3) Am. Stat. 149 (1979) for complete explanation.
// Function performs DOOLITTLE(kk) on matrix xx.
// Function will only work on a square matrix.
double aa_ij, aa_ik, aa_kk, aa_kj;
index_t ii, jj, nrow_xx = numrows(xx), ncol_xx = numcols(xx);
// Adjust rows below kk
aa_kk = matrix_get_element(xx, kk, kk);
for (ii=(kk+1); ii<nrow_xx; ii++){
aa_ik = matrix_get_element(xx, ii, kk);
for(jj=(kk+1); jj<ncol_xx; jj++){
aa_ij = matrix_get_element(xx, ii, jj);
aa_kj = matrix_get_element(xx, kk, jj);
matrix_set_element(xx, ii, jj, aa_ij - ((aa_ik/aa_kk)*aa_kj));
}
matrix_set_element(xx, ii, kk, 0.0);
}
}
/* write matrix to binary file
* the nonzeros are in order of double loop over rows and columns
format:
num_rows (int)
num_columns (int)
nnz (double)
...
nnz (double)
*/
void matrix_write_to_binary_file(mat *M, char *fname){
int i, j, num_rows, num_columns, row_num, col_num;
double nnz_val;
size_t one = 1;
FILE *fp;
num_rows = M->nrows; num_columns = M->ncols;
fp = fopen(fname,"w");
fwrite(&num_rows,sizeof(int),one,fp); //write m
fwrite(&num_columns,sizeof(int),one,fp); //write n
// write the elements
for(i=0; i<num_rows; i++){
for(j=0; j<num_columns; j++){
nnz_val = matrix_get_element(M,i,j);
fwrite(&nnz_val,sizeof(double),one,fp); //write nnz
}
}
fclose(fp);
}
/*
void
matrix_get_row(Matrix *m, index_t i, Matrix *v)
{
// Extracts the ith row of m to the column vector v
index_t j;
const index_t nc=numcols(m);
#ifdef _DBG_
len=numrows(v),
if (len!=nc)
error("Incompatible dimensions in matrix_get_row()");
#endif
for (j=0; j<nc; j++)
matrix_set_element(v,j,0, matrix_get_element(m,i,j));
return;
}
*/
int
matrix_is_symmetric(Matrix *xx)
{
// Checks a matrix for symmetry, aindex_t with other basic checks.
// Returns 1 if the matrix is
// symmetric, 0 if not symmetric (if something else is wrong).
int retval = 1;
index_t ii, jj, nrow_xx = numrows(xx), ncol_xx = numcols(xx);
Matrix *yy = matrix_new(nrow_xx, ncol_xx);
matrix_transpose(xx, yy);
matrix_scalar_multiply(yy, -1.0, yy);
matrix_add(xx, yy, yy);
for (ii=0; ii<nrow_xx; ii++)
for (jj=0; jj<ncol_xx; jj++)
if (matrix_get_element(yy, ii, jj) > DBL_EPSILON)
retval = 0;
matrix_free(yy);
return retval;
}
void
matrix_print_element(Matrix const * const xx, index_t row, index_t col)
{
Rprintf("%g\t", matrix_get_element(xx, row, col));
return;
}
