//log likelihood for calculating priors for chebyshev polynomials
void LogLikeVelPriorA(double *Cube, int &ndim, int &npars, double &lnew, long &pointer)
{
//get pointer in from MultiNest
parameterList *pL = (parameterList *) pointer;
//scale pars for this point in the parameter space
WIMPpars Wcube;
scaleParams( Cube, pL->p, &Wcube);
double vmin;
double vmax = 0.0023333;
lnew=0;
double sigma;
double GMB,Gcheb;
//Wcube.printWIMPpars();
int Npoints = 20;
for (int i=0; i < Npoints; i++)
{
Gcheb = G( 220/3e5, (240)/3e5, 544/3e5, (double)i*vmax/Npoints, 4, Wcube.vLa);
GMB = G( 220/3e5, (240)/3e5, 544/3e5, (double)i*vmax/Npoints, 1, Wcube.vLa);
sigma = 0.1+ GMB/10.0;//45*(1-tanh((5*i-40)/Npoints));
lnew += gsl_ran_gaussian_pdf(Gcheb-GMB,sigma);
Cube[ndim+1+i] = Gcheb;
//std::cout << gsl_ran_gaussian_pdf(GMB-Gcheb,sigma) << " " << GMB << " " << Gcheb << " " << sigma << std::endl;
}
Cube[ndim]= Wcube.vLa[0];
if( isnan(lnew) )
lnew = -1e99;
}
double as_test_stat(double beta, double alpha, double s, double * X, int n)
{
double mu = beta / (1 - alpha);
double sigma = sqrt( (s * s) / (1 - alpha * alpha) );
double c1 = 1.0 / sqrt(2.0 * 3.141592);
double c2 = 1.0 / (2.0 * sqrt(3.141592));
//double bw = 0.0124;
double bw = comp_bandwidth(X, n);
int i;
double esum = 0.0;
double vsum = 0.0;
double msum = 0.0;
for (i = 0; i < n; i++)
{
double t = npkde(X, n, bw, X[i]);
double u = gsl_ran_gaussian_pdf(X[i] - mu, sigma);
esum += t;
vsum += t * t * t;
msum += (u - t) * (u - t);
}
double E = c2 * esum / n;
double V = c1 * vsum / n;
double M = n * bw * msum / n;
return fabs(pow(bw * V, -0.5) * (M - E));
}
double Model::fptpdf(const double &z, const double &x0max, const double &chi,
const double &d, const double &sddrift) {
const double zs = z * sddrift;
const double zu = z * d;
const double chiminuszu = chi - zu;
const double chizu = chiminuszu / zs;
const double chizumax = (chiminuszu - x0max) / zs;
const double tmp1 =
d * (gsl_cdf_gaussian_P(chizu, 1) - gsl_cdf_gaussian_P(chizumax, 1));
const double tmp2 = sddrift * (gsl_ran_gaussian_pdf(chizumax, 1) -
gsl_ran_gaussian_pdf(chizu, 1));
double res = (tmp1 + tmp2) / x0max;
return res;
}
double npkde(double * X, double n, double bw, double y)
{
int i;
double sum = 0.0;
for (i = 0; i < n; i++)
{
sum += gsl_ran_gaussian_pdf((X[i] - y) / bw, 1);
}
return (1.0 / bw) * (sum / n);
}
double Model::fptcdf(const double &z, const double &x0max, const double &chi,
const double &d, const double &sddrift) {
const double zs = z * sddrift;
const double zu = z * d;
const double chiminuszu = chi - zu;
const double xx = chiminuszu - x0max;
const double chizu = chiminuszu / zs;
const double chizumax = xx / zs;
const double tmp1 =
zs * (gsl_ran_gaussian_pdf(chizumax, 1) - gsl_ran_gaussian_pdf(chizu, 1));
const double tmp2 = xx * gsl_cdf_gaussian_P(chizumax, 1) -
chiminuszu * gsl_cdf_gaussian_P(chizu, 1);
double res = 1 + (tmp1 + tmp2) / x0max;
return res;
}
double
test_bivariate_gaussian4_pdf (double x)
{
double sx = 3.0, sy = 2.0, r = -0.5;
double su = (sx+r*sy) ;
double sv = sy*sqrt(1-r*r) ;
double sigma = sqrt(su*su + sv*sv) ;
return gsl_ran_gaussian_pdf (x, sigma);
}
double normal_prod_gsl(double *x,gsl_vector *means,gsl_vector *sd) {
size_t j;
double lprod=0.0;
double p;
//printf("NP: x=%lf %lf\n",x[0],x[1]);
for(j=0;j<means->size;j++) {
p=gsl_ran_gaussian_pdf(x[j]-ELTd(means,j),ELTd(sd,j));
lprod+=log(p);
}
return exp(lprod);
}
scalar sasfit_peak_fatique_life_area(scalar x, sasfit_param * param) {
scalar z;
SASFIT_ASSERT_PTR(param); // assert pointer param is valid
SASFIT_CHECK_COND1((BETA <= 0.0), param, "beta(%lg) < 0",BETA); // modify condition to your needs
SASFIT_CHECK_COND1((GAMMA <= 0.0), param, "gamma(%lg) < 0",GAMMA); // modify condition to your needs
// insert your code here
z = (x-X0)/BETA;
if (z<=0) return BACKGR;
return AREA/BETA
* (sqrt(z)+sqrt(1/z))/(2*GAMMA*z)
* gsl_ran_gaussian_pdf((sqrt(z)+sqrt(1/z))/GAMMA,1)+BACKGR;
}
/* if distributions are added here, the parameters they expected
must be listed in interface.R */
double logdist(double x, char* distribution, vec_double* params){
double out = 1.;
if (!strcmp(distribution, "flat")) {
out = gsl_ran_flat_pdf(x, params->values[0], params->values[1]);
} else if (!strcmp(distribution, "gaussian")) {
out = gsl_ran_gaussian_pdf(x - params->values[0], params->values[1]);
} else if (!strcmp(distribution, "lognormal")) {
out = gsl_ran_lognormal_pdf(x, params->values[0], params->values[1]);
} else if (!strcmp(distribution, "beta")) {
out = gsl_ran_beta_pdf(x, params->values[0], params->values[1]);
} else if (!strcmp(distribution, "exponential")) {
out = gsl_ran_exponential_pdf(x, params->values[0]);
}
out = log(out);
filter_logprob(&out);
return(out);
}
/*============================================================================*/
double ighmm_rand_normal_density (double x, double mean, double u)
{
# define CUR_PROC "ighmm_rand_normal_density"
#ifndef DO_WITH_GSL
double expo;
#endif
if (u <= 0.0) {
GHMM_LOG(LCONVERTED, "u <= 0.0 not allowed\n");
goto STOP;
}
/* The denominator is possibly < EPS??? Check that ? */
#ifdef DO_WITH_GSL
/* double gsl_ran_gaussian_pdf (double x, double sigma) */
return gsl_ran_gaussian_pdf (x - mean, sqrt (u));
#else
expo = exp (-1 * m_sqr (mean - x) / (2 * u));
return (1 / (sqrt (2 * PI * u)) * expo);
#endif
STOP:
return (-1.0);
# undef CUR_PROC
} /* double ighmm_rand_normal_density */
double pdf_Normal(double x) { return gsl_ran_gaussian_pdf(x,1); }
double
test_gaussian_ratio_method_pdf (double x)
{
return gsl_ran_gaussian_pdf (x, 3.0);
}
double
test_gaussian_pdf (double x)
{
return gsl_ran_gaussian_pdf (x, 3.0);
}
double
test_levy_skew2b_pdf (double x)
{
return gsl_ran_gaussian_pdf (x, sqrt(2.0) * 5.0 );
}
static double dtarget(void* ignore, const gsl_vector* x) {
ignore = NULL; /*keep compiler quiet*/
return log(gsl_ran_gaussian_pdf(x0, 1.0));
}
static inline double plot_fun(double inp, double mean,double sigma){
return gsl_ran_gaussian_pdf(inp-mean,sigma);}
double
test_gaussian_ziggurat_pdf (double x)
{
return gsl_ran_gaussian_pdf (x, 3.12);
}
int main(int argc, char **argv){
distlist distribution = Normal;
char msg[10000], c;
int pval = 0, qval = 0;
double param1 = GSL_NAN, param2 =GSL_NAN, findme = GSL_NAN;
char number[1000];
sprintf(msg, "%s [opts] number_to_lookup\n\n"
"Look up a probability or p-value for a given standard distribution.\n"
"[This is still loosely written and counts as beta. Notably, negative numbers are hard to parse.]\n"
"E.g.:\n"
"%s -dbin 100 .5 34\n"
"sets the distribution to a Binomial(100, .5), and find the odds of 34 appearing.\n"
"%s -p 2 \n"
"find the area of the Normal(0,1) between -infty and 2. \n"
"\n"
"-pval Find the p-value: integral from -infinity to your value\n"
"-qval Find the q-value: integral from your value to infinity\n"
"\n"
"After giving an optional -p or -q, specify the distribution. \n"
"Default is Normal(0, 1). Other options:\n"
"\t\t-binom Binomial(n, p)\n"
"\t\t-beta Beta(a, b)\n"
"\t\t-f F distribution(df1, df2)\n"
"\t\t-norm Normal(mu, sigma)\n"
"\t\t-negative bin Negative binomial(n, p)\n"
"\t\t-poisson Poisson(L)\n"
"\t\t-t t distribution(df)\n"
"I just need enough letters to distinctly identify a distribution.\n"
, argv[0], argv[0], argv[0]);
opterr=0;
if(argc==1){
printf("%s", msg);
return 0;
}
while ((c = getopt (argc, argv, "B:b:F:f:N:n:pqT:t:")) != -1){
switch (c){
case 'B':
case 'b':
if (optarg[0]=='i')
distribution = Binomial;
else if (optarg[0]=='e')
distribution = Beta;
else {
printf("I can't parse the option -b%s\n", optarg);
exit(0);
}
param1 = atof(argv[optind]);
param2 = atof(argv[optind+1]);
findme = atof(argv[optind+2]);
break;
case 'F':
case 'f':
distribution = F;
param1 = atof(argv[optind]);
findme = atof(argv[optind+1]);
break;
case 'H':
case 'h':
printf("%s", msg);
return 0;
case 'n':
case 'N':
if (optarg[0]=='o'){ //normal
param1 = atof(argv[optind]);
param2 = atof(argv[optind+1]);
findme = atof(argv[optind+2]);
} else if (optarg[0]=='e'){
distribution = Negbinom;
param1 = atof(argv[optind]);
param2 = atof(argv[optind+1]);
findme = atof(argv[optind+2]);
} else {
printf("I can't parse the option -n%s\n", optarg);
exit(0);
}
break;
case 'p':
if (!optarg || optarg[0] == 'v')
pval++;
else if (optarg[0] == 'o'){
distribution = Poisson;
param1 = atof(argv[optind]);
findme = atof(argv[optind+1]);
} else {
printf("I can't parse the option -p%s\n", optarg);
exit(0);
}
break;
case 'q':
qval++;
break;
case 'T':
case 't':
distribution = T;
param1 = atof(argv[optind]);
findme = atof(argv[optind+1]);
break;
case '?'://probably a negative number
if (optarg)
snprintf(number, 1000, "%c%s", optopt, optarg);
else snprintf(number, 1000, "%c", optopt);
if (gsl_isnan(param1)) param1 = -atof(number);
else if (gsl_isnan(param2)) param2 = -atof(number);
else if (gsl_isnan(findme)) findme = -atof(number);
}
}
if (gsl_isnan(findme)) findme = atof(argv[optind]);
//defaults, as promised
if (gsl_isnan(param1)) param1 = 0;
if (gsl_isnan(param2)) param2 = 1;
if (!pval && !qval){
double val =
distribution == Beta ? gsl_ran_beta_pdf(findme, param1, param2)
: distribution == Binomial ? gsl_ran_binomial_pdf(findme, param2, param1)
: distribution == F ? gsl_ran_fdist_pdf(findme, param1, param2)
: distribution == Negbinom ? gsl_ran_negative_binomial_pdf(findme, param2, param1)
: distribution == Normal ? gsl_ran_gaussian_pdf(findme, param2)+param1
: distribution == Poisson ? gsl_ran_poisson_pdf(findme, param1)
: distribution == T ? gsl_ran_tdist_pdf(findme, param1) : GSL_NAN;
printf("%g\n", val);
return 0;
}
if (distribution == Binomial){
printf("Sorry, the GSL doesn't have a Binomial CDF.\n");
return 0; }
if (distribution == Negbinom){
printf("Sorry, the GSL doesn't have a Negative Binomial CDF.\n");
return 0; }
if (distribution == Poisson){
printf("Sorry, the GSL doesn't have a Poisson CDF.\n");
return 0; }
if (pval){
double val =
distribution == Beta ? gsl_cdf_beta_P(findme, param1, param2)
: distribution == F ? gsl_cdf_fdist_P(findme, param1, param2)
: distribution == Normal ? gsl_cdf_gaussian_P(findme-param1, param2)
: distribution == T ? gsl_cdf_tdist_P(findme, param1) : GSL_NAN;
printf("%g\n", val);
return 0;
}
if (qval){
double val =
distribution == Beta ? gsl_cdf_beta_Q(findme, param1, param2)
: distribution == F ? gsl_cdf_fdist_Q(findme, param1, param2)
: distribution == Normal ? gsl_cdf_gaussian_Q(findme-param1, param2)
: distribution == T ? gsl_cdf_tdist_Q(findme, param1) : GSL_NAN;
printf("%g\n", val);
}
}
double bimodal_proposal_density(const double *from, const double *to, const void *feedback, const void *arg)
{
double var = * ((double *) feedback);
return gsl_ran_gaussian_pdf(*to - *from, sqrt(2*var));
}
plom_err_code log_prob_proposal(double *log_like, struct s_best *p_best, theta_t *proposed, theta_t *mean, gsl_matrix *var, double sd_fac, struct s_data *p_data, int is_mvn)
{
int i, k, offset;
double p_tmp, Lp;
p_tmp=0.0, Lp=0.0;
if (is_mvn) {
p_tmp = plom_dmvnorm(p_best, proposed, mean, var, sd_fac);
}
for(i=0; i<p_data->p_it_all->length; i++) {
struct s_router *p_router = p_data->routers[p_data->p_it_all->ind[i]];
for(k=0; k<p_router->n_gp; k++) {
offset = p_data->p_it_all->offset[i]+k;
if(p_best->is_estimated[offset]) {
if (!is_mvn) {
p_tmp = gsl_ran_gaussian_pdf((gsl_vector_get(proposed, offset)-gsl_vector_get(mean, offset)), sd_fac*sqrt(gsl_matrix_get(var, offset, offset)));
}
/*
Change of variable formula:
Y = r(X) (r is assumed to be increasing) with inverse r_inv
X has f for density
Y has g for density
g(y) = f (r_inv (y)) * d r_inv(y)/dy
In our case, the proposal takes place on a transformed scale router.f. We know g(y) but we want f(r_inv(y))
we therefore divide g(y) by d r_inv(y)/dy.
Note that in the multivariate case, we need to
divide by the determinant of the Jacobian
matrix. However in our case the Jacobian is
diagonal so the determinant is the product of the
diagonal terms so everything generalizes nicely
*/
p_tmp /= (*(p_router->f_inv_derivative))(gsl_vector_get(proposed, offset), p_router->min[k], p_router->max[k]);
//check for numerical issues
if( (isnan(p_tmp)==1) || (isinf(p_tmp)==1) || (p_tmp<0.0) ) {
return PLOM_ERR_LIKE;
}
if (!is_mvn) {
Lp += log(p_tmp);
}
}
}
}
if (is_mvn) {
Lp = log(p_tmp);
}
//check AGAIN for numerical issues (taking log could have created issues)
if((isinf(Lp)==1) || (isnan(Lp)==1)) {
return PLOM_ERR_LIKE;
}
*log_like = Lp;
return PLOM_SUCCESS;
}
double distr_target(double x)
{
return 0.3*(gsl_ran_gaussian_pdf(x, 1)) + 0.7*( gsl_ran_gaussian_pdf(x-5, 1));
}
double
test_bivariate_gaussian1_pdf (double x)
{
return gsl_ran_gaussian_pdf (x, 3.0);
}
double poly_gaussian_proposal_pdf(double x, poly_gaussian_proposal_param_t par) {
double dist = gsl_ran_gaussian_pdf(x-par.mean, par.stdev);
return dist;
}
double
gaussian (double x, void *p)
{
return gsl_ran_gaussian_pdf (x, *(double*)p);
}
RcppExport SEXP updatealphau_noPu_Exp(SEXP alphaut, SEXP n_s, SEXP n_u, SEXP I, SEXP K, SEXP lambda_u, SEXP var_p, SEXP ttt, SEXP gammat)
{
BEGIN_RCPP
Rcpp::IntegerMatrix xgammat(gammat);
Rcpp::NumericVector xalphaut(alphaut);
Rcpp::IntegerMatrix xn_s(n_s);
Rcpp::IntegerMatrix xn_u(n_u);
int xI = Rcpp::as<int>(I);
int xK = Rcpp::as<int>(K);
Rcpp::NumericVector sqrt_var(var_p);
int xtt = Rcpp::as<int>(ttt);
Rcpp::NumericVector xlambda_u(lambda_u);
Rcpp::IntegerVector xAalphau(xK);
Rcpp::RNGScope scope;
double delF = 0.0;
double log1 = 0.0;
double log2 = 0.0;
double sum_alphau = 0.0;
int flag1 = 0; int flag0 = 0; int flagkk = 0;
int lp0 = 0; int lp1 = 0;
double sum_nusalphau = 0.0;
double sum_nualphau = 0.0;
double sums = 0.;
for (int kk = 0; kk < xK; kk++) {
delF = 0.0;
log1 = 0.0;
log2 = 0.0;
sum_alphau = 0.0;
for (int s = 0; s < xK; s++) {
sum_alphau += xalphaut[s];
}
log2 -= xI*lgamma(xalphaut[kk]);
delF += xI*(boost::math::digamma(sum_alphau)- boost::math::digamma(xalphaut[kk]));
log2 += xI*lgamma(sum_alphau);
for (int i = 0; i < xI; i++) {
lp1 = 0;
for (int k = 0; k < xK; k++) {
if (xgammat(i,k) == 1) { lp1 +=1;}
}
lp0 = xK-lp1;
int p1[lp1]; flag1 = 0;
int p0[lp0]; flag0 = 0;
flagkk = 0; // whether gamma_k = 1
for (int k= 0; k < xK; k++) {
if (xgammat(i,k) == 1) {
p1[flag1] = k;
flag1 += 1;
if (k == kk) {flagkk = 1;}
} else {
p0[flag0] = k;
flag0 +=1;
}
}
if (flagkk==1) {
log2 += lgamma(xn_u(i,kk)+xalphaut[kk]);
delF +=boost::math::digamma(xn_u(i,kk)+xalphaut[kk]);
sum_nualphau = 0.0;
sum_nusalphau = 0.0;
for (int k = 0; k<lp1; k++) {
sums = xn_u(i,p1[k])+xalphaut[p1[k]];
sum_nualphau += sums;
sum_nusalphau += (sums+xn_s(i,p1[k]));
}
log2 -=lgamma(sum_nualphau);
log2 += lgamma(sum_nusalphau+1);
delF -=boost::math::digamma(sum_nualphau);
delF += boost::math::digamma(sum_nusalphau+1);
for (int k= 0; k<lp0; k++) {
sum_nusalphau +=(xn_u(i,p0[k])+xalphaut[p0[k]]+xn_s(i,p0[k]));
}
delF -= boost::math::digamma(sum_nusalphau+1);
log2 -= lgamma(sum_nusalphau+1);
} else {
log2 += lgamma(xn_u(i,kk)+xalphaut[kk]+xn_s(i,kk));
delF += boost::math::digamma(xn_u(i,kk)+xalphaut[kk]+xn_s(i,kk));
sum_nusalphau = 0.0;
for ( int k = 0; k<xK; k++) {
sum_nusalphau +=xn_u(i,k)+xalphaut[k]+xn_s(i,k);
}
log2 -= lgamma(sum_nusalphau+1);
delF -= boost::math::digamma(sum_nusalphau+1);
}
}
double mean_p = std::max(0.01, xalphaut[kk]+delF/xtt);
Rcpp::NumericVector alpha_u_p = Rcpp::rnorm(1, mean_p, sqrt_var[kk]);
if (alpha_u_p[0]>0.0) {
double alp[xK];
for (int i = 0; i<xK; i++) {
alp[i] = xalphaut[i];
}
alp[kk] = alpha_u_p[0];
log2 += log(gsl_ran_gaussian_pdf(alp[kk]-mean_p, sqrt_var[kk]));
delF = 0.0; sum_alphau = 0.0;
for (int s = 0; s < xK; s++) {
sum_alphau += alp[s];
}
log1 -= xI*lgamma(alp[kk]);
delF += xI*(boost::math::digamma(sum_alphau)- boost::math::digamma(alp[kk]));
log1 += xI*lgamma(sum_alphau);
for (int i = 0; i < xI; i++ ){
lp1 = 0;
for (int k = 0; k < xK; k++) {
if (xgammat(i,k) == 1) { lp1 +=1;}
}
lp0 = xK-lp1;
int p1[lp1]; flag1 = 0;
int p0[lp0]; flag0 = 0;
flagkk = 0; // whether gamma_k = 1
for (int k= 0; k < xK; k++) {
if (xgammat(i,k) == 1) {
p1[flag1] = k;
flag1 += 1;
if (k == kk) {flagkk = 1;}
} else {
p0[flag0] = k;
flag0 +=1;
}
}
if (flagkk==1) {
log1 += lgamma(xn_u(i,kk)+alp[kk]);
delF +=boost::math::digamma(xn_u(i,kk)+alp[kk]);
sum_nualphau = 0.0;
sum_nusalphau = 0.0;
for (int k = 0; k<lp1; k++) {
sums = xn_u(i,p1[k])+alp[p1[k]];
sum_nualphau += sums;
sum_nusalphau += (sums+xn_s(i,p1[k]));
}
log1 -=lgamma(sum_nualphau);
log1 += lgamma(sum_nusalphau+1);
delF -=boost::math::digamma(sum_nualphau);
delF += boost::math::digamma(sum_nusalphau+1);
for (int k= 0; k<lp0; k++) {
sum_nusalphau +=(xn_u(i,p0[k])+alp[p0[k]]+xn_s(i,p0[k]));
}
delF -= boost::math::digamma(sum_nusalphau+1);
log1 -= lgamma(sum_nusalphau+1);
} else {
log1 += lgamma(xn_u(i,kk)+alp[kk]+xn_s(i,kk));
delF += boost::math::digamma(xn_u(i,kk)+alp[kk]+xn_s(i,kk));
sum_nusalphau = 0.0;
for ( int k = 0; k<xK; k++) {
sum_nusalphau +=xn_u(i,k)+alp[k]+xn_s(i,k);
}
log1 -= lgamma(sum_nusalphau+1);
delF -=boost::math::digamma(sum_nusalphau+1);
}
}
mean_p = std::max(0.01, alp[kk] + delF/xtt);
log1 +=log(gsl_ran_gaussian_pdf(xalphaut[kk]-mean_p, sqrt_var[kk]));
log1 += log(gsl_ran_exponential_pdf(alp[kk],xlambda_u[kk])); //exponential prior
log2 += log(gsl_ran_exponential_pdf(xalphaut[kk],xlambda_u[kk])); //exponential prior
//if (alp[kk]<0 || alp[kk]>xlambda_u[kk]) {log1+=log(0);} //Uniform prior
//if (xalphaut[kk]<0 || xalphaut[kk]>xlambda_u[kk]) {log2+=log(0);} //Uniform prior
if (log(Rcpp::as<double>(Rcpp::runif(1)) ) <= (log1 - log2)) {
xalphaut[kk] = alp[kk];
xAalphau[kk] = 1;
} else{
xAalphau[kk] = 0;
}
}
}
return Rcpp::List::create(Rcpp::Named("alphau_tt") = xalphaut, Rcpp::Named("Aalphau") = xAalphau);
END_RCPP
}
