static int
exactdet (struct Control_Points *cp, struct MATRIX *m, double a[], double b[], double E[], /* EASTING COEFFICIENTS */
double N[] /* NORTHING COEFFICIENTS */
)
{
int pntnow, currow, j;
currow = 1;
for (pntnow = 0; pntnow < cp->count; pntnow++)
{
if (cp->status[pntnow] > 0)
{
/* POPULATE MATRIX M */
for (j = 1; j <= m->n; j++)
M (currow, j) = term (j, cp->e1[pntnow], cp->n1[pntnow]);
/* POPULATE MATRIX A AND B */
a[currow - 1] = cp->e2[pntnow];
b[currow - 1] = cp->n2[pntnow];
currow++;
}
}
if (currow - 1 != m->n)
return MINTERR;
return solvemat (m, a, b, E, N);
}
static int calcls (
struct Control_Points *cp,
struct MATRIX *m,
double x_mean,
double y_mean,
double a[],
double b[],
double E[], /* EASTING COEFFICIENTS */
double N[] /* NORTHING COEFFICIENTS */
)
{
int i = 0, j = 0, n = 0, numactive = 0;
/* INITIALIZE THE UPPER HALF OF THE MATRIX AND THE TWO COLUMN VECTORS */
for(i = 1 ; i <= m->n ; i++)
{
for(j = i ; j <= m->n ; j++)
M(i,j) = 0.0;
a[i-1] = b[i-1] = 0.0;
}
/* SUM THE UPPER HALF OF THE MATRIX AND THE COLUMN VECTORS ACCORDING TO
THE LEAST SQUARES METHOD OF SOLVING OVER DETERMINED SYSTEMS */
for(n = 0 ; n < cp->count ; n++)
{
if(cp->status[n] > 0)
{
numactive++;
for(i = 1 ; i <= m->n ; i++)
{
for(j = i ; j <= m->n ; j++)
M(i,j) += term(i,cp->e1[n] - x_mean, cp->n1[n] - y_mean) * term(j,cp->e1[n] - x_mean, cp->n1[n] - y_mean);
a[i-1] += cp->e2[n] * term(i,cp->e1[n] - x_mean, cp->n1[n] - y_mean);
b[i-1] += cp->n2[n] * term(i,cp->e1[n] - x_mean, cp->n1[n] - y_mean);
}
}
}
if(numactive <= m->n)
return(MINTERR);
/* TRANSPOSE VALUES IN UPPER HALF OF M TO OTHER HALF */
for(i = 2 ; i <= m->n ; i++)
{
for(j = 1 ; j < i ; j++)
M(i,j) = M(j,i);
}
return(solvemat(m,a,b,E,N));
}
/*---------------------------------------------------------------------------
* makeInverseXformFromMatrix -- make a fut of given gridsize from given
* matrix data for inverse transform (XYZ -> RGB); return status code
*---------------------------------------------------------------------------
*/
PTErr_t
makeInverseXformFromMatrix (LPMATRIXDATA mdata,
KpUInt32_t interpMode,
KpInt32_p dim,
fut_p theFut)
{
PTErr_t PTErr = KCP_SUCCESS;
ResponseRecord_p rrp;
KpInt32_t i;
fut_chan_p theChan;
fut_gtbl_p theGtbl;
fut_otbl_p theOtbl;
mf2_tbldat_p gtblDat[3], otblDat, prevOtblDat;
KpUInt16_t prevGamma = 0, thisGamma;
double fwdgamma, one[3];
double offset[3] = {1.0 / 3.0, 1.0 / 3.0, 1.0 / 3.0};
KpUInt16_t *pCurveData = NULL;
for (i = 0; i < 3; i++) {
if (!IS_CHAN(theChan = theFut->chan[i])
|| !IS_GTBL(theGtbl = theChan->gtbl)
|| ((gtblDat[i] = theGtbl->refTbl) == NULL) /* Get grid tables */
|| !IS_OTBL(theOtbl = theChan->otbl)
|| ((otblDat = theOtbl->refTbl) == NULL)) { /* Get output table */
return KCP_INCON_PT;
}
if (theOtbl->refTblEntries != FUT_OUTTBL_ENT) return KCP_INCON_PT;
/* Get ResponseRecord: */
rrp = mdata->outResponse[i];
if (NULL == rrp) {
break; /* must only have output tables */
}
if (PARA_TYPE_SIG == rrp->TagSig)
{
pCurveData = (KpUInt16_p) allocBufferPtr (MFV_CURVE_TBL_ENT*sizeof(KpUInt16_t)); /* get memory for curve data */
if (NULL == pCurveData) {
return KCP_NO_MEMORY;
}
makeCurveFromPara (rrp->ParaFunction, rrp->ParaParams, pCurveData, MFV_CURVE_TBL_ENT);
rrp->CurveCount = MFV_CURVE_TBL_ENT;
rrp->CurveData = pCurveData;
}
if ((rrp->CurveCount > 0) && (rrp->CurveData == (KpUInt16_p)NULL)) {
PTErr = KCP_INCON_PT;
goto ErrOut;
}
/* Recompute output table: */
switch (rrp->CurveCount) {
case 0: /* linear response, with clipping */
calcOtbl0 (otblDat);
break;
case 1: /* power law */
thisGamma = rrp->CurveData[0];
if (prevGamma == thisGamma) { /* same gamma, just copy table */
memcpy (otblDat, prevOtblDat, sizeof (*otblDat) * FUT_OUTTBL_ENT);
}
else {
prevGamma = thisGamma;
prevOtblDat = otblDat;
fwdgamma = (double)thisGamma / SCALEDOT8;
if (fwdgamma <= 0.0) {
PTErr = KCP_INCON_PT;
goto ErrOut;
}
calcOtbl1 (otblDat, fwdgamma);
}
break;
default: /* look-up table of arbitrary length */
makeInverseMonotonic (rrp->CurveCount, rrp->CurveData);
if (rrp->CurveCount == theOtbl->refTblEntries) { /* ready-to-use look-up table */
memcpy (otblDat, rrp->CurveData, sizeof (*otblDat) * rrp->CurveCount);
}
else {
PTErr = calcOtblN (otblDat, rrp, interpMode);
if (PTErr != KCP_SUCCESS) {
PTErr = KCP_INCON_PT;
goto ErrOut;
}
}
break;
}
}
/* Compute inverse matrix (XYZ -> RGB): */
one[0] = one[1] = one[2] = 1.0; /* arbitrary vector */
/* replaces matrix with inverse */
if (solvemat (3, mdata->matrix, one) != 0) {
PTErr = KCP_INCON_PT;
goto ErrOut;
}
/* Rescale given matrix by factor of 3 for extended range: */
for (i = 0; i < 3; i++) {
KpInt32_t j;
for (j = 0; j < 3; j++) {
mdata->matrix[i][j] /= 3.0;
}
}
/* Replace grid tables: */
calcGtbl3 (gtblDat, dim, mdata->matrix, offset); /* with offset */
ErrOut:
if (NULL != pCurveData) {
freeBufferPtr (pCurveData);
}
return PTErr;
}
int main(int argc, char *argv[])
{
unsigned int r, c, rows, cols, n_valid; /* totals */
int *mapx_fd, mapy_fd, mapres_fd, mapest_fd;
int i, j, k, n_predictors;
double *sumX, sumY, *sumsqX, sumsqY, *sumXY;
double *meanX, meanY, *varX, varY, *sdX, sdY;
double yest, yres; /* estimated y, residual */
double sumYest, *SSerr_without;
double SE;
double meanYest, meanYres, varYest, varYres, sdYest, sdYres;
double SStot, SSerr, SSreg;
double **a;
struct MATRIX *m, *m_all;
double **B, Rsq, Rsqadj, F, t, AIC, AICc, BIC;
unsigned int count = 0;
DCELL **mapx_buf, *mapy_buf, *mapx_val, mapy_val, *mapres_buf, *mapest_buf;
char *name;
struct Option *input_mapx, *input_mapy, *output_res, *output_est, *output_opt;
struct Flag *shell_style;
struct Cell_head region;
struct GModule *module;
G_gisinit(argv[0]);
module = G_define_module();
G_add_keyword(_("raster"));
G_add_keyword(_("statistics"));
G_add_keyword(_("regression"));
module->description =
_("Calculates multiple linear regression from raster maps.");
/* Define the different options */
input_mapx = G_define_standard_option(G_OPT_R_INPUTS);
input_mapx->key = "mapx";
input_mapx->description = (_("Map for x coefficient"));
input_mapy = G_define_standard_option(G_OPT_R_INPUT);
input_mapy->key = "mapy";
input_mapy->description = (_("Map for y coefficient"));
output_res = G_define_standard_option(G_OPT_R_OUTPUT);
output_res->key = "residuals";
output_res->required = NO;
output_res->description = (_("Map to store residuals"));
output_est = G_define_standard_option(G_OPT_R_OUTPUT);
output_est->key = "estimates";
output_est->required = NO;
output_est->description = (_("Map to store estimates"));
output_opt = G_define_standard_option(G_OPT_F_OUTPUT);
output_opt->key = "output";
output_opt->required = NO;
output_opt->description =
(_("ASCII file for storing regression coefficients (output to screen if file not specified)."));
shell_style = G_define_flag();
shell_style->key = 'g';
shell_style->description = _("Print in shell script style");
if (G_parser(argc, argv))
exit(EXIT_FAILURE);
name = output_opt->answer;
if (name != NULL && strcmp(name, "-") != 0) {
if (NULL == freopen(name, "w", stdout)) {
G_fatal_error(_("Unable to open file <%s> for writing"), name);
}
}
G_get_window(®ion);
rows = region.rows;
cols = region.cols;
/* count x maps */
for (i = 0; input_mapx->answers[i]; i++);
n_predictors = i;
/* allocate memory for x maps */
mapx_fd = (int *)G_malloc(n_predictors * sizeof(int));
sumX = (double *)G_malloc(n_predictors * sizeof(double));
sumsqX = (double *)G_malloc(n_predictors * sizeof(double));
sumXY = (double *)G_malloc(n_predictors * sizeof(double));
SSerr_without = (double *)G_malloc(n_predictors * sizeof(double));
meanX = (double *)G_malloc(n_predictors * sizeof(double));
varX = (double *)G_malloc(n_predictors * sizeof(double));
sdX = (double *)G_malloc(n_predictors * sizeof(double));
mapx_buf = (DCELL **)G_malloc(n_predictors * sizeof(DCELL *));
mapx_val = (DCELL *)G_malloc((n_predictors + 1) * sizeof(DCELL));
/* ordinary least squares */
m = NULL;
m_all = (struct MATRIX *)G_malloc((n_predictors + 1) * sizeof(struct MATRIX));
a = (double **)G_malloc((n_predictors + 1) * sizeof(double *));
B = (double **)G_malloc((n_predictors + 1) * sizeof(double *));
m = &(m_all[0]);
m->n = n_predictors + 1;
m->v = (double *)G_malloc(m->n * m->n * sizeof(double));
a[0] = (double *)G_malloc(m->n * sizeof(double));
B[0] = (double *)G_malloc(m->n * sizeof(double));
for (i = 0; i < m->n; i++) {
for (j = i; j < m->n; j++)
M(m, i, j) = 0.0;
a[0][i] = 0.0;
B[0][i] = 0.0;
}
for (k = 1; k <= n_predictors; k++) {
m = &(m_all[k]);
m->n = n_predictors;
m->v = (double *)G_malloc(m->n * m->n * sizeof(double));
a[k] = (double *)G_malloc(m->n * sizeof(double));
B[k] = (double *)G_malloc(m->n * sizeof(double));
for (i = 0; i < m->n; i++) {
for (j = i; j < m->n; j++)
M(m, i, j) = 0.0;
a[k][i] = 0.0;
B[k][i] = 0.0;
}
}
/* open maps */
G_debug(1, "open maps");
for (i = 0; i < n_predictors; i++) {
mapx_fd[i] = Rast_open_old(input_mapx->answers[i], "");
}
mapy_fd = Rast_open_old(input_mapy->answer, "");
for (i = 0; i < n_predictors; i++)
mapx_buf[i] = Rast_allocate_d_buf();
mapy_buf = Rast_allocate_d_buf();
for (i = 0; i < n_predictors; i++) {
sumX[i] = sumsqX[i] = sumXY[i] = 0.0;
meanX[i] = varX[i] = sdX[i] = 0.0;
SSerr_without[i] = 0.0;
}
sumY = sumsqY = meanY = varY = sdY = 0.0;
sumYest = meanYest = varYest = sdYest = 0.0;
meanYres = varYres = sdYres = 0.0;
/* read input maps */
G_message(_("First pass..."));
n_valid = 0;
mapx_val[0] = 1.0;
for (r = 0; r < rows; r++) {
G_percent(r, rows, 2);
for (i = 0; i < n_predictors; i++)
Rast_get_d_row(mapx_fd[i], mapx_buf[i], r);
Rast_get_d_row(mapy_fd, mapy_buf, r);
for (c = 0; c < cols; c++) {
int isnull = 0;
for (i = 0; i < n_predictors; i++) {
mapx_val[i + 1] = mapx_buf[i][c];
if (Rast_is_d_null_value(&(mapx_val[i + 1]))) {
isnull = 1;
break;
}
}
if (isnull)
continue;
mapy_val = mapy_buf[c];
if (Rast_is_d_null_value(&mapy_val))
continue;
for (i = 0; i <= n_predictors; i++) {
double val1 = mapx_val[i];
for (j = i; j <= n_predictors; j++) {
double val2 = mapx_val[j];
m = &(m_all[0]);
M(m, i, j) += val1 * val2;
/* linear model without predictor k */
for (k = 1; k <= n_predictors; k++) {
if (k != i && k != j) {
int i2 = k > i ? i : i - 1;
int j2 = k > j ? j : j - 1;
m = &(m_all[k]);
M(m, i2, j2) += val1 * val2;
}
}
}
a[0][i] += mapy_val * val1;
for (k = 1; k <= n_predictors; k++) {
if (k != i) {
int i2 = k > i ? i : i - 1;
a[k][i2] += mapy_val * val1;
}
}
if (i > 0) {
sumX[i - 1] += val1;
sumsqX[i - 1] += val1 * val1;
sumXY[i - 1] += val1 * mapy_val;
}
}
sumY += mapy_val;
sumsqY += mapy_val * mapy_val;
count++;
}
}
G_percent(rows, rows, 2);
if (count < n_predictors + 1)
G_fatal_error(_("Not enough valid cells available"));
for (k = 0; k <= n_predictors; k++) {
m = &(m_all[k]);
/* TRANSPOSE VALUES IN UPPER HALF OF M TO OTHER HALF */
for (i = 1; i < m->n; i++)
for (j = 0; j < i; j++)
M(m, i, j) = M(m, j, i);
if (!solvemat(m, a[k], B[k])) {
for (i = 0; i <= n_predictors; i++) {
fprintf(stdout, "b%d=0.0\n", i);
}
G_fatal_error(_("Multiple regression failed"));
}
}
/* second pass */
G_message(_("Second pass..."));
/* residuals output */
if (output_res->answer) {
mapres_fd = Rast_open_new(output_res->answer, DCELL_TYPE);
mapres_buf = Rast_allocate_d_buf();
}
else {
mapres_fd = -1;
mapres_buf = NULL;
}
/* estimates output */
if (output_est->answer) {
mapest_fd = Rast_open_new(output_est->answer, DCELL_TYPE);
mapest_buf = Rast_allocate_d_buf();
}
else {
mapest_fd = -1;
mapest_buf = NULL;
}
for (i = 0; i < n_predictors; i++)
meanX[i] = sumX[i] / count;
meanY = sumY / count;
SStot = SSerr = SSreg = 0.0;
for (r = 0; r < rows; r++) {
G_percent(r, rows, 2);
for (i = 0; i < n_predictors; i++)
Rast_get_d_row(mapx_fd[i], mapx_buf[i], r);
Rast_get_d_row(mapy_fd, mapy_buf, r);
if (mapres_buf)
Rast_set_d_null_value(mapres_buf, cols);
if (mapest_buf)
Rast_set_d_null_value(mapest_buf, cols);
for (c = 0; c < cols; c++) {
int isnull = 0;
for (i = 0; i < n_predictors; i++) {
mapx_val[i + 1] = mapx_buf[i][c];
if (Rast_is_d_null_value(&(mapx_val[i + 1]))) {
isnull = 1;
break;
}
}
if (isnull)
continue;
yest = 0.0;
for (i = 0; i <= n_predictors; i++) {
yest += B[0][i] * mapx_val[i];
}
if (mapest_buf)
mapest_buf[c] = yest;
mapy_val = mapy_buf[c];
if (Rast_is_d_null_value(&mapy_val))
continue;
yres = mapy_val - yest;
if (mapres_buf)
mapres_buf[c] = yres;
SStot += (mapy_val - meanY) * (mapy_val - meanY);
SSreg += (yest - meanY) * (yest - meanY);
SSerr += yres * yres;
for (k = 1; k <= n_predictors; k++) {
double yesti = 0.0;
double yresi;
/* linear model without predictor k */
for (i = 0; i <= n_predictors; i++) {
if (i != k) {
j = k > i ? i : i - 1;
yesti += B[k][j] * mapx_val[i];
}
}
yresi = mapy_val - yesti;
/* linear model without predictor k */
SSerr_without[k - 1] += yresi * yresi;
varX[k - 1] = (mapx_val[k] - meanX[k - 1]) * (mapx_val[k] - meanX[k - 1]);
}
}
if (mapres_buf)
Rast_put_d_row(mapres_fd, mapres_buf);
if (mapest_buf)
Rast_put_d_row(mapest_fd, mapest_buf);
}
G_percent(rows, rows, 2);
fprintf(stdout, "n=%d\n", count);
/* coefficient of determination aka R squared */
Rsq = 1 - (SSerr / SStot);
fprintf(stdout, "Rsq=%f\n", Rsq);
/* adjusted coefficient of determination */
Rsqadj = 1 - ((SSerr * (count - 1)) / (SStot * (count - n_predictors - 1)));
fprintf(stdout, "Rsqadj=%f\n", Rsqadj);
/* F statistic */
/* F = ((SStot - SSerr) / (n_predictors)) / (SSerr / (count - n_predictors));
* , or: */
F = ((SStot - SSerr) * (count - n_predictors - 1)) / (SSerr * (n_predictors));
fprintf(stdout, "F=%f\n", F);
i = 0;
/* constant aka estimate for intercept in R */
fprintf(stdout, "b%d=%f\n", i, B[0][i]);
/* t score for R squared of the full model, unused */
t = sqrt(Rsq) * sqrt((count - 2) / (1 - Rsq));
/*
fprintf(stdout, "t%d=%f\n", i, t);
*/
/* AIC, corrected AIC, and BIC information criteria for the full model */
AIC = count * log(SSerr / count) + 2 * (n_predictors + 1);
fprintf(stdout, "AIC=%f\n", AIC);
AICc = AIC + (2 * n_predictors * (n_predictors + 1)) / (count - n_predictors - 1);
fprintf(stdout, "AICc=%f\n", AICc);
BIC = count * log(SSerr / count) + log(count) * (n_predictors + 1);
fprintf(stdout, "BIC=%f\n", BIC);
/* error variance of the model, identical to R */
SE = SSerr / (count - n_predictors - 1);
/*
fprintf(stdout, "SE=%f\n", SE);
fprintf(stdout, "SSerr=%f\n", SSerr);
*/
for (i = 0; i < n_predictors; i++) {
fprintf(stdout, "\npredictor%d=%s\n", i + 1, input_mapx->answers[i]);
fprintf(stdout, "b%d=%f\n", i + 1, B[0][i + 1]);
if (n_predictors > 1) {
double Rsqi, SEi, sumsqX_corr;
/* corrected sum of squares for predictor [i] */
sumsqX_corr = sumsqX[i] - sumX[i] * sumX[i] / (count - n_predictors - 1);
/* standard error SE for predictor [i] */
/* SE[i] with only one predictor: sqrt(SE / sumsqX_corr)
* this does not work with more than one predictor */
/* in R, SEi is sqrt(diag(R) * resvar) with
* R = ???
* resvar = rss / rdf = SE global
* rss = sum of squares of the residuals
* rdf = residual degrees of freedom = count - n_predictors - 1 */
SEi = sqrt(SE / (Rsq * sumsqX_corr));
/*
fprintf(stdout, "SE%d=%f\n", i + 1, SEi);
*/
/* Sum of squares for predictor [i] */
/*
fprintf(stdout, "SSerr%d=%f\n", i + 1, SSerr_without[i] - SSerr);
*/
/* R squared of the model without predictor [i] */
/* Rsqi = 1 - SSerr_without[i] / SStot; */
/* the additional amount of variance explained
* when including predictor [i] :
* Rsq - Rsqi */
Rsqi = (SSerr_without[i] - SSerr) / SStot;
fprintf(stdout, "Rsq%d=%f\n", i + 1, Rsqi);
/* t score for Student's t distribution, unused */
t = (B[0][i + 1]) / SEi;
/*
fprintf(stdout, "t%d=%f\n", i + 1, t);
*/
/* F score for Fisher's F distribution
* here: F score to test if including predictor [i]
* yields a significant improvement
* after Lothar Sachs, Angewandte Statistik:
* F = (Rsq - Rsqi) * (count - n_predictors - 1) / (1 - Rsq) */
/* same like Sumsq / SE */
/* same like (SSerr_without[i] / SSerr - 1) * (count - n_predictors - 1) */
/* same like R-stats when entered in R-stats as last predictor */
F = (SSerr_without[i] / SSerr - 1) * (count - n_predictors - 1);
fprintf(stdout, "F%d=%f\n", i + 1, F);
/* AIC, corrected AIC, and BIC information criteria for
* the model without predictor [i] */
AIC = count * log(SSerr_without[i] / count) + 2 * (n_predictors);
fprintf(stdout, "AIC%d=%f\n", i + 1, AIC);
AICc = AIC + (2 * (n_predictors - 1) * n_predictors) / (count - n_predictors - 2);
fprintf(stdout, "AICc%d=%f\n", i + 1, AICc);
BIC = count * log(SSerr_without[i] / count) + (n_predictors - 1) * log(count);
fprintf(stdout, "BIC%d=%f\n", i + 1, BIC);
}
}
for (i = 0; i < n_predictors; i++) {
Rast_close(mapx_fd[i]);
G_free(mapx_buf[i]);
}
Rast_close(mapy_fd);
G_free(mapy_buf);
if (mapres_fd > -1) {
struct History history;
Rast_close(mapres_fd);
G_free(mapres_buf);
Rast_short_history(output_res->answer, "raster", &history);
Rast_command_history(&history);
Rast_write_history(output_res->answer, &history);
}
if (mapest_fd > -1) {
struct History history;
Rast_close(mapest_fd);
G_free(mapest_buf);
Rast_short_history(output_est->answer, "raster", &history);
Rast_command_history(&history);
Rast_write_history(output_est->answer, &history);
}
exit(EXIT_SUCCESS);
}
