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