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)));
}
}
}
/* 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));
}
}
}
/* load matrix from 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)
*/
mat * matrix_load_from_binary_file(char *fname){
int i, j, num_rows, num_columns, row_num, col_num;
double nnz_val;
size_t one = 1;
FILE *fp;
mat *M;
fp = fopen(fname,"r");
fread(&num_rows,sizeof(int),one,fp); //read m
fread(&num_columns,sizeof(int),one,fp); //read n
printf("initializing M of size %d by %d\n", num_rows, num_columns);
M = matrix_new(num_rows,num_columns);
printf("done..\n");
// read and set elements
for(i=0; i<num_rows; i++){
for(j=0; j<num_columns; j++){
fread(&nnz_val,sizeof(double),one,fp); //read nnz
matrix_set_element(M,i,j,nnz_val);
}
}
fclose(fp);
return M;
}
/* 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));
}
}
}
/* 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));
}
}
}
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;
}
/* 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));
}
}
}
/* 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));
}
}
}
/* put vector row_vec as row i of a matrix */
void matrix_set_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++){
matrix_set_element(M,i,j,vector_get_element(row_vec,j));
}
}
}
/* set column of matrix to vector */
void matrix_set_col(mat *M, int j, vec *column_vec){
int i;
#pragma omp parallel shared(column_vec,M,j) private(i)
{
#pragma omp for
for(i=0; i<M->nrows; i++){
matrix_set_element(M,i,j,vector_get_element(column_vec,i));
}
}
}
/* 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)));
}
}
}
/* initialize diagonal matrix from vector data */
void initialize_diagonal_matrix(mat *D, vec *data){
int i;
#pragma omp parallel shared(D) private(i)
{
#pragma omp parallel for
for(i=0; i<(D->nrows); i++){
matrix_set_element(D,i,i,data->d[i]);
}
}
}
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;
}
void matrix_identity(Matrix *xx)
{
index_t ii, nr=numrows(xx), nc=numcols(xx);
if (nr!=nc)
error("Non-square matrix in matrix_identity()");
matrix_fastset(xx,0);
for (ii=0; ii<nr; ii++)
matrix_set_element(xx,ii,ii, 1.0);
return;
}
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)));
}
/* initialize identity */
void initialize_identity_matrix(mat *D){
int i;
matrix_scale(D, 0);
#pragma omp parallel shared(D) private(i)
{
#pragma omp parallel for
for(i=0; i<(D->nrows); i++){
matrix_set_element(D,i,i,1.0);
}
}
}
/* 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));
}
}
}
/* 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));
}
}
}
}
/* copy only upper triangular matrix part as for symmetric matrix */
void matrix_keep_only_upper_triangular(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(M,i,j,0);
}
}
}
}
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);
}
}
void matrix_cholesky(Matrix *X, Matrix *Y)
{
// Sets Y equal to the cholesky decomp of X. Note per the definition,
// the cholesky decomp is an upper triangular matrix.
int i,j, m=numrows(X),n=numcols(X);
if (n!=m)
error("Non-square matrix in matrix_cholesky()");
// Copy X to Y (error check for dims inside matrix_copy)
matrix_copy(X,Y);
// Zero out lower triangle
for (j=0; j<n; j++)
for (i=j+1; i<n; i++)
matrix_set_element(Y,i,j,0.0);
// Compute: Cholesky factorization of Y (upper triangular)
//
//SUBROUTINE DPOTRF(UPLO,N,A,LDA,INFO)
//
// UPLO = 'U' => Upper triangle stored, 'L' => Lower triangle
// N = numrows(A)
// A = LDA-by-N matrix, leading N-by-N matrix to be factored
// On exit, the Cholesky factor
// LDA = Leading dimension of A
// INFO =0 => Successful exit
// >0 => if INFO = -i the ith argument had an illegal value
// <0 => if INFO = i the leading minor of order i is not p.d.
//
F77_CALL(dpotrf)("Upper",&m,Y,&m,&i);
//F77_CALL(chol)(X,&n,&n,Y,i);
if (i!=0){
if (i>0)
error("Leading minor is not positive definite in matrix_cholesky()");
error("Illegal value in matrix_cholesky()");
}
return;
}
void lp_set_coefficient(LP* lp, mpq_t c, int row, int var) {
if (row == lp->rows)
vector_set_element(lp->c, c, var);
else
matrix_set_element(lp->A, c, row, var);
}