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
}
}
