//Wishart distribution random number generator int ran_wishart(const gsl_rng *r, const double nu, const gsl_matrix *V, gsl_matrix *X) { const int k = V->size1; int i, j; gsl_matrix *A = gsl_matrix_calloc(k, k); gsl_matrix *L = gsl_matrix_alloc(k, k); for(i=0; i<k; i++) { gsl_matrix_set(A, i, i, sqrt(gsl_ran_chisq(r, (nu-i)))); for (j=0; j<i; j++){ gsl_matrix_set(A, i, j, gsl_ran_gaussian(r, 1)); } } gsl_matrix_memcpy(L, V); gsl_linalg_cholesky_decomp(L); gsl_blas_dtrmm(CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, 1.0, L, A); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, A, A, 0.0, X); gsl_matrix_free(A); gsl_matrix_free(L); return 0; }
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; } }
void pplfunc_frandomcs (ppl_context *c, pplObj *in, int nArgs, int *status, int *errType, char *errText) { char *FunctionDescription = "chisq(nu)"; if (rndgen==NULL) { rndgen = gsl_rng_alloc(gsl_rng_default); gsl_rng_set(rndgen, 0); } OUTPUT.real = gsl_ran_chisq(rndgen, in[0].real); CHECK_OUTPUT_OKAY; }
void librdist_chisq(gsl_rng *rng, int argc, void *argv, int bufc, float *buf){ t_atom *av = (t_atom *)argv; if(argc != librdist_getnargs(ps_chisq)){ return; } const double nu = librdist_atom_getfloat(av); int i; for(i = 0; i < bufc; i++) buf[i] = (float)gsl_ran_chisq(rng, nu); }
extern double dist_chisq (struct _flow *flow, const double nu) { #ifdef HAVE_LIBGSL gsl_rng * r = flow->r; return gsl_ran_chisq(r, nu); #else /* not implemented */ UNUSED_ARGUMENT(flow); UNUSED_ARGUMENT(nu); return 0; #endif /* HAVE_LIBGSL */ }
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 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 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 ; }
void gen_rand_state_synth(double *const x, unsigned int N, gsl_rng *r, TMCMCParams ¶ms) { assert(N == 1 + params.N_DM + 4*params.N_stars); // R_V x[0] = 3.1 + gsl_ran_gaussian_ziggurat(r, 0.2); // Delta_EBV for(size_t i=0; i<params.N_DM; i++) { x[i+1] = params.data->EBV / (double)params.N_DM * gsl_ran_chisq(r, 1.); } // Stars TSED sed_tmp(true); for(size_t i = 1 + params.N_DM; i < 1 + params.N_DM + 4*params.N_stars; i += 4) { // DM x[i] = 5. + 13. * gsl_rng_uniform(r); // Stellar type double logMass, logtau, FeH, tau; bool in_lib = false; while(!in_lib) { logMass = gsl_ran_gaussian_ziggurat(r, 0.5); tau = -1.; while(tau <= 0.) { tau = 1.e9 * (5. + gsl_ran_gaussian_ziggurat(r, 2.)); } logtau = log10(tau); FeH = -1.0 + gsl_ran_gaussian_ziggurat(r, 1.); in_lib = params.synth_stellar_model->get_sed(logMass, logtau, FeH, sed_tmp); } x[i+1] = logMass; x[i+2] = logtau; x[i+3] = FeH; } }
void sample_model_synth(TGalacticLOSModel &galactic_model, TSyntheticStellarModel &stellar_model, TExtinctionModel &extinction_model, TStellarData &stellar_data) { unsigned int N_DM = 20; double DM_min = 5.; double DM_max = 20.; TMCMCParams params(&galactic_model, &stellar_model, NULL, &extinction_model, &stellar_data, N_DM, DM_min, DM_max); TMCMCParams params_tmp(&galactic_model, &stellar_model, NULL, &extinction_model, &stellar_data, N_DM, DM_min, DM_max); // Random number generator gsl_rng *r; seed_gsl_rng(&r); // Vector describing position in probability space size_t length = 1 + params.N_DM + 4*params.N_stars; // x = {RV, Delta_EBV_1, ..., Delta_EBV_M, Theta_1, ..., Theta_N}, where Theta = {DM, logMass, logtau, FeH}. double *x = new double[length]; // Random starting point for reddening profile x[0] = 3.1;// + gsl_ran_gaussian_ziggurat(r, 0.2); // RV for(size_t i=0; i<params.N_DM; i++) { x[i+1] = params.data->EBV / (double)N_DM * gsl_ran_chisq(r, 1.); } // Delta_EBV // Random starting point for each star TSED sed_tmp(true); for(size_t i = 1 + params.N_DM; i < 1 + params.N_DM + 4*params.N_stars; i += 4) { x[i] = 5. + 13.*gsl_rng_uniform(r); double logMass, logtau, FeH, tau; bool in_lib = false; while(!in_lib) { logMass = gsl_ran_gaussian_ziggurat(r, 0.5); tau = -1.; while(tau <= 0.) { tau = 1.e9 * (5. + gsl_ran_gaussian_ziggurat(r, 2.)); } logtau = log10(tau); FeH = -1.0 + gsl_ran_gaussian_ziggurat(r, 1.); in_lib = stellar_model.get_sed(logMass, logtau, FeH, sed_tmp); } x[i+1] = logMass; x[i+2] = logtau; x[i+3] = FeH; } params.update_EBV_interp(x); double *lnp_star = new double[params.N_stars]; double lnp_los = logP_los_synth(x, length, params, lnp_star); std::cerr << "# ln p(x_0) = " << lnp_los << std::endl; double *x_tmp = new double[length]; double Theta_tmp[4]; double sigma_Theta[4] = {0.1, 0.1, 0.1, 0.1}; double sigma_RV = 0.05; double sigma_lnEBV = 0.1; double lnp_tmp; double *lnp_star_tmp = new double[params.N_stars]; double p; unsigned int N_steps = 1000000; TChain chain(length, N_steps); TStats EBV_stats(N_DM); // In each step unsigned int N_star = 0; unsigned int N_accept_star = 0; unsigned int N_los = 0; unsigned int N_accept_los = 0; bool accept; bool burn_in = true; for(unsigned int i=0; i<N_steps; i++) { if(i == N_steps/2) { sigma_Theta[0] = 0.05; sigma_Theta[1] = 0.05; sigma_Theta[2] = 0.05; sigma_Theta[3] = 0.05; sigma_RV = 0.005; sigma_lnEBV = 0.05; burn_in = false; } // Step each star for(unsigned int n=0; n<params.N_stars; n++) { if(!burn_in) { N_star++; } rand_gaussian_vector(&Theta_tmp[0], &x[1+N_DM+4*n], &sigma_Theta[0], 4, r); lnp_tmp = logP_single_star_synth(&Theta_tmp[0], params.get_EBV(Theta_tmp[_DM]), x[0], galactic_model, stellar_model, extinction_model, stellar_data.star[n]); accept = false; if(lnp_tmp > lnp_star[n]) { accept = true; } else { p = gsl_rng_uniform(r); if((p > 0.) && (log(p) < lnp_tmp - lnp_star[n])) { accept = true; } } if(accept) { if(!burn_in) { N_accept_star++; } for(size_t k=0; k<4; k++) { x[1+N_DM+4*n+k] = Theta_tmp[k]; } lnp_los += lnp_tmp - lnp_star[n]; lnp_star[n] = lnp_tmp; } } // Step reddening profile if(!burn_in) { N_los++; } for(size_t k=0; k<length; k++) { x_tmp[k] = x[k]; } //if(!burn_in) { x_tmp[0] += gsl_ran_gaussian_ziggurat(r, sigma_RV); } for(unsigned int m=0; m<params.N_DM; m++) { x_tmp[1+m] += gsl_ran_gaussian_ziggurat(r, sigma_lnEBV); } params_tmp.update_EBV_interp(x_tmp); lnp_tmp = logP_los_synth(x_tmp, length, params_tmp, lnp_star_tmp); //if(isinf(lnp_tmp)) { // lnp_tmp = logP_los(x, length, params_tmp, lnp_star_tmp); //} //std::cerr << "# ln p(y) = " << lnp_tmp << std::endl; accept = false; if(lnp_tmp > lnp_los) { accept = true; } else if(log(gsl_rng_uniform(r)) < lnp_tmp - lnp_los) { accept = true; } if(accept) { if(!burn_in) { N_accept_los++; } for(size_t k=0; k<1+N_DM; k++) { x[k] = x_tmp[k]; } for(size_t k=0; k<params.N_stars; k++) { lnp_star[k] = lnp_star_tmp[k]; } lnp_los = lnp_tmp; params.update_EBV_interp(x); //std::cerr << "# ln p(x) = " << lnp_los << std::endl; } if(!burn_in) { chain.add_point(x, lnp_los, 1.); x_tmp[0] = exp(x[1]); for(size_t k=1; k<N_DM; k++) { x_tmp[k] = x_tmp[k-1] + exp(x[k]); } EBV_stats(x_tmp, 1); } } std::cerr << "# ln p(x) = " << lnp_los << std::endl; std::cout.precision(4); std::cerr << std::endl; std::cerr << "# % acceptance: " << 100. * (double)N_accept_star / (double)N_star << " (stars)" << std::endl; std::cerr << " " << 100. * (double)N_accept_los / (double)N_los << " (extinction)" << std::endl; std::cerr << "# R_V = " << x[0] << std::endl << std::endl; std::cerr << "# DM E(B-V)" << std::endl; std::cerr << "# =============" << std::endl; for(double DM=5.; DM<20.; DM+=1.) { std::cerr << "# " << DM << " " << params.get_EBV(DM) << std::endl; } std::cerr << std::endl; EBV_stats.print(); std::cerr << std::endl; delete[] x; delete[] x_tmp; delete[] lnp_star; delete[] lnp_star_tmp; }
double test_chisq (void) { return gsl_ran_chisq (r_global, 13.0); }
static long double wishart_ll(apop_data *in, apop_model *m){ Nullcheck_mpd(in, m, GSL_NAN); wishartstruct_t ws = { .paraminv = apop_matrix_inverse(m->parameters->matrix), .len = sqrt(in->matrix->size2), .df = m->parameters->vector->data[0] }; double paramdet = apop_matrix_determinant(m->parameters->matrix); if (paramdet < 1e-3) return GSL_NEGINF; double ll = apop_map_sum(in, .fn_vp = one_wishart_row, .param=&ws, .part='r'); double k = log(ws.df)*ws.df/2.; k -= M_LN2 * ws.len* ws.df/2.; k -= log(paramdet) * ws.df/2.; k -= apop_multivariate_lngamma(ws.df/2., ws.len); return ll + k*in->matrix->size1; } static int apop_wishart_draw(double *out, gsl_rng *r, apop_model *m){ /* Translated from the Fortran by BK. Fortran comments: C SUBROUTINE DWSHRT(D, N, NP, NNP, SB, SA) C C ALGORITHM AS 53 APPL. STATIST. (1972) VOL.21, NO.3 C C Wishart variate generator. On output, SA is an upper-triangular C matrix of size NP * NP [...] C whose elements have a Wishart(N, SIGMA) distribution. */ Nullcheck_mp(m, ); int np = m->parameters->matrix->size1; int n = m->parameters->vector->data[0]; if (!m->more) { gsl_matrix *ccc = apop_matrix_copy(m->parameters->matrix); gsl_linalg_cholesky_decomp(ccc); for (int i=0; i < ccc->size1; i++) //zero out the upper diagonal for (int j=i+1; j < ccc->size2; j++) gsl_matrix_set(ccc, i, j, 0); m->more = apop_matrix_to_data(ccc); m->more_size = sizeof(apop_data); } apop_data *Chol = m->more; apop_data *rmatrix = apop_data_calloc(np, np); Staticdef(apop_model *, std_normal, apop_model_set_parameters(apop_normal, 0, 1)); //C Load diagonal elements with square root of chi-square variates for(int i = 0; i< np; i++){ int DF = n - i; apop_data_set(rmatrix, i, i, sqrt(gsl_ran_chisq(r, DF))); } for(int i = 1; i< np; i++) //off-diagonal triangles: Normals. for(int j = 0; j< i; j++){ double ndraw; apop_draw(&ndraw, r, std_normal); assert (!gsl_isnan(ndraw)); apop_data_set(rmatrix, i, j, ndraw); } //Now find C * rand * rand' * C' apop_data *cr = apop_dot(Chol, rmatrix); apop_data *crr = apop_dot(cr, rmatrix, .form2='t'); apop_data *crrc = apop_dot(crr, Chol, .form2='t'); memmove(out, crrc->matrix->data, sizeof(double)*np*np); apop_data_free(rmatrix); apop_data_free(cr); apop_data_free(crrc); apop_data_free(crr); return 0; }
void draw_from_synth_model(size_t nstars, double RV, TGalacticLOSModel& gal_model, TSyntheticStellarModel& stellar_model, TStellarData& stellar_data, TExtinctionModel& ext_model, double (&mag_limit)[5]) { unsigned int samples = 1000; void* gal_model_ptr = static_cast<void*>(&gal_model); double DM_min = 0.; double DM_max = 25.; TDraw1D draw_DM(&log_dNdmu_draw, DM_min, DM_max, gal_model_ptr, samples, true); double logMass_min = -0.9; double logMass_max = 1.1; TDraw1D draw_logMass_disk(&disk_IMF_draw, logMass_min, logMass_max, gal_model_ptr, samples, false); TDraw1D draw_logMass_halo(&halo_IMF_draw, logMass_min, logMass_max, gal_model_ptr, samples, false); double tau_min = 1.e6; double tau_max = 13.e9; TDraw1D draw_tau_disk(&disk_SFR_draw, tau_min, tau_max, gal_model_ptr, samples, false); TDraw1D draw_tau_halo(&halo_SFR_draw, tau_min, tau_max, gal_model_ptr, samples, false); double FeH_min = -2.5; double FeH_max = 1.; TDraw1D draw_FeH_disk(&disk_FeH_draw, FeH_min, FeH_max, gal_model_ptr, samples, false); TDraw1D draw_FeH_halo(&halo_FeH_draw, FeH_min, FeH_max, gal_model_ptr, samples, false); stellar_data.clear(); gal_model.get_lb(stellar_data.l, stellar_data.b); gsl_rng *r; seed_gsl_rng(&r); double EBV, DM, logtau, logMass, FeH; double f_halo; bool halo, in_lib, observed; TSED sed; double mag[NBANDS]; double err[NBANDS]; std::cout << "Component E(B-V) DM log(Mass) log(tau) [Fe/H] g r i z y " << std::endl; std::cout << "=============================================================================================================" << std::endl; std::cout.flags(std::ios::left); std::cout.precision(3); for(size_t i=0; i<nstars; i++) { observed = false; while(!observed) { // Draw E(B-V) EBV = gsl_ran_chisq(r, 1.); // Draw DM DM = draw_DM(); // Draw stellar type f_halo = gal_model.f_halo(DM); halo = (gsl_rng_uniform(r) < f_halo); in_lib = false; while(!in_lib) { if(halo) { logMass = draw_logMass_halo(); logtau = log10(draw_tau_halo()); FeH = draw_FeH_halo(); } else { logMass = draw_logMass_disk(); logtau = log10(draw_tau_disk()); FeH = draw_FeH_disk(); } in_lib = stellar_model.get_sed(logMass, logtau, FeH, sed); } // Generate magnitudes observed = true; unsigned int N_nonobs = 0; for(size_t k=0; k<NBANDS; k++) { mag[k] = sed.absmag[k] + DM + EBV * ext_model.get_A(RV, k); err[k] = 0.02 + 0.1*exp(mag[i]-mag_limit[i]-1.5); mag[k] += gsl_ran_gaussian_ziggurat(r, err[k]); // Require detection in g band and 3 other bands if(mag[k] > mag_limit[k]) { N_nonobs++; if((k == 0) || N_nonobs > 1) { observed = false; break; } } } } std::cout << (halo ? "halo" : "disk") << " "; std::cout << std::setw(9) << EBV << " "; std::cout << std::setw(9) << DM << " "; std::cout << std::setw(9) << logMass << " "; std::cout << std::setw(9) << logtau << " "; std::cout << std::setw(9) << FeH << " "; for(size_t k=0; k<NBANDS; k++) { std::cout << std::setw(9) << mag[k] << " "; } std::cout << std::endl; TStellarData::TMagnitudes mag_tmp(mag, err); mag_tmp.obj_id = i; mag_tmp.l = stellar_data.l; mag_tmp.b = stellar_data.b; stellar_data.star.push_back(mag_tmp); } std::cout << std::endl; gsl_rng_free(r); /*std::vector<bool> filled; DM_of_P.get_filled(filled); for(std::vector<bool>::iterator it = filled.begin(); it != filled.end(); ++it) { std::cout << *it << std::endl; } */ }
double test_chisqnu2 (void) { return gsl_ran_chisq (r_global, 2.0); }