/* Generate a random vector from a multivariate Gaussian distribution using
* the Cholesky decomposition of the variance-covariance matrix, following
* "Computational Statistics" from Gentle (2009), section 7.4.
*
* mu mean vector (dimension d)
* L matrix resulting from the Cholesky decomposition of
* variance-covariance matrix Sigma = L L^T (dimension d x d)
* result output vector (dimension d)
*/
int
gsl_ran_multivariate_gaussian (const gsl_rng * r,
const gsl_vector * mu,
const gsl_matrix * L,
gsl_vector * result)
{
const size_t M = L->size1;
const size_t N = L->size2;
if (M != N)
{
GSL_ERROR("requires square matrix", GSL_ENOTSQR);
}
else if (mu->size != M)
{
GSL_ERROR("incompatible dimension of mean vector with variance-covariance matrix", GSL_EBADLEN);
}
else if (result->size != M)
{
GSL_ERROR("incompatible dimension of result vector", GSL_EBADLEN);
}
else
{
size_t i;
for (i = 0; i < M; ++i)
gsl_vector_set(result, i, gsl_ran_ugaussian(r));
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, L, result);
gsl_vector_add(result, mu);
return GSL_SUCCESS;
}
}
void gaussian_gen(const gsl_rng* rng, const gaussian_t* dist,
gsl_vector* result) {
assert(result->size == dist->dim);
size_t i;
for (i = 0; i < result->size; i++) {
gsl_vector_set(result, i, gsl_ran_ugaussian(rng));
}
if (gaussian_isdiagonal(dist)) {
for (i = 0; i < result->size; i++) {
double* p = gsl_vector_ptr(result, i);
*p *= DEBUG_SQRT(gsl_vector_get(dist->diag, i));
}
}
else {
gsl_matrix* v = gsl_matrix_alloc(dist->dim, dist->dim);
gsl_matrix_memcpy(v, dist->cov);
gsl_linalg_cholesky_decomp(v);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, v, result);
gsl_matrix_free(v);
}
gsl_vector_add(result, dist->mean);
}
void HLayeredBlWStructure::AtVkV( gsl_vector *u, long k, const gsl_matrix *A,
const gsl_vector *v, gsl_vector *tmpVkV, double beta ) const {
gsl_blas_dcopy(v, tmpVkV);
gsl_blas_dtrmv(CblasLower, (k > 0 ? CblasNoTrans : CblasTrans),
CblasNonUnit, getWk(abs(k)), tmpVkV);
gsl_blas_dgemv(CblasTrans, 1.0, A, tmpVkV, beta, u);
}
int rmvnorm(const gsl_rng *r, const int n, const gsl_vector *mean,
const gsl_matrix *var, gsl_vector *result){
/* multivariate normal distribution random number generator */
/*
* n dimension of the random vetor
* mean vector of means of size n
* var variance matrix of dimension n x n
* result output variable with a sigle random vector normal distribution generation
*/
int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work,var);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result );
gsl_vector_add(result,mean);
gsl_matrix_free(work);
return 0;
}
static void
_ncm_data_gauss_cov_resample (NcmData *data, NcmMSet *mset, NcmRNG *rng)
{
NcmDataGaussCov *gauss = NCM_DATA_GAUSS_COV (data);
NcmDataGaussCovClass *gauss_cov_class = NCM_DATA_GAUSS_COV_GET_CLASS (gauss);
gboolean cov_update = FALSE;
gint ret;
guint i;
if (gauss_cov_class->cov_func != NULL)
cov_update = gauss_cov_class->cov_func (gauss, mset, gauss->cov);
if (cov_update || !gauss->prepared_LLT)
_ncm_data_gauss_cov_prepare_LLT (data);
ncm_rng_lock (rng);
for (i = 0; i < gauss->np; i++)
{
const gdouble u_i = gsl_ran_ugaussian (rng->r);
ncm_vector_set (gauss->v, i, u_i);
}
ncm_rng_unlock (rng);
/* CblasLower, CblasNoTrans => CblasUpper, CblasTrans */
ret = gsl_blas_dtrmv (CblasUpper, CblasTrans, CblasNonUnit,
ncm_matrix_gsl (gauss->LLT), ncm_vector_gsl (gauss->v));
NCM_TEST_GSL_RESULT ("_ncm_data_gauss_cov_resample", ret);
gauss_cov_class->mean_func (gauss, mset, gauss->y);
ncm_vector_sub (gauss->y, gauss->v);
}
void RandomNumberGenerator::gaussian_mv(const vector<double> &mean, const vector<vector<double> > &covar, const vector<double> &min, const vector<double> &max, vector<double> &result){
/* multivariate normal distribution random number generator */
/*
* n dimension of the random vetor
* mean vector of means of size n
* var variance matrix of dimension n x n
* result output variable with a sigle random vector normal distribution generation
*/
int k;
int n=mean.size();
gsl_matrix *_covar = gsl_matrix_alloc(covar.size(),covar[0].size());
gsl_vector *_result = gsl_vector_calloc(mean.size());
gsl_vector *_mean = gsl_vector_calloc(mean.size());
result.resize(mean.size());
for(k=0;k<n;k++){
for(int j=0;j<n;j++){
gsl_matrix_set(_covar,k,j,covar[k][j]);
}
gsl_vector_set(_mean, k, mean[k]);
}
int status = gsl_linalg_cholesky_decomp(_covar);
if(status){
printf("ERROR: Covariance matrix appears to be un-invertible. Increase your convergence step length to better sample the posterior such that you have enough samples to create a non-singular matrix at first matrix update.\nExiting...\n");
exit(1);
}
bool in_range;
do{
for(k=0; k<n; k++)
gsl_vector_set( _result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, _covar, _result);
gsl_vector_add(_result,_mean);
in_range = true;
for(k=0; k<n; k++){
if(gsl_vector_get(_result, k) < min[k] or gsl_vector_get(_result, k) > max[k]){
in_range = false;
k=n+1;
}
}
}while(not in_range);
for(k=0; k<n; k++){
result[k] = gsl_vector_get(_result, k);
}
gsl_matrix_free(_covar);
gsl_vector_free(_result);
gsl_vector_free(_mean);
return;
}
/*===========================RANDOM SCALAR/VECTOR/MATRIX=========================*/
void
gslu_rand_gaussian_vector (const gsl_rng *r, gsl_vector *a,
const gsl_vector *mu, const gsl_matrix *Sigma, const gsl_matrix *L)
{
assert (a->size == mu->size && (Sigma || L));
for (size_t i=0; i<a->size; i++)
gsl_vector_set (a, i, gsl_ran_gaussian_ziggurat (r, 1.0));
if (L) {
assert (L->size1 == L->size2 && L->size1 == mu->size);
gsl_blas_dtrmv (CblasLower, CblasNoTrans, CblasNonUnit, L, a);
} else {
assert (Sigma->size1 == Sigma->size2 && Sigma->size1 == mu->size);
gsl_matrix *_L = gsl_matrix_alloc (Sigma->size1, Sigma->size2);
gsl_matrix_memcpy (_L, Sigma);
gsl_linalg_cholesky_decomp (_L);
gsl_blas_dtrmv (CblasLower, CblasNoTrans, CblasNonUnit, _L, a);
gsl_matrix_free (_L);
}
gsl_vector_add (a, mu);
}
int rmvnorm(const gsl_rng *r, const unsigned int n, const gsl_matrix *Sigma, gsl_vector *randeffect)
{
unsigned int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work, Sigma);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set(randeffect, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, randeffect);
gsl_matrix_free(work);
return 0;
}
int ran_mv_t(const gsl_rng *r, const gsl_vector *mu,
const gsl_matrix *Sigma, const double nu, gsl_vector *x)
{
const int k = mu->size;
gsl_matrix *A = gsl_matrix_alloc(k, k);
double v;
v = gsl_ran_chisq(r, nu);
gsl_matrix_memcpy(A, Sigma);
gsl_linalg_cholesky_decomp(A);
ran_mv_normal(r, mu, Sigma, x);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, A, x);
gsl_vector_scale(x, 1/sqrt(v));
gsl_vector_add(x, mu);
gsl_matrix_free(A);
return 0;
}
int ran_mv_normal(const gsl_rng *r, const gsl_vector *mu,
const gsl_matrix *Sigma, gsl_vector *x)
{
const int k = mu->size;
int i;
gsl_matrix *A = gsl_matrix_alloc(k, k);
gsl_matrix_memcpy(A, Sigma);
gsl_linalg_cholesky_decomp(A);
for (i=0; i<k; i++)
{
gsl_vector_set(x, i, gsl_ran_gaussian(r, 1));
}
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, A, x);
gsl_vector_add(x, mu);
gsl_matrix_free(A);
return 0;
}
/**
* Adapted from: Multivariate Normal density function and random
* number generator Using GSL from Ralph dos Santos Silva
* Copyright (C) 2006
* multivariate normal distribution random number generator
*
* @param n dimension of the random vetor
* @param mean vector of means of size n
* @param var variance matrix of dimension n x n
* @param result output variable with a sigle random vector normal distribution generation
*/
int ssm_rmvnorm(const gsl_rng *r, const int n, const gsl_vector *mean, const gsl_matrix *var, double sd_fac, gsl_vector *result)
{
int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work,var);
//scale var with sd_fac^2
gsl_matrix_scale(work, sd_fac*sd_fac);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result);
gsl_vector_add(result,mean);
gsl_matrix_free(work);
return 0;
}
int rmvt(const gsl_rng *r, const unsigned int n, const gsl_vector *location, const gsl_matrix *scale, const unsigned int dof, gsl_vector *result)
{
unsigned int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
double ax = 0.5*dof;
ax = gsl_ran_gamma(r,ax,(1/ax)); /* gamma distribution */
gsl_matrix_memcpy(work,scale);
gsl_matrix_scale(work,(1/ax)); /* scaling the matrix */
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result);
gsl_vector_add(result, location);
gsl_matrix_free(work);
return 0;
}
/**
* C++ version of gsl_blas_dtrmv().
* @param Uplo Upper or lower triangular
* @param TransA Transpose type
* @param Diag Diagonal type
* @param A A matrix
* @param X A vector
* @return Error code on failure
*/
int dtrmv( CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag,
matrix const& A, vector& X ){
return gsl_blas_dtrmv( Uplo, TransA, Diag, A.get(), X.get() ); }
static int
triangular_inverse(CBLAS_UPLO_t Uplo, CBLAS_DIAG_t Diag, gsl_matrix * T)
{
const size_t N = T->size1;
if (N != T->size2)
{
GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
}
else
{
gsl_matrix_view m;
gsl_vector_view v;
size_t i;
if (Uplo == CblasUpper)
{
for (i = 0; i < N; ++i)
{
double aii;
if (Diag == CblasNonUnit)
{
double *Tii = gsl_matrix_ptr(T, i, i);
*Tii = 1.0 / *Tii;
aii = -(*Tii);
}
else
{
aii = -1.0;
}
if (i > 0)
{
m = gsl_matrix_submatrix(T, 0, 0, i, i);
v = gsl_matrix_subcolumn(T, i, 0, i);
gsl_blas_dtrmv(CblasUpper, CblasNoTrans, Diag,
&m.matrix, &v.vector);
gsl_blas_dscal(aii, &v.vector);
}
} /* for (i = 0; i < N; ++i) */
}
else
{
for (i = 0; i < N; ++i)
{
double ajj;
size_t j = N - i - 1;
if (Diag == CblasNonUnit)
{
double *Tjj = gsl_matrix_ptr(T, j, j);
*Tjj = 1.0 / *Tjj;
ajj = -(*Tjj);
}
else
{
ajj = -1.0;
}
if (j < N - 1)
{
m = gsl_matrix_submatrix(T, j + 1, j + 1,
N - j - 1, N - j - 1);
v = gsl_matrix_subcolumn(T, j, j + 1, N - j - 1);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, Diag,
&m.matrix, &v.vector);
gsl_blas_dscal(ajj, &v.vector);
}
} /* for (i = 0; i < N; ++i) */
}
return GSL_SUCCESS;
}
}
/* Draw one sample from the Markov Chain using the RMHMC algorithm.
* Arguments:
* kernel: a pointer to the RMHMC kernel data structure.
* Result:
* returns zero for success and non-zero for failure.
* the new sample is directly updated in kernel->x.
* acc is set to 0 if the chain in the previous state (reject)
* and 1 if the chain made a transition to a new state (accept)
*/
static int rmhmc_kernel_sample(mcmc_kernel* kernel, int* acc){
rmhmc_params* state = (rmhmc_params*) kernel->kernel_params;
rmhmc_model* model = (rmhmc_model*) kernel->model_function;
gsl_rng* rng = (gsl_rng*) kernel->rng;
int N = kernel->N;
double stepSize = state->stepsize;
int fIt = state->fIt;
/* sample momentum variables from multivariate normal with covariance Mx */
double* p = state->momentum;
int d;
for (d = 0; d < N; d++)
p[d] = gsl_ran_ugaussian(rng);
gsl_vector_view p_v = gsl_vector_view_array(state->momentum, N);
gsl_matrix_view cholM_v = gsl_matrix_view_array(state->cholMx, N, N);
/* p = cholM*p */
gsl_blas_dtrmv (CblasUpper, CblasTrans, CblasNonUnit, &cholM_v.matrix, &p_v.vector);
/* randomise direction of integration */
double randDir = gsl_rng_uniform(rng);
if (randDir > 0.5)
stepSize = -1.0*stepSize;
/* randomise number of leap-frog steps */
int L = 1 + gsl_rng_uniform_int(rng, state->mL);
/* Generalised leap-frog integrator */
copyStateVariables(state, kernel);
gsl_vector_view new_p_v = gsl_vector_view_array(state->new_momentum, N);
gsl_vector_view tmpVect = gsl_vector_view_array(state->p0, N);
int l;
int flag = 0;
for (l = 0; l < L; l++) {
/* momentum Newton update */
/* temp copy of momentum variables */
gsl_vector_memcpy(&tmpVect.vector, &new_p_v.vector);
momentumNewtonUpdate(state, state->p0, fIt, N, stepSize);
/* parameters Newton update */
flag = parametersNewtonUpdate(state, model, N, stepSize);
if (flag != 0){
fprintf(stderr,"RMHMC: Error in parameter Newton update. Reject step.\n");
*acc = 0;
return flag;
}
/* single Newton update step for momentum variables */
momentumNewtonUpdate(state, state->new_momentum, 1, N, stepSize);
}
/* calculate Hamiltonian energy for current state */
double H_c = calculateHamiltonian(N, state->fx, state->cholMx, state->invMx, state->momentum, state);
/* calculate Hamiltonian energy for proposed state */
double H_p = calculateHamiltonian(N, state->new_fx, state->new_cholMx, state->new_invMx, state->new_momentum, state);
/* Accept/reject using Metropolis-Hastings ratio */
double mh_ratio = H_p - H_c;
double rand_dec = log(gsl_rng_uniform(rng));
if ( (mh_ratio > 0.0)||(mh_ratio > rand_dec) ) {
*acc = 1;
double* tmp;
SWAP(kernel->x, state->new_x, tmp);
SWAP(state->dfx, state->new_dfx, tmp);
SWAP(state->cholMx, state->new_cholMx, tmp);
SWAP(state->invMx, state->new_invMx, tmp);
SWAP(state->dMx, state->new_dMx, tmp);
state->fx = state->new_fx;
}else {
*acc = 0;
}
return 0;
}