/* 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;
}
