/* Function: esl_mixgev_logsurv() * * Purpose: Returns the log survivor function $\log P(X > x)$ (log(1-CDF)) * for quantile <x>, given mixture GEV parameters <mg>. */ double esl_mixgev_logsurv(double x, ESL_MIXGEV *mg) { int k; for (k = 0; k < mg->K; k++) { mg->wrk[k] = log(mg->q[k]); mg->wrk[k] += esl_gev_logsurv(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; }