/* Function: esl_mixgev_Sample() * * Purpose: Sample a random variate x from a mixture GEV <mg>, * given random number source <r>. */ double esl_mixgev_Sample(ESL_RANDOMNESS *r, ESL_MIXGEV *mg) { int k; k = esl_rnd_DChoose(r, mg->q, mg->K); return esl_gev_Sample(r, mg->mu[k], mg->lambda[k], mg->alpha[k]); }
/* stats_sample() * Creates an R input table containing 10,000 random samples * each in columns labeled "gumbel", "frechet", "weibull". * To process in R (remember that R uses 1/lambda for scale): library(ismev) library(evd) z=read.table("stats.7") x1 <- sort(z$gumbel, decreasing=T) x2 <- sort(z$frechet, decreasing=T) x3 <- sort(z$weibull, decreasing=T) q1 <- qgumbel(ppoints(10000), -20., 1./0.4) q2 <- qgev(ppoints(10000), -20., 1./0.4, 0.2) q3 <- qgev(ppoints(10000), -20., 1./0.4, -0.2) xax<- seq(-40,40,by=0.1) a1 <- dgumbel(xax, -20, 1/0.4) a2 <- dgev(xax, -20, 1/0.4, 0.2) a3 <- dgev(xax, -20, 1/0.4, -0.2) qqplot(x1,q1); abline(0,1) qqplot(x2,q2); abline(0,1) qqplot(x3,q3); abline(0,1) plot(density(x1,bw=0.2)); lines(xax,a1) plot(density(x2,bw=0.2)); lines(xax,a2) plot(density(x3,bw=0.2)); lines(xax,a3) */ static void stats_sample(FILE *fp) { ESL_RANDOMNESS *r; double mu = -20.; double lambda = 0.4; int n = 10000; double a,b,c; int i; r = esl_randomness_Create(42); fprintf(fp, " gumbel \t frechet\t weibull\n"); for (i = 1; i <= n; i++) { a = esl_gev_Sample(r, mu, lambda, 0.0); b = esl_gev_Sample(r, mu, lambda, 0.2); c = esl_gev_Sample(r, mu, lambda, -0.2); fprintf(fp, "%d\t%8.4f\t%8.4f\t%8.4f\n", i, a,b,c); } esl_randomness_Destroy(r); }
/* stats_fittest() * Samples <n> numbers from a GEV w/ parameters <mu>, <lambda>, <alpha>; * then fits to a GEV and print info about how good the fit is. * * Repeat this <ntrials> times. * * For each trial, outputs a line to <fp>: * <trial> <nll> <est_nll> <est_mu> <mu %error> <est_lambda> <%err>\ * <est_alpha> <%err> <est E-val at parametric E=1> * * Each sampled set is done with the random number generator seeded to * the trial number. This should make each set reproducible and * identical to the sets used to test R's fitting. * * xref STL9/191; xref 2005/0718-weibull-debugging */ static int stats_fittest(FILE *fp, int ntrials, int n, double mu, double lambda, double alpha) { ESL_RANDOMNESS *r = NULL; double *x = NULL; int i; int trial; double est_mu, est_lambda, est_alpha; double z; double nll, est_nll; int status; ESL_ALLOC(x, sizeof(double) * n); for (trial = 1; trial <= ntrials; trial++) { r = esl_randomness_Create(trial); nll = 0.; for (i = 0; i < n; i++) { x[i] = esl_gev_Sample(r, mu, lambda, alpha); nll -= esl_gev_logpdf(x[i], mu, lambda, alpha); } esl_randomness_Destroy(r); esl_gev_FitComplete(x, n, &est_mu, &est_lambda, &est_alpha); est_nll = 0.; for (i = 0; i < n; i++) est_nll -= esl_gev_logpdf(x[i], est_mu, est_lambda, est_alpha); z = mu + (exp(-alpha*log(1/(double)n)) - 1 ) / (alpha*lambda);/* x at E=1*/ z = (double) n * esl_gev_surv(z, est_mu, est_lambda, est_alpha); /* E at x */ printf("%4d %10.2f %10.2f %8.3f %8.3f %8.5f %8.3f %8.5f %8.3f %6.4f\n", trial, nll, est_nll, est_mu, 100* fabs((est_mu-mu)/mu), est_lambda, 100* fabs((est_lambda-lambda)/lambda), est_alpha, 100* fabs((est_alpha-alpha)/alpha), z); } free(x); return eslOK; ERROR: return status; }
int main(int argc, char **argv) { double est_mu, est_lambda, est_alpha; double z; int i; int n = 10000; /* simulate 10,000 samples */ double mu = -20.0; /* with mu = -20 */ double lambda = 0.4; /* and lambda = 0.4 */ double alpha = 0.1; /* and alpha = 0.1 */ double min = 9999.; double max = -9999.; double *x = malloc(sizeof(double) * n); ESL_RANDOMNESS *r = esl_randomness_Create(0);; for (i = 0; i < n; i++) /* generate the 10,000 samples */ { x[i] = esl_gev_Sample(r, mu, lambda, alpha); if (x[i] < min) min = x[i]; if (x[i] > max) max = x[i]; } z = esl_gev_surv(max, mu, lambda, alpha); /* right tail p~1e-4 >= max */ printf("max = %6.1f P(>max) = %g E=%6.3f\n", max, z, z*(double)n); z = esl_gev_cdf(min, mu, lambda, alpha); /* left tail p~1e-4 < min */ printf("min = %6.1f P(<=min) = %g E=%6.3f\n", min, z, z*(double)n); esl_gev_FitComplete(x, n, &est_mu, &est_lambda, &est_alpha); printf("Parametric mu = %6.1f. Estimated mu = %6.2f. Difference = %.1f%%.\n", mu, est_mu, 100. * fabs((est_mu - mu) / mu)); printf("Parametric lambda = %6.2f. Estimated lambda = %6.2f. Difference = %.1f%%.\n", lambda, est_lambda, 100. * fabs((est_lambda - lambda) /lambda)); printf("Parametric alpha = %6.4f. Estimated alpha = %6.4f. Difference = %.1f%%.\n", alpha, est_alpha, 100. * fabs((est_alpha - alpha) /alpha)); free(x); esl_randomness_Destroy(r); return 0; }