https://github.com/cran/gstat
Tip revision: 1b2742a3d71abc7fbde73ca141b23e1375f185bf authored by Edzer Pebesma on 30 October 2011, 00:00:00 UTC
version 1.0-9
version 1.0-9
Tip revision: 1b2742a
report.c
/*
Gstat, a program for geostatistical modelling, prediction and simulation
Copyright 1992, 2011 (C) Edzer Pebesma
Edzer Pebesma, edzer.pebesma@uni-muenster.de
Institute for Geoinformatics (ifgi), University of Münster
Weseler Straße 253, 48151 Münster, Germany. Phone: +49 251
8333081, Fax: +49 251 8339763 http://ifgi.uni-muenster.de
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version. As a special exception, linking
this program with the Qt library is permitted.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
(read also the files COPYING and Copyright)
*/
/*
* report.c: write (cross) validation report
*/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <math.h>
#include "defs.h"
#ifdef HAVE_LIBGIS
#include "gis.h"
#include "site.h"
#endif
#include "userio.h"
#include "data.h"
#include "utils.h" /* my_dtoa() */
#include "debug.h"
#include "glvars.h"
#include "stat.h"
#include "predict.h"
#include "report.h"
static void write_ascii_header(FILE *out_file, DATA *data,
int n_outfl);
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 CDECL (*)(const void *,const void *)) compare);
while (!is_mv_double(&(xdata[nXdata])) && nXdata < ndata)
nXdata++;
qsort(xpred, (size_t) ndata, sizeof(double),
(int CDECL (*)(const void *,const void *)) compare);
while (!is_mv_double(&(xpred[nXpred])) && nXpred < ndata)
nXpred++;
qsort(xdiff, (size_t) ndata, sizeof(double),
(int CDECL (*)(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 CDECL (*)(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 CDECL (*)(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;
}
int CDECL 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;
}
#ifndef USING_R
static void write_ascii_header(FILE *out_file, DATA *data, int n_outfl) {
char *lf = "\n";
int i = 0;
if (data->mode & X_BIT_SET) i++; /* xcoord */
if (data->mode & Y_BIT_SET) i++; /* ycoord */
if (data->mode & Z_BIT_SET) i++; /* zcoord */
if (data->mode & S_BIT_SET) i++;
if (data->colnvalue > 0) i++; /* obs */
if (data->point_ids) i++;
if (get_mode() == STRATIFY)
i+= 2;
else
i+= n_outfl; /* est[0], .. , est[n_outfl-1] */
if (data->type.type == DATA_EAS) {
fprintf(out_file, "prediction results from file: %s variable: %s\n",
data->fname, data->variable);
fprintf(out_file, "%d\n", i);
} else {
fprintf(out_file, "#");
lf = " ";
}
if (data->mode & X_BIT_SET) fprintf(out_file, "%s%s", NULS(data->x_coord), lf);
if (data->mode & Y_BIT_SET) fprintf(out_file, "%s%s", NULS(data->y_coord), lf);
if (data->mode & Z_BIT_SET) fprintf(out_file, "%s%s", NULS(data->z_coord), lf);
if (data->mode & S_BIT_SET) fprintf(out_file, "%s%s", NULS(data->s_coord), lf);
if (data->colnvalue > 0) fprintf(out_file, "%s%s", NULS(data->variable), lf);
if (get_mode() == STRATIFY)
fprintf(out_file, "predictions%svariances%s", lf, lf);
else
for (i = 0; i < n_outfl; i++)
fprintf(out_file, "%s%s", what_is_outfile(i), lf);
if (data->point_ids)
fprintf(out_file, "%s%s",data->id_name,lf);
if (data->type.type != DATA_EAS) fprintf(out_file, "\n");
}
static void output_line(FILE *out_file, DATA *data, DPOINT *where,
double *est, int n_outfl) {
int i;
assert(out_file != NULL);
assert(out_file != stdout);
if (data->mode & X_BIT_SET) {
fprintf(out_file, " ");
fprintf(out_file, gl_format, where->x);
}
if (data->mode & Y_BIT_SET) {
fprintf(out_file, " ");
fprintf(out_file, gl_format, where->y);
}
if (data->mode & Z_BIT_SET) {
fprintf(out_file, " ");
fprintf(out_file, gl_format, where->z);
}
if (data->mode & S_BIT_SET)
fprintf(out_file, " %d", where->u.stratum + strata_min);
if (data->colnvalue > 0) {
fprintf(out_file, " ");
fprintf(out_file, gl_format, where->attr);
}
for (i = 0; i < n_outfl; i++)
fprintf(out_file, " %s", my_dtoa(gl_format, &(est[i])));
if (data->point_ids)
fprintf(out_file, " %s",data->point_ids[GET_INDEX(where)]);
fprintf(out_file, "\n");
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
}
}
#endif /* USING_R */