void VarproFunction::mulZmatPerm( gsl_vector* res, const gsl_matrix *Zmatr,
const gsl_matrix *perm, size_t i, size_t j ) {
gsl_matrix subJ = gsl_matrix_const_submatrix(Zmatr, j * getM(), 0, getM(),
Zmatr->size2).matrix;
setPhiPermCol(i, perm, myPhiPermCol);
gsl_blas_dgemv(CblasTrans, 1.0, &subJ, myPhiPermCol, 0.0, res);
}
/// Create a submatrix. A submatrix is a view into the parent matrix.
/// Lifetime of a submatrix cannot exceed the lifetime of the parent.
/// @param M :: The parent matrix.
/// @param row :: The first row in the submatrix.
/// @param col :: The first column in the submatrix.
/// @param nRows :: The number of rows in the submatrix.
/// @param nCols :: The number of columns in the submatrix.
GSLMatrix::GSLMatrix(const GSLMatrix &M, size_t row, size_t col, size_t nRows,
size_t nCols) {
if (row + nRows > M.size1() || col + nCols > M.size2()) {
throw std::runtime_error("Submatrix exceeds matrix size.");
}
auto view = gsl_matrix_const_submatrix(M.gsl(), row, col, nRows, nCols);
m_matrix = gsl_matrix_alloc(nRows, nCols);
gsl_matrix_memcpy(m_matrix, &view.matrix);
}
int
gsl_linalg_COD_lssolve (const gsl_matrix * QRZ, const gsl_vector * tau_Q, const gsl_vector * tau_Z,
const gsl_permutation * perm, const size_t rank, const gsl_vector * b,
gsl_vector * x, gsl_vector * residual)
{
const size_t M = QRZ->size1;
const size_t N = QRZ->size2;
if (M < N)
{
GSL_ERROR ("QRZ matrix must have M>=N", GSL_EBADLEN);
}
else if (M != b->size)
{
GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
}
else if (rank > GSL_MIN (M, N))
{
GSL_ERROR ("rank must be <= MIN(M,N)", GSL_EBADLEN);
}
else if (N != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else if (M != residual->size)
{
GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view R11 = gsl_matrix_const_submatrix (QRZ, 0, 0, rank, rank);
gsl_vector_view QTb1 = gsl_vector_subvector(residual, 0, rank);
gsl_vector_view x1 = gsl_vector_subvector(x, 0, rank);
gsl_vector_set_zero(x);
/* compute residual = Q^T b */
gsl_vector_memcpy(residual, b);
gsl_linalg_QR_QTvec (QRZ, tau_Q, residual);
/* solve x1 := R11^{-1} (Q^T b)(1:r) */
gsl_vector_memcpy(&(x1.vector), &(QTb1.vector));
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &(R11.matrix), &(x1.vector));
/* compute Z^T ( R11^{-1} x1; 0 ) */
cod_householder_ZTvec(QRZ, tau_Z, rank, x);
/* compute x = P Z^T ( R11^{-1} x1; 0 ) */
gsl_permute_vector_inverse(perm, x);
/* compute residual = b - A x = Q (Q^T b - R [ R11^{-1} x1; 0 ]) */
gsl_vector_set_zero(&(QTb1.vector));
gsl_linalg_QR_Qvec(QRZ, tau_Q, residual);
return GSL_SUCCESS;
}
}
int
gsl_linalg_QRPT_lssolve2 (const gsl_matrix * QR, const gsl_vector * tau, const gsl_permutation * p,
const gsl_vector * b, const size_t rank, gsl_vector * x, gsl_vector * residual)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (M < N)
{
GSL_ERROR ("QR matrix must have M>=N", GSL_EBADLEN);
}
else if (M != b->size)
{
GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
}
else if (rank == 0 || rank > N)
{
GSL_ERROR ("rank must have 0 < rank <= N", GSL_EBADLEN);
}
else if (N != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else if (M != residual->size)
{
GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view R11 = gsl_matrix_const_submatrix (QR, 0, 0, rank, rank);
gsl_vector_view QTb1 = gsl_vector_subvector(residual, 0, rank);
gsl_vector_view x1 = gsl_vector_subvector(x, 0, rank);
size_t i;
/* compute work = Q^T b */
gsl_vector_memcpy(residual, b);
gsl_linalg_QR_QTvec (QR, tau, residual);
/* solve R_{11} x(1:r) = [Q^T b](1:r) */
gsl_vector_memcpy(&(x1.vector), &(QTb1.vector));
gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, &(R11.matrix), &(x1.vector));
/* x(r+1:N) = 0 */
for (i = rank; i < N; ++i)
gsl_vector_set(x, i, 0.0);
/* compute x = P y */
gsl_permute_vector_inverse (p, x);
/* compute residual = b - A x = Q (Q^T b - R x) */
gsl_vector_set_zero(&(QTb1.vector));
gsl_linalg_QR_Qvec(QR, tau, residual);
return GSL_SUCCESS;
}
}
Embedding MNF(const Matrix &data, const Matrix &noise_covariance, Index reduced_dimensions) {
if (noise_covariance.cols() != noise_covariance.rows() || noise_covariance.rows() != data.cols()) {
throw std::invalid_argument("The rows and columns of noise covariance should both equal to the columns of the data.");
}
if (reduced_dimensions == 0) reduced_dimensions = data.cols();
if (reduced_dimensions > data.cols()) throw std::invalid_argument("Reduced dimensions should be less than or equal to the total dimensions.");
Matrix U1(noise_covariance);
Matrix V1(data.cols(), data.cols());
gsl_vector *S1v = gsl_vector_alloc(data.cols());
gsl_linalg_SV_decomp_jacobi(U1.m_, V1.m_, S1v);
Matrix wX(data.rows(), data.cols());
Matrix wXintermediate(data.cols(), data.cols());
Matrix invsqrtS1(data.cols(), data.cols());
for (Index i = 0; i < data.cols(); ++i) {
invsqrtS1(i, i) = 1.0 / sqrt(gsl_vector_get(S1v, i));
}
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, U1.m_, invsqrtS1.m_, 0.0, wXintermediate.m_);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, data.m_, wXintermediate.m_, 0.0, wX.m_);
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, wX.m_, wX.m_, 0.0, wXintermediate.m_);
Matrix V2(data.cols(), data.cols());
gsl_vector *S2v = gsl_vector_alloc(data.cols());
gsl_linalg_SV_decomp_jacobi(wXintermediate.m_, V2.m_, S2v);
Embedding result;
result.space = std::make_shared<gsl::Matrix>(data.rows(), reduced_dimensions);
result.vectors = std::make_shared<gsl::Matrix>(data.cols(), data.cols());
result.values = std::make_shared<gsl::Matrix>(1, data.cols());
Matrix intermediate2(data.cols(), data.cols());
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, invsqrtS1.m_, V2.m_, 0.0, intermediate2.m_);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, U1.m_, intermediate2.m_, 0.0, result.vectors->m_);
gsl_matrix_const_view reduced_vectors = gsl_matrix_const_submatrix(result.vectors->m_, 0, 0, result.vectors->rows(), reduced_dimensions);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, data.m_, &reduced_vectors.matrix, 0.0, result.space->m_);
// TODO: assign eigenvalues and eigenvectors
gsl_vector_free(S1v);
gsl_vector_free(S2v);
return result;
}
int
gsl_linalg_LQ_lssolve_T (const gsl_matrix * LQ, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
{
const size_t N = LQ->size1;
const size_t M = LQ->size2;
if (M < N)
{
GSL_ERROR ("LQ matrix must have M>=N", GSL_EBADLEN);
}
else if (M != b->size)
{
GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
}
else if (N != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else if (M != residual->size)
{
GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view L = gsl_matrix_const_submatrix (LQ, 0, 0, N, N);
gsl_vector_view c = gsl_vector_subvector(residual, 0, N);
gsl_vector_memcpy(residual, b);
/* compute rhs = b^T Q^T */
gsl_linalg_LQ_vecQT (LQ, tau, residual);
/* Solve x^T L = rhs */
gsl_vector_memcpy(x, &(c.vector));
gsl_blas_dtrsv (CblasLower, CblasTrans, CblasNonUnit, &(L.matrix), x);
/* Compute residual = b^T - x^T A = (b^T Q^T - x^T L) Q */
gsl_vector_set_zero(&(c.vector));
gsl_linalg_LQ_vecQ(LQ, tau, residual);
return GSL_SUCCESS;
}
}
int
gsl_linalg_QR_lssolve (const gsl_matrix * QR, const gsl_vector * tau, const gsl_vector * b, gsl_vector * x, gsl_vector * residual)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (M < N)
{
GSL_ERROR ("QR matrix must have M>=N", GSL_EBADLEN);
}
else if (M != b->size)
{
GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
}
else if (N != x->size)
{
GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
}
else if (M != residual->size)
{
GSL_ERROR ("matrix size must match residual size", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view R = gsl_matrix_const_submatrix (QR, 0, 0, N, N);
gsl_vector_view c = gsl_vector_subvector(residual, 0, N);
gsl_vector_memcpy(residual, b);
/* compute rhs = Q^T b */
gsl_linalg_QR_QTvec (QR, tau, residual);
/* Solve R x = rhs */
gsl_vector_memcpy(x, &(c.vector));
gsl_blas_dtrsv (CblasUpper, CblasNoTrans, CblasNonUnit, &(R.matrix), x);
/* Compute residual = b - A x = Q (Q^T b - R x) */
gsl_vector_set_zero(&(c.vector));
gsl_linalg_QR_Qvec(QR, tau, residual);
return GSL_SUCCESS;
}
}
int
gsl_eigen_gensymm_standardize(gsl_matrix *A, const gsl_matrix *B)
{
const size_t N = A->size1;
size_t i;
double a, b, c;
for (i = 0; i < N; ++i)
{
/* update lower triangle of A(i:n, i:n) */
a = gsl_matrix_get(A, i, i);
b = gsl_matrix_get(B, i, i);
a /= b * b;
gsl_matrix_set(A, i, i, a);
if (i < N - 1)
{
gsl_vector_view ai = gsl_matrix_subcolumn(A, i, i + 1, N - i - 1);
gsl_matrix_view ma =
gsl_matrix_submatrix(A, i + 1, i + 1, N - i - 1, N - i - 1);
gsl_vector_const_view bi =
gsl_matrix_const_subcolumn(B, i, i + 1, N - i - 1);
gsl_matrix_const_view mb =
gsl_matrix_const_submatrix(B, i + 1, i + 1, N - i - 1, N - i - 1);
gsl_blas_dscal(1.0 / b, &ai.vector);
c = -0.5 * a;
gsl_blas_daxpy(c, &bi.vector, &ai.vector);
gsl_blas_dsyr2(CblasLower, -1.0, &ai.vector, &bi.vector, &ma.matrix);
gsl_blas_daxpy(c, &bi.vector, &ai.vector);
gsl_blas_dtrsv(CblasLower,
CblasNoTrans,
CblasNonUnit,
&mb.matrix,
&ai.vector);
}
}
return GSL_SUCCESS;
} /* gsl_eigen_gensymm_standardize() */
void HLayeredBlWStructure::multByGtUnweighted( gsl_vector* p,
const gsl_matrix *Rt, const gsl_vector *y,
double alpha, double beta, bool skipFixedBlocks ) {
size_t l, k, sum_np = 0, sum_nl = 0, D = Rt->size2;
gsl_matrix Y = gsl_matrix_const_view_vector(y,getN(), D).matrix, RtSub;
gsl_vector Y_row, psub;
for (l = 0; l < getQ();
sum_np += getLayerNp(l), sum_nl += getLayerLag(l), ++l) {
RtSub = gsl_matrix_const_submatrix(Rt, sum_nl, 0, getLayerLag(l), D).matrix;
if (!(skipFixedBlocks && isLayerExact(l))) {
for (k = 0; k < getN(); k++) {
psub = gsl_vector_subvector(p, k + sum_np, getLayerLag(l)).vector;
Y_row = gsl_matrix_row(&Y, k).vector;
gsl_blas_dgemv(CblasNoTrans, alpha, &RtSub, &Y_row, beta, &psub);
}
}
}
}
int
solve_PCA(const size_t P, const gsl_matrix * knm,
const gsl_matrix * U, gsl_matrix * alpha,
gsl_matrix * knmt)
{
int status = 0;
const size_t nt = knm->size2; /* number of time stamps */
const size_t nnm = U->size1;
gsl_matrix *R; /* R = knm - U*alpha */
struct timeval tv0, tv1;
double residual; /* || knm - U*alpha || */
int rank;
/* select largest P eigenvectors of SDM */
gsl_matrix_const_view Uv = gsl_matrix_const_submatrix(U, 0, 0, nnm, P);
/* solve: U*alpha = Q */
fprintf(stderr, "solve_PCA: solving PCA problem for alpha...");
gettimeofday(&tv0, NULL);
status = lapack_lls(&Uv.matrix, knm, alpha, &rank);
gettimeofday(&tv1, NULL);
/* compute: knm~ = U*alpha */
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &Uv.matrix, alpha, 0.0, knmt);
/* compute: R = knm - knm~ */
R = gsl_matrix_alloc(nnm, nt);
gsl_matrix_memcpy(R, knm);
gsl_matrix_sub(R, knmt);
residual = norm_fro(R);
fprintf(stderr, "done (%g seconds, status = %d, rank = %d, residual = %.12e)\n",
time_diff(tv0, tv1), status, rank, residual);
gsl_matrix_free(R);
return status;
}
void kjg_fpca_XTB (
const gsl_matrix *B,
gsl_matrix *A) {
size_t n = get_nrows();
size_t m = get_ncols();
size_t i, r;
double *Y = malloc(sizeof(double) * n * KJG_FPCA_ROWS);
gsl_matrix_view Xmat;
gsl_matrix_set_zero(A);
for (i = 0; i < m; i += KJG_FPCA_ROWS) {
r = kjg_geno_get_normalized_rows(i, KJG_FPCA_ROWS, Y);
Xmat = gsl_matrix_view_array(Y, r, n);
gsl_matrix_const_view Hmat = gsl_matrix_const_submatrix(B, i, 0, r,
B->size2);
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1, &Xmat.matrix, &Hmat.matrix,
1, A);
}
free(Y);
}
int
gsl_linalg_QRPT_rcond(const gsl_matrix * QR, double * rcond, gsl_vector * work)
{
const size_t M = QR->size1;
const size_t N = QR->size2;
if (M < N)
{
GSL_ERROR ("M must be >= N", GSL_EBADLEN);
}
else if (work->size != 3 * N)
{
GSL_ERROR ("work vector must have length 3*N", GSL_EBADLEN);
}
else
{
gsl_matrix_const_view R = gsl_matrix_const_submatrix (QR, 0, 0, N, N);
int status;
status = gsl_linalg_tri_upper_rcond(&R.matrix, rcond, work);
return status;
}
}
static int
compute_covar(const double t, const gsl_matrix *C,
double rms[3],
mfield_workspace *mfield_p,
msynth_workspace *msynth_p)
{
int s = 0;
const size_t nmax = 12;
const size_t nnm = (nmax + 1) * (nmax + 1) - 1;
const size_t p = nnm;
const double t0 = mfield_p->epoch;
const double dt = t - t0;
gsl_matrix_const_view SC0 = gsl_matrix_const_submatrix(C, 0, 0, p, p);
gsl_matrix_const_view SR0 = gsl_matrix_const_submatrix(C, mfield_p->sv_offset, mfield_p->sv_offset, p, p);
gsl_matrix_const_view SC0R0 = gsl_matrix_const_submatrix(C, mfield_p->sv_offset, 0, p, p);
gsl_matrix *SC = gsl_matrix_alloc(p, p);
gsl_vector *work = gsl_vector_alloc(p);
mfield_green_workspace *green_p = mfield_p->green_workspace_p;
gsl_vector_view dX = gsl_vector_view_array(green_p->dX, p);
gsl_vector_view dY = gsl_vector_view_array(green_p->dY, p);
gsl_vector_view dZ = gsl_vector_view_array(green_p->dZ, p);
double r, theta, phi;
size_t n = 0;
size_t ngv = 0;
size_t i, j;
for (i = 0; i < p; ++i)
{
for (j = 0; j < p; ++j)
{
double sc0 = gsl_matrix_get(&SC0.matrix, i, j);
double sr0 = gsl_matrix_get(&SR0.matrix, i, j);
double sc0r0 = gsl_matrix_get(&SC0R0.matrix, i, j);
/* Sigma_C from eq (5) of Nikos paper */
gsl_matrix_set(SC, i, j, sc0 + dt * dt * sr0 + 2.0 * dt * sc0r0);
}
}
r = mfield_p->R;
theta = M_PI / 2.0;
phi = 0.0;
for (i = 0; i < 8; ++i)
rms[i] = 0.0;
for (theta = 0.01; theta < M_PI; theta += 5.0 * M_PI / 180.0)
{
double lat = 90.0 - theta * 180.0 / M_PI;
for (phi = 0.0; phi < 2.0 * M_PI; phi += 5.0 * M_PI / 180.0)
{
double SSX, SSY, SSZ, SSH, SSF, SSD, SSI;
double B[4];
/* compute main field for this point */
msynth_eval(t, r, theta, phi, B, msynth_p);
/* compute Green's functions for this point */
mfield_green_calc(r, theta, phi, green_p);
/* compute b^T SC b for X,Y,Z */
SSX = compute_sigmasq(&dX.vector, SC, work);
SSY = compute_sigmasq(&dY.vector, SC, work);
SSZ = compute_sigmasq(&dZ.vector, SC, work);
/* compute rms H, F, D, I */
{
double H = gsl_hypot(B[0], B[1]);
double term1 = B[0] * (1.0 + (B[1]/B[0])*(B[1]/B[0]));
double term2 = H * (1.0 + (B[2]/H)*(B[2]/H));
double Dterm = 1.0 / (term1 * term1);
double Iterm = 1.0 / (term2 * term2);
SSH = (B[0] / H) * (B[0] / H) * SSX +
(B[1] / H) * (B[1] / H) * SSY;
SSF = (B[0] / B[3]) * (B[0] / B[3]) * SSX +
(B[1] / B[3]) * (B[1] / B[3]) * SSY +
(B[2] / B[3]) * (B[2] / B[3]) * SSZ;
SSD = (B[1] / B[0]) * (B[1] / B[0]) * Dterm * SSX +
Dterm * SSY;
SSI = (B[2] / H) * (B[2] / H) * Iterm * SSH +
Iterm * SSZ;
}
rms[0] += SSX * SSX;
rms[1] += SSY * SSY;
rms[2] += SSZ * SSZ;
rms[3] += SSH * SSH;
rms[4] += SSF * SSF;
rms[5] += SSD * SSD;
rms[6] += SSI * SSI;
++n;
if (lat > 55.0 || lat < -55.0)
{
rms[7] += SSD * SSD;
++ngv;
}
}
}
for (i = 0; i < 7; ++i)
rms[i] = sqrt(rms[i] / (double)n);
rms[7] = sqrt(rms[7] / (double)ngv);
gsl_matrix_free(SC);
gsl_vector_free(work);
return s;
}
int
gsl_linalg_COD_unpack(const gsl_matrix * QRZ, const gsl_vector * tau_Q,
const gsl_vector * tau_Z, const size_t rank, gsl_matrix * Q,
gsl_matrix * R, gsl_matrix * Z)
{
const size_t M = QRZ->size1;
const size_t N = QRZ->size2;
if (tau_Q->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau_Q must be MIN(M,N)", GSL_EBADLEN);
}
else if (tau_Z->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau_Z must be MIN(M,N)", GSL_EBADLEN);
}
else if (rank > GSL_MIN (M, N))
{
GSL_ERROR ("rank must be <= MIN(M,N)", GSL_EBADLEN);
}
else if (Q->size1 != M || Q->size2 != M)
{
GSL_ERROR ("Q must by M-by-M", GSL_EBADLEN);
}
else if (R->size1 != M || R->size2 != N)
{
GSL_ERROR ("R must by M-by-N", GSL_EBADLEN);
}
else if (Z->size1 != N || Z->size2 != N)
{
GSL_ERROR ("Z must by N-by-N", GSL_EBADLEN);
}
else
{
size_t i;
gsl_matrix_view R11 = gsl_matrix_submatrix(R, 0, 0, rank, rank);
gsl_matrix_const_view QRZ11 = gsl_matrix_const_submatrix(QRZ, 0, 0, rank, rank);
/* form Q matrix */
gsl_matrix_set_identity(Q);
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view h = gsl_matrix_const_subcolumn (QRZ, i, i, M - i);
gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i);
double ti = gsl_vector_get (tau_Q, i);
gsl_linalg_householder_hm (ti, &h.vector, &m.matrix);
}
/* form Z matrix */
gsl_matrix_set_identity(Z);
if (rank < N)
{
gsl_vector_view work = gsl_matrix_row(R, 0); /* temporary workspace, size N */
/* multiply I by Z from the right */
gsl_linalg_COD_matZ(QRZ, tau_Z, rank, Z, &work.vector);
}
/* copy rank-by-rank upper triangle of QRZ into R and zero the rest */
gsl_matrix_set_zero(R);
gsl_matrix_tricpy('U', 1, &R11.matrix, &QRZ11.matrix);
return GSL_SUCCESS;
}
}
int
gsl_multifit_linear_wgenform2 (const gsl_matrix * LQR,
const gsl_vector * Ltau,
const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
const gsl_vector * cs,
const gsl_matrix * M,
gsl_vector * c,
gsl_multifit_linear_workspace * work)
{
const size_t m = LQR->size1;
const size_t n = X->size1;
const size_t p = X->size2;
if (n > work->nmax || p > work->pmax)
{
GSL_ERROR("X matrix does not match workspace", GSL_EBADLEN);
}
else if (p != LQR->size2)
{
GSL_ERROR("LQR matrix does not match X", GSL_EBADLEN);
}
else if (p != c->size)
{
GSL_ERROR("c vector does not match X", GSL_EBADLEN);
}
else if (w != NULL && n != w->size)
{
GSL_ERROR("w vector does not match X", GSL_EBADLEN);
}
else if (n != y->size)
{
GSL_ERROR("y vector does not match X", GSL_EBADLEN);
}
else if (m >= p) /* square or tall L matrix */
{
if (p != cs->size)
{
GSL_ERROR("cs vector must be length p", GSL_EBADLEN);
}
else
{
int s;
gsl_matrix_const_view R = gsl_matrix_const_submatrix(LQR, 0, 0, p, p); /* R factor of L */
/* solve R c = cs for true solution c, using QR decomposition of L */
gsl_vector_memcpy(c, cs);
s = gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &R.matrix, c);
return s;
}
}
else /* rectangular L matrix with m < p */
{
if (m != cs->size)
{
GSL_ERROR("cs vector must be length m", GSL_EBADLEN);
}
else if (n != M->size1 || p != M->size2)
{
GSL_ERROR("M matrix must be size n-by-p", GSL_EBADLEN);
}
else
{
int status;
const size_t pm = p - m;
gsl_matrix_view A = gsl_matrix_submatrix(work->A, 0, 0, n, p);
gsl_vector_view b = gsl_vector_subvector(work->t, 0, n);
gsl_matrix_view Rp = gsl_matrix_view_array(LQR->data, m, m); /* R_p */
gsl_matrix_view LTQR = gsl_matrix_view_array(LQR->data, p, m);
gsl_vector_const_view LTtau = gsl_vector_const_subvector(Ltau, 0, m);
gsl_matrix_const_view MQR = gsl_matrix_const_submatrix(M, 0, 0, n, pm);
gsl_vector_const_view Mtau = gsl_matrix_const_subcolumn(M, p - 1, 0, GSL_MIN(n, pm));
gsl_matrix_const_view To = gsl_matrix_const_submatrix(&MQR.matrix, 0, 0, pm, pm);
gsl_vector_view workp = gsl_vector_subvector(work->xt, 0, p);
gsl_vector_view v1, v2;
/* compute A = sqrt(W) X and b = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, &A.matrix, &b.vector);
if (status)
return status;
/* initialize c to zero */
gsl_vector_set_zero(c);
/* compute c = L_inv cs = K_p R_p^{-T} cs */
/* set c(1:m) = R_p^{-T} cs */
v1 = gsl_vector_subvector(c, 0, m);
gsl_vector_memcpy(&v1.vector, cs);
gsl_blas_dtrsv(CblasUpper, CblasTrans, CblasNonUnit, &Rp.matrix, &v1.vector);
/* c <- K R_p^{-T} cs = [ K_p R_p^{_T} cs ; 0 ] */
gsl_linalg_QR_Qvec(<QR.matrix, <tau.vector, c);
/* compute: b1 = b - A L_inv cs */
gsl_blas_dgemv(CblasNoTrans, -1.0, &A.matrix, c, 1.0, &b.vector);
/* compute: b2 = H^T b1 */
gsl_linalg_QR_QTvec(&MQR.matrix, &Mtau.vector, &b.vector);
/* compute: b3 = T_o^{-1} b2 */
v1 = gsl_vector_subvector(&b.vector, 0, pm);
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &To.matrix, &v1.vector);
/* compute: b4 = K_o b3 */
gsl_vector_set_zero(&workp.vector);
v2 = gsl_vector_subvector(&workp.vector, m, pm);
gsl_vector_memcpy(&v2.vector, &v1.vector);
gsl_linalg_QR_Qvec(<QR.matrix, <tau.vector, &workp.vector);
/* final solution vector */
gsl_vector_add(c, &workp.vector);
return GSL_SUCCESS;
}
}
}
int
gsl_multifit_linear_wstdform2 (const gsl_matrix * LQR,
const gsl_vector * Ltau,
const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
gsl_matrix * Xs,
gsl_vector * ys,
gsl_matrix * M,
gsl_multifit_linear_workspace * work)
{
const size_t m = LQR->size1;
const size_t n = X->size1;
const size_t p = X->size2;
if (n > work->nmax || p > work->pmax)
{
GSL_ERROR("observation matrix larger than workspace", GSL_EBADLEN);
}
else if (p != LQR->size2)
{
GSL_ERROR("LQR and X matrices have different numbers of columns", GSL_EBADLEN);
}
else if (n != y->size)
{
GSL_ERROR("y vector does not match X", GSL_EBADLEN);
}
else if (w != NULL && n != w->size)
{
GSL_ERROR("weights vector must be length n", GSL_EBADLEN);
}
else if (m >= p) /* square or tall L matrix */
{
/* the sizes of Xs and ys depend on whether m >= p or m < p */
if (n != Xs->size1 || p != Xs->size2)
{
GSL_ERROR("Xs matrix must be n-by-p", GSL_EBADLEN);
}
else if (n != ys->size)
{
GSL_ERROR("ys vector must have length n", GSL_EBADLEN);
}
else
{
int status;
size_t i;
gsl_matrix_const_view R = gsl_matrix_const_submatrix(LQR, 0, 0, p, p);
/* compute Xs = sqrt(W) X and ys = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, Xs, ys);
if (status)
return status;
/* compute X~ = X R^{-1} using QR decomposition of L */
for (i = 0; i < n; ++i)
{
gsl_vector_view v = gsl_matrix_row(Xs, i);
/* solve: R^T y = X_i */
gsl_blas_dtrsv(CblasUpper, CblasTrans, CblasNonUnit, &R.matrix, &v.vector);
}
return GSL_SUCCESS;
}
}
else /* L matrix with m < p */
{
const size_t pm = p - m;
const size_t npm = n - pm;
/*
* This code closely follows section 2.6.1 of Hansen's
* "Regularization Tools" manual
*/
if (npm != Xs->size1 || m != Xs->size2)
{
GSL_ERROR("Xs matrix must be (n-p+m)-by-m", GSL_EBADLEN);
}
else if (npm != ys->size)
{
GSL_ERROR("ys vector must be of length (n-p+m)", GSL_EBADLEN);
}
else if (n != M->size1 || p != M->size2)
{
GSL_ERROR("M matrix must be n-by-p", GSL_EBADLEN);
}
else
{
int status;
gsl_matrix_view A = gsl_matrix_submatrix(work->A, 0, 0, n, p);
gsl_vector_view b = gsl_vector_subvector(work->t, 0, n);
gsl_matrix_view LTQR = gsl_matrix_view_array(LQR->data, p, m); /* qr(L^T) */
gsl_matrix_view Rp = gsl_matrix_view_array(LQR->data, m, m); /* R factor of L^T */
gsl_vector_const_view LTtau = gsl_vector_const_subvector(Ltau, 0, m);
/*
* M(:,1:p-m) will hold QR decomposition of A K_o; M(:,p) will hold
* Householder scalars
*/
gsl_matrix_view MQR = gsl_matrix_submatrix(M, 0, 0, n, pm);
gsl_vector_view Mtau = gsl_matrix_subcolumn(M, p - 1, 0, GSL_MIN(n, pm));
gsl_matrix_view AKo, AKp, HqTAKp;
gsl_vector_view v;
size_t i;
/* compute A = sqrt(W) X and b = sqrt(W) y */
status = gsl_multifit_linear_applyW(X, w, y, &A.matrix, &b.vector);
if (status)
return status;
/* compute: A <- A K = [ A K_p ; A K_o ] */
gsl_linalg_QR_matQ(<QR.matrix, <tau.vector, &A.matrix);
AKp = gsl_matrix_submatrix(&A.matrix, 0, 0, n, m);
AKo = gsl_matrix_submatrix(&A.matrix, 0, m, n, pm);
/* compute QR decomposition [H,T] = qr(A * K_o) and store in M */
gsl_matrix_memcpy(&MQR.matrix, &AKo.matrix);
gsl_linalg_QR_decomp(&MQR.matrix, &Mtau.vector);
/* AKp currently contains A K_p; apply H^T from the left to get H^T A K_p */
gsl_linalg_QR_QTmat(&MQR.matrix, &Mtau.vector, &AKp.matrix);
/* the last npm rows correspond to H_q^T A K_p */
HqTAKp = gsl_matrix_submatrix(&AKp.matrix, pm, 0, npm, m);
/* solve: Xs R_p^T = H_q^T A K_p for Xs */
gsl_matrix_memcpy(Xs, &HqTAKp.matrix);
for (i = 0; i < npm; ++i)
{
gsl_vector_view x = gsl_matrix_row(Xs, i);
gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, &Rp.matrix, &x.vector);
}
/*
* compute: ys = H_q^T b; this is equivalent to computing
* the last q elements of H^T b (q = npm)
*/
v = gsl_vector_subvector(&b.vector, pm, npm);
gsl_linalg_QR_QTvec(&MQR.matrix, &Mtau.vector, &b.vector);
gsl_vector_memcpy(ys, &v.vector);
return GSL_SUCCESS;
}
}
}
//[E,z] = (n, n_class, pi, K);
void mexFunction(int nlhs, mxArray* plhs[], int nrhs, const mxArray* prhs[])
{
double sigma_noise = 5.0e-7; // works for s=0, but this gives different results from the octave code
double *pi;
double *Kmx;
int c, i, j, n, n_class;
double *tmp, z = 0;
/* Check for proper number of arguments. */
if(nrhs!=4) {
mexErrMsgTxt("mex_laplace_subroutine: requires exactly four input arguments.");
} else if(nlhs>2) {
mexErrMsgTxt("mex_laplace_subroutine: requires at most two output arguments.");
} else if (nlhs <= 0) {
mexErrMsgTxt("mex_laplace_subroutine: requires at least one output argument.");
}
tmp = mxGetPr(prhs[0]);
n = (int) (tmp[0]);
tmp = mxGetPr(prhs[1]);
n_class = (int) (tmp[0]);
pi = mxGetPr(prhs[2]);
Kmx = mxGetPr(prhs[3]);
gsl_matrix *K = gsl_matrix_alloc(n*n_class, n*n_class);
K->data = Kmx;
// K, at least K(:,:,1), is confirmed correct
gsl_matrix* Ip = gsl_matrix_alloc(n, n);
gsl_matrix_set_identity(Ip);
gsl_matrix_scale(Ip, 1+sigma_noise);
// this should probably be restructured, after I get this working
double *E_val;
plhs[0] = mxCreateDoubleMatrix(n, n*n_class, mxREAL);
E_val = mxGetPr(plhs[0]);
//#pragma omp parallel for
for (c = 0; c < n_class; c++) {
gsl_matrix *sqrtDc = gsl_matrix_calloc(n, n);
gsl_matrix *L = gsl_matrix_alloc(n, n);
gsl_matrix *L1 = gsl_matrix_alloc(n, n);
_gsl_matrix_const_view Kcv = gsl_matrix_const_submatrix(K, c*n, c*n, n, n);
gsl_matrix *Kc = gsl_matrix_alloc(n, n);
Kc = &Kcv.matrix;
gsl_matrix *Ec = gsl_matrix_alloc(n, n);
for (i = 0; i < n; i++) {
gsl_matrix_set(sqrtDc, i, i, sqrt(pi[i + c * n]));
}
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Kc, sqrtDc, 0.0, L1); // L1 = K[:,:,c]) * sqrtDc
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, sqrtDc, L1, 0.0, L); // L = sqrtDc * (K(:,:,c) * sqrtDc);
// NTS: is the above equivalent to:
// Lc := (pi_c pi_c') .* Kc
// ?
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Ip, Ip, 1.0, L); // L = (1 + sigma_noise)*eye(n) + sqrtDc * K(:,:,c) * sqrtDc;
// rewrite that one, god - mult to do add? that's just absurd
gsl_linalg_cholesky_decomp(L); // L = chol((1 + sigma_noise)*eye(n) + sqrtDc * K(:,:,c) * sqrtDc)';
// this gives L as being doubled triangular! LL' != RHS
// if it throws GSL_EDOM, that means L wasn't pos def, apparently
for (i = 0; i < n; i++) {
z += log(gsl_matrix_get(L, i, i)); // this apparently works. huzzah
}
for (i = 0; i < n; i++) {
for (j=0;j<n;j++) {
gsl_matrix_set(L1, i, j, gsl_matrix_get(sqrtDc,i,j));
}
}
// L1 = sqrtDc
gsl_blas_dtrsm(CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 1.0, L, L1); // L1 = L \ sqrtDc
gsl_blas_dtrsm(CblasLeft, CblasLower, CblasTrans, CblasNonUnit, 1.0, L, L1); // L1 = L' \ (L \ sqrtDc)
// sqrtDc and L are sym, so these should be invariant trans or no trans, provided exactly one is
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, sqrtDc, L1, 0.0, Ec); // Ec = sqrtDc * ( L' \ (L \ sqrtDc) );
/*catch
disp('alg3.3s chol is failing again');
matrix [L, U] = lu((1 + sigma_noise)*eye(n) + sqrtDc * K(:,:,c) * sqrtDc);
E(:,:,c) = ((sqrtDc / U) / L) * sqrtDc;
end*/
for (j=0;j<n;j++) {
for (i=0;i<n;i++) {
E_val[c*n*n+j*n+i] = gsl_matrix_get(Ec, i, j);
}
}
/*
if (!c) {
printf("Ec1:\n");
for (i = 0; i < n; i++) {
for (j = 0; j < n; j++) {
printf("%g ", gsl_matrix_get(Ec, i, j));
}
printf("\n");
}
printf("E1:\n");
for (i = 0; i < n; i++) {
for (j = 0; j < n; j++) {
printf("%g ", gsl_matrix_get(E, i, j));
}
printf("\n");
}
}*/
}
if (nlhs >= 2) {
plhs[1] = mxCreateDoubleMatrix(1, 1, mxREAL);
double *z_val = mxGetPr(plhs[1]);
z_val[0] = z;
}
}
void fnIMIS(const size_t InitSamples, const size_t StepSamples, const size_t FinalResamples, const size_t MaxIter, const size_t NumParam, unsigned long int rng_seed, const char * runName)
{
// Declare and configure GSL RNG
gsl_rng * rng;
const gsl_rng_type * T;
gsl_rng_env_setup();
T = gsl_rng_default;
rng = gsl_rng_alloc (T);
gsl_rng_set(rng, rng_seed);
char strDiagnosticsFile[strlen(runName) + 15 +1];
char strResampleFile[strlen(runName) + 12 +1];
strcpy(strDiagnosticsFile, runName); strcat(strDiagnosticsFile, "Diagnostics.txt");
strcpy(strResampleFile, runName); strcat(strResampleFile, "Resample.txt");
FILE * diagnostics_file = fopen(strDiagnosticsFile, "w");
fprintf(diagnostics_file, "Seeded RNG: %zu\n", rng_seed);
fprintf(diagnostics_file, "Running IMIS. InitSamples: %zu, StepSamples: %zu, FinalResamples %zu, MaxIter %zu\n", InitSamples, StepSamples, FinalResamples, MaxIter);
// Setup IMIS arrays
gsl_matrix * Xmat = gsl_matrix_alloc(InitSamples + StepSamples*MaxIter, NumParam);
double * prior_all = (double*) malloc(sizeof(double) * (InitSamples + StepSamples*MaxIter));
double * likelihood_all = (double*) malloc(sizeof(double) * (InitSamples + StepSamples*MaxIter));
double * imp_weight_denom = (double*) malloc(sizeof(double) * (InitSamples + StepSamples*MaxIter)); // proportional to q(k) in stage 2c of Raftery & Bao
double * gaussian_sum = (double*) calloc(InitSamples + StepSamples*MaxIter, sizeof(double)); // sum of mixture distribution for mode
struct dst * distance = (struct dst *) malloc(sizeof(struct dst) * (InitSamples + StepSamples*MaxIter)); // Mahalanobis distance to most recent mode
double * imp_weights = (double*) malloc(sizeof(double) * (InitSamples + StepSamples*MaxIter));
double * tmp_MVNpdf = (double*) malloc(sizeof(double) * (InitSamples + StepSamples*MaxIter));
gsl_matrix * nearestX = gsl_matrix_alloc(StepSamples, NumParam);
double center_all[MaxIter][NumParam];
gsl_matrix * sigmaChol_all[MaxIter];
gsl_matrix * sigmaInv_all[MaxIter];
// Initial prior samples
sample_prior(rng, InitSamples, Xmat);
// Calculate prior covariance
double prior_invCov_diag[NumParam];
/*
The paper describing the algorithm uses the full prior covariance matrix.
This follows the code in the IMIS R package and diagonalizes the prior
covariance matrix to ensure invertibility.
*/
for(size_t i = 0; i < NumParam; i++){
gsl_vector_view tmpCol = gsl_matrix_subcolumn(Xmat, i, 0, InitSamples);
prior_invCov_diag[i] = gsl_stats_variance(tmpCol.vector.data, tmpCol.vector.stride, InitSamples);
prior_invCov_diag[i] = 1.0/prior_invCov_diag[i];
}
// IMIS steps
fprintf(diagnostics_file, "Step Var(w_i) MargLik Unique Max(w_i) ESS Time\n");
printf("Step Var(w_i) MargLik Unique Max(w_i) ESS Time\n");
time_t time1, time2;
time(&time1);
size_t imisStep = 0, numImisSamples;
for(imisStep = 0; imisStep < MaxIter; imisStep++){
numImisSamples = (InitSamples + imisStep*StepSamples);
// Evaluate prior and likelihood
if(imisStep == 0){ // initial stage
#pragma omp parallel for
for(size_t i = 0; i < numImisSamples; i++){
gsl_vector_const_view theta = gsl_matrix_const_row(Xmat, i);
prior_all[i] = prior(&theta.vector);
likelihood_all[i] = likelihood(&theta.vector);
}
} else { // imisStep > 0
#pragma omp parallel for
for(size_t i = InitSamples + (imisStep-1)*StepSamples; i < numImisSamples; i++){
gsl_vector_const_view theta = gsl_matrix_const_row(Xmat, i);
prior_all[i] = prior(&theta.vector);
likelihood_all[i] = likelihood(&theta.vector);
}
}
// Determine importance weights, find current maximum, calculate monitoring criteria
#pragma omp parallel for
for(size_t i = 0; i < numImisSamples; i++){
imp_weight_denom[i] = (InitSamples*prior_all[i] + StepSamples*gaussian_sum[i])/(InitSamples + StepSamples * imisStep);
imp_weights[i] = (prior_all[i] > 0)?likelihood_all[i]*prior_all[i]/imp_weight_denom[i]:0;
}
double sumWeights = 0.0;
for(size_t i = 0; i < numImisSamples; i++){
sumWeights += imp_weights[i];
}
double maxWeight = 0.0, varImpW = 0.0, entropy = 0.0, expectedUnique = 0.0, effSampSize = 0.0, margLik;
size_t maxW_idx;
#pragma omp parallel for reduction(+: varImpW, entropy, expectedUnique, effSampSize)
for(size_t i = 0; i < numImisSamples; i++){
imp_weights[i] /= sumWeights;
varImpW += pow(numImisSamples * imp_weights[i] - 1.0, 2.0);
entropy += imp_weights[i] * log(imp_weights[i]);
expectedUnique += (1.0 - pow((1.0 - imp_weights[i]), FinalResamples));
effSampSize += pow(imp_weights[i], 2.0);
}
for(size_t i = 0; i < numImisSamples; i++){
if(imp_weights[i] > maxWeight){
maxW_idx = i;
maxWeight = imp_weights[i];
}
}
for(size_t i = 0; i < NumParam; i++)
center_all[imisStep][i] = gsl_matrix_get(Xmat, maxW_idx, i);
varImpW /= numImisSamples;
entropy = -entropy / log(numImisSamples);
effSampSize = 1.0/effSampSize;
margLik = log(sumWeights/numImisSamples);
fprintf(diagnostics_file, "%4zu %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n", imisStep, varImpW, margLik, expectedUnique, maxWeight, effSampSize, difftime(time(&time2), time1));
printf("%4zu %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n", imisStep, varImpW, margLik, expectedUnique, maxWeight, effSampSize, difftime(time(&time2), time1));
time1 = time2;
// Check for convergence
if(expectedUnique > FinalResamples*(1.0 - exp(-1.0))){
break;
}
// Calculate Mahalanobis distance to current mode
GetMahalanobis_diag(Xmat, center_all[imisStep], prior_invCov_diag, numImisSamples, NumParam, distance);
// Find StepSamples nearest points
// (Note: this was a major bottleneck when InitSamples and StepResamples are large. qsort substantially outperformed GSL sort options.)
qsort(distance, numImisSamples, sizeof(struct dst), cmp_dst);
#pragma omp parallel for
for(size_t i = 0; i < StepSamples; i++){
gsl_vector_const_view tmpX = gsl_matrix_const_row(Xmat, distance[i].idx);
gsl_matrix_set_row(nearestX, i, &tmpX.vector);
}
// Calculate weighted covariance of nearestX
// (a) Calculate weights for nearest points 1...StepSamples
double weightsCov[StepSamples];
#pragma omp parallel for
for(size_t i = 0; i < StepSamples; i++){
weightsCov[i] = 0.5*(imp_weights[distance[i].idx] + 1.0/numImisSamples); // cov_wt function will normalize the weights
}
// (b) Calculate weighted covariance
sigmaChol_all[imisStep] = gsl_matrix_alloc(NumParam, NumParam);
covariance_weighted(nearestX, weightsCov, StepSamples, center_all[imisStep], NumParam, sigmaChol_all[imisStep]);
// (c) Do Cholesky decomposition and inverse of covariance matrix
gsl_linalg_cholesky_decomp(sigmaChol_all[imisStep]);
for(size_t j = 0; j < NumParam; j++) // Note: GSL outputs a symmetric matrix rather than lower tri, so have to set upper tri to zero
for(size_t k = j+1; k < NumParam; k++)
gsl_matrix_set(sigmaChol_all[imisStep], j, k, 0.0);
sigmaInv_all[imisStep] = gsl_matrix_alloc(NumParam, NumParam);
gsl_matrix_memcpy(sigmaInv_all[imisStep], sigmaChol_all[imisStep]);
gsl_linalg_cholesky_invert(sigmaInv_all[imisStep]);
// Sample new inputs
gsl_matrix_view newSamples = gsl_matrix_submatrix(Xmat, numImisSamples, 0, StepSamples, NumParam);
GenerateRandMVnorm(rng, StepSamples, center_all[imisStep], sigmaChol_all[imisStep], NumParam, &newSamples.matrix);
// Evaluate sampling probability from mixture distribution
// (a) For newly sampled points, sum over all previous centers
for(size_t pastStep = 0; pastStep < imisStep; pastStep++){
GetMVNpdf(&newSamples.matrix, center_all[pastStep], sigmaInv_all[pastStep], sigmaChol_all[pastStep], StepSamples, NumParam, tmp_MVNpdf);
#pragma omp parallel for
for(size_t i = 0; i < StepSamples; i++)
gaussian_sum[numImisSamples + i] += tmp_MVNpdf[i];
}
// (b) For all points, add weight for most recent center
gsl_matrix_const_view Xmat_curr = gsl_matrix_const_submatrix(Xmat, 0, 0, numImisSamples + StepSamples, NumParam);
GetMVNpdf(&Xmat_curr.matrix, center_all[imisStep], sigmaInv_all[imisStep], sigmaChol_all[imisStep], numImisSamples + StepSamples, NumParam, tmp_MVNpdf);
#pragma omp parallel for
for(size_t i = 0; i < numImisSamples + StepSamples; i++)
gaussian_sum[i] += tmp_MVNpdf[i];
} // loop over imisStep
//// FINISHED IMIS ROUTINE
fclose(diagnostics_file);
// Resample posterior outputs
int resampleIdx[FinalResamples];
walker_ProbSampleReplace(rng, numImisSamples, imp_weights, FinalResamples, resampleIdx); // Note: Random sampling routine used in R sample() function.
// Print results
FILE * resample_file = fopen(strResampleFile, "w");
for(size_t i = 0; i < FinalResamples; i++){
for(size_t j = 0; j < NumParam; j++)
fprintf(resample_file, "%.15e\t", gsl_matrix_get(Xmat, resampleIdx[i], j));
gsl_vector_const_view theta = gsl_matrix_const_row(Xmat, resampleIdx[i]);
fprintf(resample_file, "\n");
}
fclose(resample_file);
/*
// This outputs Xmat (parameter matrix), centers, and covariance matrices to files for debugging
FILE * Xmat_file = fopen("Xmat.txt", "w");
for(size_t i = 0; i < numImisSamples; i++){
for(size_t j = 0; j < NumParam; j++)
fprintf(Xmat_file, "%.15e\t", gsl_matrix_get(Xmat, i, j));
fprintf(Xmat_file, "%e\t%e\t%e\t%e\t%e\t\n", prior_all[i], likelihood_all[i], imp_weights[i], gaussian_sum[i], distance[i]);
}
fclose(Xmat_file);
FILE * centers_file = fopen("centers.txt", "w");
for(size_t i = 0; i < imisStep; i++){
for(size_t j = 0; j < NumParam; j++)
fprintf(centers_file, "%f\t", center_all[i][j]);
fprintf(centers_file, "\n");
}
fclose(centers_file);
FILE * sigmaInv_file = fopen("sigmaInv.txt", "w");
for(size_t i = 0; i < imisStep; i++){
for(size_t j = 0; j < NumParam; j++)
for(size_t k = 0; k < NumParam; k++)
fprintf(sigmaInv_file, "%f\t", gsl_matrix_get(sigmaInv_all[i], j, k));
fprintf(sigmaInv_file, "\n");
}
fclose(sigmaInv_file);
*/
// free memory allocated by IMIS
for(size_t i = 0; i < imisStep; i++){
gsl_matrix_free(sigmaChol_all[i]);
gsl_matrix_free(sigmaInv_all[i]);
}
// release RNG
gsl_rng_free(rng);
gsl_matrix_free(Xmat);
gsl_matrix_free(nearestX);
free(prior_all);
free(likelihood_all);
free(imp_weight_denom);
free(gaussian_sum);
free(distance);
free(imp_weights);
free(tmp_MVNpdf);
return;
}
