double gsl_ran_tdist (const gsl_rng * r, const double nu) { if (nu <= 2) { double Y1 = gsl_ran_ugaussian (r); double Y2 = gsl_ran_chisq (r, nu); double t = Y1 / sqrt (Y2 / nu); return t; } else { double Y1, Y2, Z, t; do { Y1 = gsl_ran_ugaussian (r); Y2 = gsl_ran_exponential (r, 1 / (nu/2 - 1)); Z = Y1 * Y1 / (nu - 2); } while (1 - Z < 0 || exp (-Y2 - Z) > (1 - Z)); /* Note that there is a typo in Knuth's formula, the line below is taken from the original paper of Marsaglia, Mathematics of Computation, 34 (1980), p 234-256 */ t = Y1 / sqrt ((1 - 2 / nu) * (1 - Z)); return t; } }
int main(void) { const gsl_rng_type * T; gsl_rng * r; struct data ntuple_row; int i; gsl_ntuple *ntuple = gsl_ntuple_create("test.dat", &ntuple_row, sizeof(ntuple_row)); gsl_rng_env_setup(); T = gsl_rng_default; r = gsl_rng_alloc(T); for (i = 0; i < 10000; i++) { ntuple_row.x = gsl_ran_ugaussian(r); ntuple_row.y = gsl_ran_ugaussian(r); ntuple_row.z = gsl_ran_ugaussian(r); gsl_ntuple_write(ntuple); } gsl_ntuple_close(ntuple); gsl_rng_free(r); return EXIT_SUCCESS; }
int main(int argc, char **argv) { int M = atoi(argv[1]); int N = atoi(argv[2]); printf("%d %d\n", M, N); gsl_rng *rng; const gsl_rng_type *rngType; gsl_rng_env_setup(); rngType = gsl_rng_default; rng = gsl_rng_alloc(rngType); gsl_matrix *A = gsl_matrix_alloc(M, N); int i = 0; int j = 0; for (i = 0; i < M; i++) #pragma omp parallel for for (j = 0; j < N; j++) gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng)); double *A1 = (double*) A; printf("%e\n", A1[(xkM*N/2)]); return 0; }
void make_random_unit_quaternion(gsl_vector *Q, gsl_rng *rng) { /* This comes from Graphics Gems III p. 129. */ for (size_t i = 0; i < 4; i++) gsl_vector_set(Q, i, gsl_ran_ugaussian(rng)); vector_normalize(Q); }
int main (int argc, char **argv) { int i; const gsl_rng_type *rngType; gsl_rng *rng; gsl_rng_env_setup(); rngType = gsl_rng_default; rng = gsl_rng_alloc(rngType); double a[16]; for (i = 0; i < 16; i++) { a[i] = gsl_ran_ugaussian(rng); printf("%e\n", a[i]); } double z[30]; gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc(16); gsl_poly_complex_solve(a, 16, w, z); gsl_poly_complex_workspace_free(w); for (i = 0; i < 30; i++) { printf("z%d = %+.18f %+.18f\n", i, z[2*i], z[2*i+1]); } gsl_rng_free(rng); return 0; }
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; }
/* 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; } }
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 gsl_vector_step_random(const gsl_rng* r, gsl_vector* v, const double step_size) { const size_t n = v->size; gsl_vector* vp = gsl_vector_alloc(n); // Set normal distributed random numbers as elements of v_new and // compute the euclidean norm of this vector. double length = 0.; for (size_t i = 0; i < n; ++i) { double* vp_i = gsl_vector_ptr(vp, i); *vp_i = gsl_ran_ugaussian(r); length += pow(*vp_i, 2); } length = sqrt(length); // Scale vp so that the elements of vp are uniformly distributed // within an n-sphere of radius step_size. const double scale = pow(pow(step_size, boost::numeric_cast<int>(n)) * gsl_rng_uniform_pos(r), 1.0/n) / length; gsl_vector_scale(vp, scale); gsl_vector_add(v, vp); }
int main(int argc, char **argv) { int M = atoi(argv[1]); int N = atoi(argv[2]); gsl_rng *rng; const gsl_rng_type *rngType; gsl_rng_env_setup(); rngType = gsl_rng_default; rng = gsl_rng_alloc(rngType); gsl_matrix *A = gsl_matrix_alloc(M, N); int i = 0; int j = 0; for (i = 0; i < M; i++) for (j = 0; j < N; j++) gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng)); gsl_matrix *U = gsl_matrix_alloc(max(M,N), min(M,N)); gsl_vector *s = gsl_vector_alloc(min(M, N)); gsl_matrix *V = gsl_matrix_alloc(min(M, N), N); if (!(gsl_clapack_dgesdd_(A, U, s, V) == 0)) printf("Error!\n"); printf("%e\n", gsl_matrix_get(U, 20, 20)); gsl_rng_free(rng); return 0; }
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); }
double* gsl_runorm(gsl_rng *r, const int n) { double *x = malloc(n * sizeof(double)); #pragma omp parallel for schedule(static), num_threads(2) for (int i = 0; i < n; i++) { x[i] = gsl_ran_ugaussian(r); } return x; };
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; }
int main(int argc, char** argv) { const gsl_rng_type *rngType; gsl_rng_env_setup(); rngType = gsl_rng_default; rng = gsl_rng_alloc(rngType); int matrixSize1 = atoi(argv[1]); int matrixSize2 = atoi(argv[2]); #ifdef DEBUG printf("%5d %5d\n", matrixSize1, matrixSize2); #endif gsl_matrix *dataSet = gsl_matrix_alloc(matrixSize1, matrixSize2); int i = 0; int j = 0; #ifdef DEBUG printf("Generating......."); #endif for (i= 0; i < matrixSize1; i++) { for (j = 0; j < matrixSize2; j++) { gsl_matrix_set(dataSet, i, j, gsl_ran_ugaussian(rng)); #ifdef DEBUG printf("%e\n", gsl_matrix_get(dataSet, i, j)); #endif } } #ifdef DEBUG printf("OK!\n"); #endif gsl_matrix *svdVmatrix = gsl_matrix_alloc(matrixSize2, matrixSize2); gsl_vector *svdSvector = gsl_vector_alloc(matrixSize2); gsl_vector *svdWorkspace = gsl_vector_alloc(matrixSize2); #ifdef DEBUG for (j = 0; j < matrixSize2; j++) printf("%e\n", gsl_matrix_get(dataSet, 5, j)); #endif if (!(gsl_linalg_SV_decomp(dataSet, svdVmatrix, svdSvector, svdWorkspace) == 0)) printf("Error!\n"); gsl_rng_free(rng); return 0; }
void runTrial(int T, double mu, double sigma, double deltat, gsl_rng* r,int n){ std::ofstream file; if(n==1) file.open("task10_t1.dat"); if(n==2) file.open("task10_t2.dat"); int M=T/deltat; double w1[M+1], w2[M+1], w3[M+1],s1[M+1], s2[M+1], s3[M+1]; s1[0]=10; s2[0]=10; s3[0]=10; w1[0]=gsl_ran_ugaussian(r); w2[0]=gsl_ran_ugaussian(r); w3[0]=gsl_ran_ugaussian(r); file << "#deltat w1 w2 w3 s1 s2 s3\n"; file << "0 " << w1[0]<< " " << w2[0] << " " << w3[0] << " " << s1[0] <<" " << s2[0] <<" " <<s3[0] <<" "<< "\n"; for(int i=1;i<=M;i++){ w1[i]=w1[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r); w2[i]=w2[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r); w3[i]=w3[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r); s1[i]=s1[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w1[i]); s2[i]=s2[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w2[i]); s3[i]=s3[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w3[i]); file << i*deltat << " " <<w1[i]<<" " <<w2[i]<<" " <<w3[i]<< " " << s1[i] <<" " << s2[i]<<" " << s3[i]<< "\n"; } file.close(); }
int semirmvnorm(const gsl_rng *rnd, const unsigned int n, const gsl_matrix *Sigma, gsl_vector *randeffect) { unsigned int k, r=0; double lambda; gsl_matrix *work = gsl_matrix_alloc(n,n); gsl_matrix_memcpy(work, Sigma); // replace cholesky with eigen decomposition gsl_eigen_symmv_workspace * w = gsl_eigen_symmv_alloc (n); gsl_vector *eval=gsl_vector_alloc (n); gsl_matrix *evec=gsl_matrix_alloc (n, n); // work = evec*diag(eval)*t(evec) gsl_eigen_symmv (work, eval, evec, w); // displayvector (eval, "eigen values of work"); // displaymatrix (evec, "eigen vector of work"); for (k=0; k<n; k++) { gsl_vector_view evec_i=gsl_matrix_column(evec, k); lambda=gsl_vector_get(eval, k); if (lambda>10e-10){ // non-zero variables // U = t(eval(r)*evec(:, r)) gsl_vector_scale (&evec_i.vector, sqrt(lambda)); // copy U to work gsl_matrix_set_col(work, r, &evec_i.vector); r++; } } // printf("r=%d.\n", r); gsl_matrix_view U=gsl_matrix_submatrix (work, 0, 0, n, r); // displaymatrix (&U.matrix, "partial eigen vectors"); // generate standard normal vector gsl_vector *z=gsl_vector_alloc(r); for(k=0; k<r; k++) gsl_vector_set( z, k, gsl_ran_ugaussian(rnd) ); // displayvector (z, "z"); // X_i = mu_i + t(U)*z gsl_blas_dgemv (CblasNoTrans, 1.0, &U.matrix, z, 0.0, randeffect); // displayvector (randeffect, "randeffect"); gsl_matrix_free(work); gsl_eigen_symmv_free(w); gsl_matrix_free(evec); gsl_vector_free(eval); gsl_vector_free(z); return 0; }
int rwishart(const gsl_rng *r, const unsigned int n, const unsigned int dof, const gsl_matrix *scale, gsl_matrix *result) { unsigned int k,l; gsl_matrix *work = gsl_matrix_calloc(n,n); for(k=0; k<n; k++){ gsl_matrix_set( work, k, k, sqrt( gsl_ran_chisq( r, (dof-k) ) ) ); for(l=0; l<k; l++) gsl_matrix_set( work, k, l, gsl_ran_ugaussian(r) ); } gsl_matrix_memcpy(result,scale); gsl_linalg_cholesky_decomp(result); gsl_blas_dtrmm(CblasLeft,CblasLower,CblasNoTrans,CblasNonUnit,1.0,result,work); gsl_blas_dsyrk(CblasUpper,CblasNoTrans,1.0,work,0.0,result); return 0; }
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; }
double simulation(int T, int M, int S0, int K, double sigma, double r,gsl_rng* rng){ double w[M+1],s[M+1]; double dt=(double)T/M; s[0]=S0; w[0]=0; double prod=1; for(int i=1;i<=M;i++){ w[i]=w[i-1]+sqrt(dt)*gsl_ran_ugaussian(rng); s[i]=s[0]*exp((r-0.5*sigma*sigma)*i*dt+sigma*w[i]); prod*=s[i]; } //printf("%f %f\n",prod,std::max(pow(prod,1./M)-K,(double)0)); return std::max(pow(prod,1./M)-K,(double)0); }
void satellite(Halo const * const h, Particle* const g) { #ifdef DEBUG assert(random_generator); assert(solver); #endif const double a= 1.0/(1.0 + h->z); const double rho_m= cosmology_rho_m()/(a*a*a); // physical [1/h Mpc]^-3 const double r200m= 1000.0*pow(h->M/(4.0*M_PI/3.0*200.0*rho_m), 1.0/3.0); // physical 1/h kpc const double c200m= r200m/h->rs; //fprintf(stderr, "r200m c rs %e %e %e\n", r200m, c200m, h->rs); // draw random mass M(r)/M0 between [0, f(c200m)] const double fmax= f(c200m); const double fx= fmax*gsl_rng_uniform(random_generator); // solve for f(x) = fx, where x= r/r_s double x= c200m*fx/fmax; // initial guess x= f_inverse(fx, x); double r_sat= x*h->rs; // location of the satellite from center // compute vrms(r) double vrms= compute_v_rms(r_sat, h->M, r200m, c200m); r_sat= r_sat/(1000.0f*a); // physical /h kpc -> comoving /h Mpc float e[3]; random_direction(e); // satellite x v contains only offset from halo g->x[0] = r_sat*e[0]; g->x[1] = r_sat*e[1]; g->x[2] = r_sat*e[2]; g->vr= vrms*gsl_ran_ugaussian(random_generator); }
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; }
/** * 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 main (int argc, char *argv[]) { size_t i,j; size_t n = 0; double mu = 0, nu = 0, nu1 = 0, nu2 = 0, sigma = 0, a = 0, b = 0, c = 0; double zeta = 0, sigmax = 0, sigmay = 0, rho = 0; double p = 0; double x = 0, y =0, z=0 ; unsigned int N = 0, t = 0, n1 = 0, n2 = 0 ; unsigned long int seed = 0 ; const char * name ; gsl_rng * r ; if (argc < 4) { printf ( "Usage: gsl-randist seed n DIST param1 param2 ...\n" "Generates n samples from the distribution DIST with parameters param1,\n" "param2, etc. Valid distributions are,\n" "\n" " beta\n" " binomial\n" " bivariate-gaussian\n" " cauchy\n" " chisq\n" " dir-2d\n" " dir-3d\n" " dir-nd\n" " erlang\n" " exponential\n" " exppow\n" " fdist\n" " flat\n" " gamma\n" " gaussian-tail\n" " gaussian\n" " geometric\n" " gumbel1\n" " gumbel2\n" " hypergeometric\n" " laplace\n" " landau\n" " levy\n" " levy-skew\n" " logarithmic\n" " logistic\n" " lognormal\n" " negative-binomial\n" " pareto\n" " pascal\n" " poisson\n" " rayleigh-tail\n" " rayleigh\n" " tdist\n" " ugaussian-tail\n" " ugaussian\n" " weibull\n") ; exit (0); } argv++ ; seed = atol (argv[0]); argc-- ; argv++ ; n = atol (argv[0]); argc-- ; argv++ ; name = argv[0] ; argc-- ; argc-- ; gsl_rng_env_setup() ; if (gsl_rng_default_seed != 0) { fprintf(stderr, "overriding GSL_RNG_SEED with command line value, seed = %ld\n", seed) ; } gsl_rng_default_seed = seed ; r = gsl_rng_alloc(gsl_rng_default) ; #define NAME(x) !strcmp(name,(x)) #define OUTPUT(x) for (i = 0; i < n; i++) { printf("%g\n", (x)) ; } #define OUTPUT1(a,x) for(i = 0; i < n; i++) { a ; printf("%g\n", x) ; } #define OUTPUT2(a,x,y) for(i = 0; i < n; i++) { a ; printf("%g %g\n", x, y) ; } #define OUTPUT3(a,x,y,z) for(i = 0; i < n; i++) { a ; printf("%g %g %g\n", x, y, z) ; } #define INT_OUTPUT(x) for (i = 0; i < n; i++) { printf("%d\n", (x)) ; } #define ARGS(x,y) if (argc != x) error(y) ; #define DBL_ARG(x) if (argc) { x=atof((++argv)[0]);argc--;} else {error( #x);}; #define INT_ARG(x) if (argc) { x=atoi((++argv)[0]);argc--;} else {error( #x);}; if (NAME("bernoulli")) { ARGS(1, "p = probability of success"); DBL_ARG(p) INT_OUTPUT(gsl_ran_bernoulli (r, p)); } else if (NAME("beta")) { ARGS(2, "a,b = shape parameters"); DBL_ARG(a) DBL_ARG(b) OUTPUT(gsl_ran_beta (r, a, b)); } else if (NAME("binomial")) { ARGS(2, "p = probability, N = number of trials"); DBL_ARG(p) INT_ARG(N) INT_OUTPUT(gsl_ran_binomial (r, p, N)); } else if (NAME("cauchy")) { ARGS(1, "a = scale parameter"); DBL_ARG(a) OUTPUT(gsl_ran_cauchy (r, a)); } else if (NAME("chisq")) { ARGS(1, "nu = degrees of freedom"); DBL_ARG(nu) OUTPUT(gsl_ran_chisq (r, nu)); } else if (NAME("erlang")) { ARGS(2, "a = scale parameter, b = order"); DBL_ARG(a) DBL_ARG(b) OUTPUT(gsl_ran_erlang (r, a, b)); } else if (NAME("exponential")) { ARGS(1, "mu = mean value"); DBL_ARG(mu) ; OUTPUT(gsl_ran_exponential (r, mu)); } else if (NAME("exppow")) { ARGS(2, "a = scale parameter, b = power (1=exponential, 2=gaussian)"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_exppow (r, a, b)); } else if (NAME("fdist")) { ARGS(2, "nu1, nu2 = degrees of freedom parameters"); DBL_ARG(nu1) ; DBL_ARG(nu2) ; OUTPUT(gsl_ran_fdist (r, nu1, nu2)); } else if (NAME("flat")) { ARGS(2, "a = lower limit, b = upper limit"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_flat (r, a, b)); } else if (NAME("gamma")) { ARGS(2, "a = order, b = scale"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_gamma (r, a, b)); } else if (NAME("gaussian")) { ARGS(1, "sigma = standard deviation"); DBL_ARG(sigma) ; OUTPUT(gsl_ran_gaussian (r, sigma)); } else if (NAME("gaussian-tail")) { ARGS(2, "a = lower limit, sigma = standard deviation"); DBL_ARG(a) ; DBL_ARG(sigma) ; OUTPUT(gsl_ran_gaussian_tail (r, a, sigma)); } else if (NAME("ugaussian")) { ARGS(0, "unit gaussian, no parameters required"); OUTPUT(gsl_ran_ugaussian (r)); } else if (NAME("ugaussian-tail")) { ARGS(1, "a = lower limit"); DBL_ARG(a) ; OUTPUT(gsl_ran_ugaussian_tail (r, a)); } else if (NAME("bivariate-gaussian")) { ARGS(3, "sigmax = x std.dev., sigmay = y std.dev., rho = correlation"); DBL_ARG(sigmax) ; DBL_ARG(sigmay) ; DBL_ARG(rho) ; OUTPUT2(gsl_ran_bivariate_gaussian (r, sigmax, sigmay, rho, &x, &y), x, y); } else if (NAME("dir-2d")) { OUTPUT2(gsl_ran_dir_2d (r, &x, &y), x, y); } else if (NAME("dir-3d")) { OUTPUT3(gsl_ran_dir_3d (r, &x, &y, &z), x, y, z); } else if (NAME("dir-nd")) { double *xarr; ARGS(1, "n1 = number of dimensions of hypersphere"); INT_ARG(n1) ; xarr = (double *)malloc(n1*sizeof(double)); for(i = 0; i < n; i++) { gsl_ran_dir_nd (r, n1, xarr) ; for (j = 0; j < n1; j++) { if (j) putchar(' '); printf("%g", xarr[j]) ; } putchar('\n'); } ; free(xarr); } else if (NAME("geometric")) { ARGS(1, "p = bernoulli trial probability of success"); DBL_ARG(p) ; INT_OUTPUT(gsl_ran_geometric (r, p)); } else if (NAME("gumbel1")) { ARGS(2, "a = order, b = scale parameter"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_gumbel1 (r, a, b)); } else if (NAME("gumbel2")) { ARGS(2, "a = order, b = scale parameter"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_gumbel2 (r, a, b)); } else if (NAME("hypergeometric")) { ARGS(3, "n1 = tagged population, n2 = untagged population, t = number of trials"); INT_ARG(n1) ; INT_ARG(n2) ; INT_ARG(t) ; INT_OUTPUT(gsl_ran_hypergeometric (r, n1, n2, t)); } else if (NAME("laplace")) { ARGS(1, "a = scale parameter"); DBL_ARG(a) ; OUTPUT(gsl_ran_laplace (r, a)); } else if (NAME("landau")) { ARGS(0, "no arguments required"); OUTPUT(gsl_ran_landau (r)); } else if (NAME("levy")) { ARGS(2, "c = scale, a = power (1=cauchy, 2=gaussian)"); DBL_ARG(c) ; DBL_ARG(a) ; OUTPUT(gsl_ran_levy (r, c, a)); } else if (NAME("levy-skew")) { ARGS(3, "c = scale, a = power (1=cauchy, 2=gaussian), b = skew"); DBL_ARG(c) ; DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_levy_skew (r, c, a, b)); } else if (NAME("logarithmic")) { ARGS(1, "p = probability"); DBL_ARG(p) ; INT_OUTPUT(gsl_ran_logarithmic (r, p)); } else if (NAME("logistic")) { ARGS(1, "a = scale parameter"); DBL_ARG(a) ; OUTPUT(gsl_ran_logistic (r, a)); } else if (NAME("lognormal")) { ARGS(2, "zeta = location parameter, sigma = scale parameter"); DBL_ARG(zeta) ; DBL_ARG(sigma) ; OUTPUT(gsl_ran_lognormal (r, zeta, sigma)); } else if (NAME("negative-binomial")) { ARGS(2, "p = probability, a = order"); DBL_ARG(p) ; DBL_ARG(a) ; INT_OUTPUT(gsl_ran_negative_binomial (r, p, a)); } else if (NAME("pareto")) { ARGS(2, "a = power, b = scale parameter"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_pareto (r, a, b)); } else if (NAME("pascal")) { ARGS(2, "p = probability, n = order (integer)"); DBL_ARG(p) ; INT_ARG(N) ; INT_OUTPUT(gsl_ran_pascal (r, p, N)); } else if (NAME("poisson")) { ARGS(1, "mu = scale parameter"); DBL_ARG(mu) ; INT_OUTPUT(gsl_ran_poisson (r, mu)); } else if (NAME("rayleigh")) { ARGS(1, "sigma = scale parameter"); DBL_ARG(sigma) ; OUTPUT(gsl_ran_rayleigh (r, sigma)); } else if (NAME("rayleigh-tail")) { ARGS(2, "a = lower limit, sigma = scale parameter"); DBL_ARG(a) ; DBL_ARG(sigma) ; OUTPUT(gsl_ran_rayleigh_tail (r, a, sigma)); } else if (NAME("tdist")) { ARGS(1, "nu = degrees of freedom"); DBL_ARG(nu) ; OUTPUT(gsl_ran_tdist (r, nu)); } else if (NAME("weibull")) { ARGS(2, "a = scale parameter, b = exponent"); DBL_ARG(a) ; DBL_ARG(b) ; OUTPUT(gsl_ran_weibull (r, a, b)); } else { fprintf(stderr,"Error: unrecognized distribution: %s\n", name) ; } return 0 ; }
int GlmTest::resampNonCase(glm *model, gsl_matrix *bT, unsigned int i) { unsigned int j, k, id; double bt, score, yij, mij; gsl_vector_view yj; unsigned int nRows=tm->nRows, nVars=tm->nVars; // note that residuals have got means subtracted switch (tm->resamp) { case RESIBOOT: if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { if (bootID!=NULL) id = (unsigned int) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) id = (unsigned int) gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) nRows * Rf_runif(0, 1); // bY = mu+(bootr*sqrt(variance)) for (k=0; k<nVars; k++) { bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k); bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } if (tm->reprand!=TRUE) PutRNGstate(); break; case SCOREBOOT: for (j=0; j<nRows; j++) { if (bootID!=NULL) score = (double) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) score = gsl_ran_ugaussian (rnd); else score = Rf_rnorm(0.0, 1.0); // bY = mu + score*sqrt(variance) for (k=0; k<nVars; k++){ bt=gsl_matrix_get(model->Mu, j, k)+sqrt(gsl_matrix_get(model->Var, j, k))*gsl_matrix_get(model->Res, j, k)*score; bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } break; case PERMUTE: if (bootID==NULL) gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int)); for (j=0; j<nRows; j++) { if (bootID==NULL) id = permid[j]; else id = (unsigned int) gsl_matrix_get(bootID, i, j); // bY = mu + bootr * sqrt(var) for (k=0; k<nVars; k++) { bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k); bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } break; case FREEPERM: if (bootID==NULL) gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int)); for (j=0; j<nRows; j++) { if (bootID==NULL) id = permid[j]; else id = (unsigned int) gsl_matrix_get(bootID, i, j); yj=gsl_matrix_row(model->Yref, id); gsl_matrix_set_row (bT, j, &yj.vector); } break; case MONTECARLO: McSample(model, rnd, XBeta, Sigma, bT); break; case PITSBOOT: if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { if (bootID!=NULL) id = (unsigned int) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) id = (unsigned int) gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) Rf_runif(0, nRows); for (k=0; k<nVars; k++) { bt = gsl_matrix_get(model->PitRes, id, k); mij = gsl_matrix_get(model->Mu, j, k); yij = model->cdfinv(bt, mij, model->theta[k]); gsl_matrix_set(bT, j, k, yij); } } if (tm->reprand!=TRUE) PutRNGstate(); break; default: GSL_ERROR("The resampling method is not supported", GSL_ERANGE); break; } return SUCCESS; }
int main(int argc, char **argv) { gsl_rng *rng; gsl_rng_env_setup(); const gsl_rng_type *rngType = gsl_rng_default; rng = gsl_rng_alloc(rngType); const size_t M = SIZE1; const size_t N = SIZE2; gsl_matrix *A = gsl_matrix_alloc(M, N); int i = 0; int j = 0; int sigNum = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng)); } } gsl_matrix *B = gsl_matrix_alloc(M, N); gsl_matrix_memcpy(B, A); gsl_matrix *C = gsl_matrix_alloc(M, N); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, A, B, 0.0, C); gsl_matrix *D = gsl_matrix_alloc(M, N); gsl_matrix_memcpy(D, C); // will be used in QTQ' decompostion gsl_linalg_cholesky_decomp(C); printf("%e\n", gsl_matrix_get(C, M/2, N/2)); gsl_matrix_free(B); gsl_matrix *A1 = gsl_matrix_alloc(M, N); gsl_matrix_memcpy(A1, A); gsl_permutation *P = gsl_permutation_alloc(M); // will be used in // other cases gsl_permutation_init(P); gsl_ran_shuffle (rng, P->data, M, sizeof(size_t)); gsl_linalg_LU_decomp(A1, P, &sigNum); printf("%e\n", gsl_matrix_get(A1, M/2, N/2)); gsl_matrix *A2 = gsl_matrix_alloc(M, N); gsl_matrix_memcpy(A2, A); gsl_vector *tau = gsl_vector_alloc(GSL_MIN(M, N)); gsl_linalg_QR_decomp(A2, tau); printf("%e\n", gsl_matrix_get(A2, M/2, N/2)); gsl_vector_free(tau); gsl_matrix *A3 = gsl_matrix_alloc(M, N); gsl_matrix_memcpy(A3, A); gsl_matrix *svdV = gsl_matrix_alloc(N, N); gsl_vector *svdS = gsl_vector_alloc(N); gsl_vector *svdWorkspace = gsl_vector_alloc(N); gsl_linalg_SV_decomp(A3, svdV, svdS, svdWorkspace); printf("%e\n", gsl_vector_get(svdS, N/2)); gsl_vector *tau2 = gsl_vector_alloc(N - 1); gsl_linalg_symmtd_decomp(D, tau2); printf("%e\n", gsl_matrix_get(D, N/2, N/2)); return 0; }
int AnovaTest::resampTest(void) { // printf("Start resampling test ...\n"); unsigned int i, j, p, id; unsigned int maxiter=mmRef->nboot; double hii, score; gsl_matrix *bX, *bY; bY = gsl_matrix_alloc(nRows, nVars); bX = gsl_matrix_alloc(nRows, nParam); // initialize permid unsigned int *permid=NULL; if ( bootID == NULL ) { if ( mmRef->resamp == PERMUTE ){ permid = (unsigned int *)malloc(nRows*sizeof(unsigned int)); for (i=0; i<nRows; i++) permid[i] = i; } } // else // displaymatrix(bootID, "bootID received"); // resampling options if (mmRef->resamp == CASEBOOT) { nSamp = 0; for (i=0; i<maxiter; i++) { for ( j=0; j<nRows; j++ ){ // resampling index if (bootID == NULL) id = gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) gsl_matrix_get(bootID, i, j); // resample Y and X gsl_vector_view Yj=gsl_matrix_row(Yref, id); gsl_matrix_set_row (bY, j, &Yj.vector); gsl_vector_view Xj=gsl_matrix_row(Xref, id); gsl_matrix_set_row (bX, j, &Xj.vector); } anovacase(bY, bX); nSamp++; } } else if (mmRef->resamp == RESIBOOT) { nSamp = 0; for (i=0; i<maxiter; i++) { for (p=1; p<nModels; p++) { if (mmRef->reprand!=TRUE) { GetRNGstate(); printf("reprand==FALSE\n"); } for (j=0; j<nRows; j++){ // resampling index if (bootID == NULL) id = gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) gsl_matrix_get(bootID, i, j); // bootr by resampling resi=(Y-fit) gsl_vector_view Yj=gsl_matrix_row(Yref, id); gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id); gsl_matrix_set_row (bY, j, &Yj.vector); gsl_vector_view bootr=gsl_matrix_row(bY, j); gsl_vector_sub (&bootr.vector, &Fj.vector); if (mmRef->student==TRUE) { hii = gsl_matrix_get(Hats[p].mat, id, id); gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii)); } // bY = Y + bootr Yj=gsl_matrix_row(Hats[p].Y, j); gsl_vector_add (&bootr.vector, &Yj.vector); } if (mmRef->reprand!=TRUE) PutRNGstate(); anovaresi(bY, p); } nSamp++; } } else if (mmRef->resamp == SCOREBOOT) { nSamp = 0; for (i=0; i<maxiter; i++) { for (p=1; p<nModels; p++) { for ( j=0; j<nRows; j++ ) { // random score if ( bootID == NULL ) score = gsl_ran_ugaussian (rnd); else score = (double)gsl_matrix_get(bootID, i, j); // bootr = (Y - fit)*score gsl_vector_view Yj=gsl_matrix_row(Yref, j); gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, j); gsl_matrix_set_row (bY, j, &Yj.vector); gsl_vector_view bootr=gsl_matrix_row(bY, j); gsl_vector_sub (&bootr.vector, &Fj.vector); if (mmRef->student==TRUE) { hii = gsl_matrix_get(Hats[p].mat, j, j); gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii)); } // bY = Y + bootr gsl_vector_scale (&bootr.vector, score); gsl_vector_add (&bootr.vector, &Fj.vector); } anovaresi(bY, p); } nSamp++; } } else if ( mmRef->resamp == PERMUTE ) { gsl_matrix_add_constant (Pstatj, 1.0); for (p=0; p<nModels-1; p++) Pmultstat[p]=1.0; // include itself nSamp = 1; for (i=0; i<maxiter-1; i++) { //999 for (p=1; p<nModels; p++){ if (bootID == NULL ) gsl_ran_shuffle(rnd, permid, nRows, sizeof(unsigned int)); // get bootr by permuting resi:Y-fit for (j=0; j<nRows; j++){ if (bootID == NULL) id = permid[j]; else id = (unsigned int) gsl_matrix_get(bootID, i, j); // bootr by resampling resi=(Y-fit) gsl_vector_view Yj=gsl_matrix_row(Yref, id); gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id); gsl_matrix_set_row (bY, j, &Yj.vector); gsl_vector_view bootr=gsl_matrix_row(bY, j); gsl_vector_sub (&bootr.vector, &Fj.vector); if (mmRef->student==TRUE) { hii = gsl_matrix_get(Hats[p].mat, id, id); gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii)); } // bY = Y + bootr Yj=gsl_matrix_row(Hats[p].Y, j); gsl_vector_add (&bootr.vector, &Yj.vector); } anovaresi(bY, p); } nSamp++; } } else GSL_ERROR("Invalid resampling option", GSL_EINVAL); // p-values unsigned int sid, sid0; double *pj; for (i=0; i<nModels-1; i++) { Pmultstat[i]=(double) (Pmultstat[i]+1)/(nSamp+1); // adjusted with +1 pj = gsl_matrix_ptr (Pstatj, i, 0); if ( mmRef->punit == FREESTEP ){ for (j=1; j<nVars; j++){ sid = gsl_permutation_get(sortid[i], j); sid0 = gsl_permutation_get(sortid[i], j-1); *(pj+sid)=MAX(*(pj+sid), *(pj+sid0)); } } if ( mmRef->punit == STEPUP ){ for (j=2; j<nVars; j++){ sid = gsl_permutation_get(sortid[i], nVars-j); sid0 = gsl_permutation_get(sortid[i], nVars-j+1); *(pj+sid) = MIN(*(pj+sid), *(pj+sid0)); } } for (j=0; j<nVars; j++) *(pj+j) = (double)(*(pj+j)+1)/(nSamp+1); // adjusted with +1 } // free memory gsl_matrix_free(bX); gsl_matrix_free(bY); if (permid!=NULL) free(permid); return 0; }
bool apply(LociData & d) { d.set_param("phenotype", (gsl_ran_ugaussian(d.rng()) + d.info("loci_meanshift"))); return true; }
double test_ugaussian (void) { return gsl_ran_ugaussian (r_global); }
void SampleNormedRndVecWBias(gsl_vector* opinion, double x, gsl_rng * r) { for (size_t i = 0; i < opinion->size ; i++) gsl_vector_set(opinion,i, x + gsl_ran_ugaussian(r) ); NormalizeGslVector(opinion); }
/* 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; }