/* gev_func(): * Returns the neg log likelihood of a complete or censored GEV data sample; * in the API of the conjugate gradient descent optimizer in esl_minimizer. */ static double gev_func(double *p, int nparam, void *dptr) { double mu, w, lambda, alpha; struct gev_data *data; double logL; int i; /* Unpack what the optimizer gave us. */ mu = p[0]; w = p[1]; /* w is a c.o.v. to allow unconstrained opt of lambda>0 */ lambda = exp(w); alpha = p[2]; data = (struct gev_data *) dptr; logL = 0.; for (i = 0; i < data->n; i++) logL += esl_gev_logpdf(data->x[i], mu, lambda, alpha); if (data->is_censored) logL += data->z * esl_gev_logcdf(data->phi, mu, lambda, alpha); return -logL; /* goal: minimize NLL */ }
/* Function: esl_mixgev_logcdf() * * Purpose: Returns the log of the CDF $\log P(X \leq x)$ * for quantile <x>, given mixture GEV parameters <mg>. */ double esl_mixgev_logcdf(double x, ESL_MIXGEV *mg) { int k; for (k = 0; k < mg->K; k++) if (mg->q[k] == 0.0) mg->wrk[k] = -eslINFINITY; else mg->wrk[k] = log(mg->q[k]) + esl_gev_logcdf(x, mg->mu[k], mg->lambda[k], mg->alpha[k]); return esl_vec_DLogSum(mg->wrk, mg->K); }
int main(int argc, char **argv) { FILE *fp; double mu = 0.0; double lambda = 1.0; double xmin = -20.; double xmax = 60.; double xstep = 0.1; double x,z; int do_test[MAX_STATS_TESTS+1]; int i; for (i = 0; i <= MAX_STATS_TESTS; i++) do_test[i] = 0; for (i = 1; i < argc; i++) do_test[atoi(argv[i])] = 1; /* stats.1: xmgrace xy file w/ densities for Gumbel, Frechet, Weibull */ if (do_test[1]) { if ((fp = fopen("stats.1", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_pdf(x, mu, lambda, 0.0)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_pdf(x, mu, lambda, 0.1)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_pdf(x, mu, lambda, -0.1)); fprintf(fp, "&\n"); fclose(fp); } /* stats.2: xmgrace xy file w/ log densities for Gumbel, Frechet, Weibull */ if (do_test[2]) { if ((fp = fopen("stats.2", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logpdf(x, mu, lambda, 0.0); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logpdf(x, mu, lambda, 0.1); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logpdf(x, mu, lambda, -0.1); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); fclose(fp); } /* stats.3: xmgrace xy file w/ CDF for Gumbel, Frechet, Weibull */ if (do_test[3]) { if ((fp = fopen("stats.3", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_cdf(x, mu, lambda, 0.0)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_cdf(x, mu, lambda, 0.6)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_cdf(x, mu, lambda, -0.6)); fprintf(fp, "&\n"); fclose(fp); } /* stats.4: xmgrace xy file w/ logCDF for Gumbel, Frechet, Weibull */ if (do_test[4]) { if ((fp = fopen("stats.4", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logcdf(x, mu, lambda, 0.0); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logcdf(x, mu, lambda, 0.2); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logcdf(x, mu, lambda, -0.2); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); fclose(fp); } /* stats.5: xmgrace xy file w/ surv for Gumbel, Frechet, Weibull */ if (do_test[5]) { if ((fp = fopen("stats.5", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_surv(x, mu, lambda, 0.0)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_surv(x, mu, lambda, 0.6)); fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) fprintf(fp, "%.1f %9.7f\n", x, esl_gev_surv(x, mu, lambda, -0.6)); fprintf(fp, "&\n"); fclose(fp); } /* stats.6: xmgrace xy file w/ logsurv for Gumbel, Frechet, Weibull */ if (do_test[6]) { if ((fp = fopen("stats.6", "w")) == NULL) abort(); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logsurv(x, mu, lambda, 0.0); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logsurv(x, mu, lambda, 0.2); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); for (x = xmin; x <= xmax; x+= xstep) { z = esl_gev_logsurv(x, mu, lambda, -0.2); if (finite(z)) fprintf(fp, "%.1f %9.7f\n", x, z); } fprintf(fp, "&\n"); fclose(fp); } /* stats.7. R input file of 10,000 random GEV samples. */ if (do_test[7]) { if ((fp = fopen("stats.7", "w")) == NULL) abort(); stats_sample(fp); fclose(fp); } /* stats.8. Test 500 fits of the Frechet. */ if (do_test[8]) { if ((fp = fopen("stats.8", "w")) == NULL) abort(); stats_fittest(fp, 500, 10000, mu, lambda, 0.2); fclose(fp); } /* stats.9. Test 500 fits of the near-Gumbel */ if (do_test[9]) { if ((fp = fopen("stats.9", "w")) == NULL) abort(); stats_fittest(fp, 500, 10000, mu, lambda, 0.00001); fclose(fp); } /* stats.10. Test 500 fits of the Weibull */ if (do_test[10]) { if ((fp = fopen("stats.10", "w")) == NULL) abort(); stats_fittest(fp, 500, 10000, mu, lambda, -0.2); fclose(fp); } return 0; }