int compare(const double *a, const double *b) /* ansi conformant qsort cmp, puts mv's at the end */ { if (is_mv_double(a)) /* a is bigger */ return 1; if (is_mv_double(b)) /* b is bigger */ return -1; if (*a < *b) return -1; if (*a > *b) return 1; return 0; }
void print_data(const DATA *d, int list) { int i; printlog("\ndata id: %d\n", d->id); if (! is_mv_double(&(d->Icutoff))) printlog("ind. cutoff: %g\n", d->Icutoff); if (d->Category) printlog("category: %s\n", d->Category); if (! is_mv_double(&(d->mv))) printlog("missing value: %g\n", d->mv); if (d->beta) { printlog("beta: ["); for (i = 0; i < d->beta->size; i++) printlog(" %g", d->beta->val[i]); printlog("]\n"); } printlog("sel_radius %g sel_max %d sel_min %d\n", d->sel_rad, d->sel_max, d->sel_min); if (d->n_X > 0) { for (i = 0; i < d->n_X; i++) { printlog("X[%d]: ", i); if (d->colX[i] == 0) printlog("intercept "); if (d->colX[i] < 0) printlog("%s ", POLY_NAME(d->colX[i])); if (d->colX[i] > 0) printlog("%d ", d->colX[i]); } printlog("\n"); } printlog("n_list %d n_max %d n_sel %d\n", d->n_list, d->n_max, d->n_sel); if (list) { printlog("current list:\n"); logprint_data_header(d); if (d->n_list) { for (i = 0; i < d->n_list; i++) logprint_point(d->list[i], d); } else printlog("<empty>\n"); } else { printlog("current selection:\n"); logprint_data_header(d); if (d->n_sel) { for (i = 0; i < d->n_sel; i++) logprint_point(d->sel[i], d); } else printlog("<empty>\n"); } }
/* * this function should be changed--the mask map stack is misused as * to define the topology of variogram maps. * * use min/max coordinates for block diagonal as maximum cutoff * Returns: about 1/3 the max. dist between any two points in data. */ void fill_cutoff_width(DATA *data /* pointer to DATA structure to derive the values from */, VARIOGRAM *v /* pointer to VARIOGRAM structure */) { double d = 0.0; int i; GRIDMAP *m; SAMPLE_VGM *ev; assert(data); assert(v); ev = v->ev; if (get_n_masks() > 0) { m = new_map(); m->is_write = 0; m->filename = get_mask_name(0); if ((m = map_read(m)) == NULL) ErrMsg(ER_READ, "cannot open map"); ev->iwidth = 1.0; ev->cutoff = m->rows * m->cols; /* not a real cutoff, but rather the size of the container array */ ev->map = m; } else if (gl_bounds != NULL) { i = 0; while (gl_bounds[i] >= 0.0) /* count length */ i++; ev->cutoff = gl_bounds[i-1]; ev->iwidth = ev->cutoff / i; } else { if (is_mv_double(&(ev->cutoff))) { if (gl_cutoff < 0.0) { d = data_block_diagonal(data); if (d == 0.0) ev->cutoff = 1.0; /* ha ha ha */ else ev->cutoff = d * gl_fraction; } else ev->cutoff = gl_cutoff; } if (is_mv_double(&(ev->iwidth))) { if (gl_iwidth < 0.0) ev->iwidth = ev->cutoff / gl_n_intervals; else ev->iwidth = gl_iwidth; } } }
static DPOINT *next_location(DPOINT *loc, PRED_AT what, int random_path, unsigned int *row, unsigned int *col, DATA **data) { double xc, yc; static unsigned int nr = 0; switch (what) { case AT_POINTS: if (DEBUG_TRACE) { nr++; printlog("\rbusy with loc: %3u", nr); } return get_point_location(random_path); case AT_GRIDMAP: if (get_map_location(loc, random_path, row, col)) { if (loc->u.stratum >= 0) { /* i.e., non-missing valued cell */ if (DEBUG_TRACE) printlog("\rbusy with row: %3u col: %3u loc: %3u", *row + 1, *col + 1, nr + 1); map_rowcol2xy(masks[0], *row, *col, &xc, &yc); loc->x = xc; loc->y = yc; if (!is_mv_double(&gl_zmap)) loc->z = gl_zmap; else loc->z = 0.0; loc->X = get_maskX(data, loc, *row, *col); nr++; } return loc; } break; } return NULL; } /* next_location() */
static void write_output(double *est, PRED_AT w, DPOINT *here, unsigned int row, unsigned int col) { int i; switch (w) { case AT_POINTS: write_points(o_filename, val_data, here, est, get_mode() != STRATIFY ? get_n_outfile() : 2); break; case AT_GRIDMAP: for (i = 0; i < get_n_outfile(); i++) if (outmap[i] && !is_mv_double(&(est[i]))) map_put_cell(outmap[i], row, col, est[i]); break; } } /* write_output() */
char *my_dtoa(const char *fmt, double *a) { /* * BEWARE of the sideffect: * NEVER use printf("%10s %10s", my_dtoa("%g", 1.0), my_dtoa("%g", 2.0)); * instead: printf("%10s", my_dtoa("%g", 1.0)); printf(" %10s", my_dtoa("%g", 2.0)); */ static char *s = NULL; if (s == NULL) /* first time: */ s = (char *) emalloc(MAX(50, 1 + strlen(gl_mv_string))); s[0] = '\0'; if (is_mv_double(a)) sprintf(s, "%s", gl_mv_string); else sprintf(s, fmt, *a); return s; }
double da_general(VGM_MODEL *part, double h) { /* numerical approximation of derivative: */ int i; double low, high, range, r[NRANGEPARS]; for (i = 0; i < NRANGEPARS; i++) { if (is_mv_double(&(part->range[i]))) set_mv_double(&(r[i])); else r[i] = part->range[i]; } range = MAX(1e-20, part->range[0]); r[0] = range * (1.0 + DA_DELTA); low = part->fnct(h, r); r[0] = range * (1.0 - DA_DELTA); high = part->fnct(h, r); return part->sill * (low - high) / (2.0 * range * DA_DELTA); }
void report_xvalid(double *xdata, double *xpred, double *xdiff, double *xstd, double *xzscore, int ndata, int var) { /* * DATE: Tue Oct 6 11:55:44 MET 1992 * BY : Edzer J. Pebesma * PURPOSE: report summary statistics of these five lists * SIDE EFFECTS: none */ int i, nXdata = 0, nXpred = 0, nXdiff = 0, n_std = 0, nZscore = 0, compare(const double *a, const double *b); double min[5], max[5], p25[5], p75[5], p50[5], mean[5], std[5]; double corr = 0.0; set_mv_double(&corr); calc_r(xdata, xpred, ndata, &corr); for (i = 0; i < 5; i ++) { set_mv_double(&(min[i])); set_mv_double(&(p25[i])); set_mv_double(&(p50[i])); set_mv_double(&(p75[i])); set_mv_double(&(max[i])); set_mv_double(&(mean[i])); set_mv_double(&(std[i])); } /* select not missing values, put mv's at the end: */ /* sorting arrays: */ qsort(xdata, (size_t) ndata, sizeof(double), (int (*)(const void *,const void *)) compare); while (!is_mv_double(&(xdata[nXdata])) && nXdata < ndata) nXdata++; qsort(xpred, (size_t) ndata, sizeof(double), (int (*)(const void *,const void *)) compare); while (!is_mv_double(&(xpred[nXpred])) && nXpred < ndata) nXpred++; qsort(xdiff, (size_t) ndata, sizeof(double), (int (*)(const void *,const void *)) compare); while (!is_mv_double(&(xdiff[nXdiff])) && nXdiff < ndata) nXdiff++; if (var) { /* do everything for xstd and xzscore */ qsort(xstd, (size_t) ndata, sizeof(double), (int (*)(const void *,const void *)) compare); while ((! is_mv_double(&(xstd[n_std]))) && (n_std < ndata)) n_std++; qsort(xzscore, (size_t) ndata, sizeof(double), (int (*)(const void *,const void *)) compare); while ((! is_mv_double(&(xzscore[nZscore]))) && (nZscore < ndata)) nZscore++; } /* calculate statistics: */ if (nXdata) { min[0]=xdata[0]; max[0]=xdata[nXdata-1]; mean[0] = sample_mean(xdata, nXdata); if (nXdata > 1) { p25[0]=est_quant(xdata, 0.25, nXdata); p50[0]=est_quant(xdata, 0.5, nXdata); p75[0]=est_quant(xdata, 0.75, nXdata); std[0] = sample_std(xdata, mean[0], nXdata); } } if (nXpred) { min[1]=xpred[0]; max[1]=xpred[nXpred-1]; mean[1] = sample_mean(xpred, nXpred); if (nXpred > 1) { p25[1]=est_quant(xpred, 0.25, nXpred); p50[1]=est_quant(xpred, 0.5, nXpred); p75[1]=est_quant(xpred, 0.75, nXpred); std[1] = sample_std(xpred, mean[1], nXpred); } } if (nXdiff) { min[2]=xdiff[0]; max[2]=xdiff[nXdiff-1]; mean[2] = sample_mean(xdiff, nXdiff); if (nXdiff > 1) { p25[2]=est_quant(xdiff, 0.25, nXdiff); p50[2]=est_quant(xdiff, 0.5, nXdiff); p75[2]=est_quant(xdiff, 0.75, nXdiff); std[2] = sample_std(xdiff, mean[2], nXdiff); } } if (var) { if (n_std) { min[3]=xstd[0]; max[3]=xstd[n_std-1]; mean[3] = sample_mean(xstd, n_std); if (n_std > 1) { p25[3]=est_quant(xstd, 0.25, n_std); p50[3]=est_quant(xstd, 0.5, n_std); p75[3]=est_quant(xstd, 0.75, n_std); std[3] = sample_std(xstd, mean[3], n_std); } } if (nZscore) { min[4]=xzscore[0]; max[4]=xzscore[nZscore-1]; mean[4] = sample_mean(xzscore, nZscore); if (nZscore > 1) { p25[4]=est_quant(xzscore, 0.25, nZscore); p50[4]=est_quant(xzscore, 0.5, nZscore); p75[4]=est_quant(xzscore, 0.75, nZscore); std[4] = sample_std(xzscore, mean[4], nZscore); } } } /* output: */ printlog("corr(Obs, Pred): %s [%s]\n\n", my_dtoa("%6.4g", &corr), method_string(get_method())); printlog(" observed predicted pred.-obs. pred.std. zscore\n"); printlog("======================================================================\n"); printlog("%-10s%12s", "minimum", my_dtoa("%6.4g", &(min[0]))); printlog("%12s", my_dtoa("%6.4g", &(min[1]))); printlog("%12s", my_dtoa("%6.4g", &(min[2]))); printlog("%12s", my_dtoa("%6.4g", &(min[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(min[4]))); printlog("%-10s%12s", "1st q.", my_dtoa("%6.4g", &(p25[0]))); printlog("%12s", my_dtoa("%6.4g", &(p25[1]))); printlog("%12s", my_dtoa("%6.4g", &(p25[2]))); printlog("%12s", my_dtoa("%6.4g", &(p25[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(p25[4]))); printlog("%-10s%12s", "median", my_dtoa("%6.4g", &(p50[0]))); printlog("%12s", my_dtoa("%6.4g", &(p50[1]))); printlog("%12s", my_dtoa("%6.4g", &(p50[2]))); printlog("%12s", my_dtoa("%6.4g", &(p50[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(p50[4]))); printlog("%-10s%12s", "3rd q.", my_dtoa("%6.4g", &(p75[0]))); printlog("%12s", my_dtoa("%6.4g", &(p75[1]))); printlog("%12s", my_dtoa("%6.4g", &(p75[2]))); printlog("%12s", my_dtoa("%6.4g", &(p75[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(p75[4]))); printlog("%-10s%12s", "maximum", my_dtoa("%6.4g", &(max[0]))); printlog("%12s", my_dtoa("%6.4g", &(max[1]))); printlog("%12s", my_dtoa("%6.4g", &(max[2]))); printlog("%12s", my_dtoa("%6.4g", &(max[3]))); printlog("%12s\n\n", my_dtoa("%6.4g", &(max[4]))); printlog("%-10s%12d%12d%12d%12d%12d\n", "n", nXdata, nXpred, nXdiff, n_std, nZscore); printlog("%-10s%12s", "mean", my_dtoa("%6.4g", &(mean[0]))); printlog("%12s", my_dtoa("%6.4g", &(mean[1]))); printlog("%12s", my_dtoa("%6.4g", &(mean[2]))); printlog("%12s", my_dtoa("%6.4g", &(mean[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(mean[4]))); printlog("%-10s%12s", "std.dev.", my_dtoa("%6.4g", &(std[0]))); printlog("%12s", my_dtoa("%6.4g", &(std[1]))); printlog("%12s", my_dtoa("%6.4g", &(std[2]))); printlog("%12s", my_dtoa("%6.4g", &(std[3]))); printlog("%12s\n", my_dtoa("%6.4g", &(std[4]))); return; }
void write_points(const char *fname, DATA *d, DPOINT *where, double *est, int n_outfl) { static FILE *f = NULL; #ifdef HAVE_LIBGIS static Site *site = NULL; static int dim = 2; int i; #endif if (! grass()) { if (where == NULL) { if (fname != NULL) { f = efopen(fname, "w"); write_ascii_header(f, d, n_outfl); } else efclose(f); } else { if (f == NULL) ErrMsg(ER_NULL, "write_points(): f"); output_line(f, d, where, est, n_outfl); } } else { #ifdef HAVE_LIBGIS if (where == NULL) { if (fname != NULL) { /* initialize: */ DUMP("opening grass sites list\n"); if (d->mode & Z_BIT_SET) dim++; if ((f = G_sites_open_new((char *) fname)) == NULL) G_fatal_error("%s: cannot open sites file %f for writing\n", G_program_name()); site = G_site_new_struct(CELL_TYPE, dim, 0, n_outfl); } else { /* close: */ DUMP("closing grass sites list\n"); fclose(f); dim = 2; G_site_free_struct(site); site = NULL; } } else { assert(site != NULL); assert(d != NULL); /* fill site: */ site->east = where->x; site->north = where->y; if (d->mode & Z_BIT_SET) site->dim[0] = where->z; if (d->mode & S_BIT_SET) site->ccat = where->u.stratum + strata_min; else site->ccat = GET_INDEX(where) + 1; for (i = 0; i < n_outfl; i++) { if (is_mv_double(&(est[i]))) { site->dbl_att[i] = -9999.0; if (DEBUG_DUMP) printlog(" [%d]:mv ", i); } else { site->dbl_att[i] = est[i]; if (DEBUG_DUMP) printlog(" value[%d]: %g ", i, site->dbl_att[i]); } } if (DEBUG_DUMP) printlog("\n"); G_site_put(f, site); } #else ErrMsg(ER_IMPOSVAL, "gstat/grass error: libgis() not linked"); #endif } }