VARIOGRAM *reml_sills(DATA *data, VARIOGRAM *vp) {
int i, j, k;
MAT **Vk = NULL, *X = MNULL;
VEC *Y = VNULL, *init = VNULL;
DPOINT *dpa, *dpb;
double dx, dy = 0.0, dz = 0.0, dzero2;
if (data == NULL || vp == NULL)
ErrMsg(ER_NULL, "reml()");
select_at(data, (DPOINT *) NULL);
if (vp->n_models <= 0)
ErrMsg(ER_VARNOTSET, "reml: please define initial variogram model");
/*
* create Y, X, Vk's only once:
*/
Y = get_y(&data, Y, 1);
X = get_X(&data, X, 1);
Vk = (MAT **) emalloc(vp->n_models * sizeof(MAT));
init = v_resize(init, vp->n_models);
for (i = 0; i < vp->n_models; i++) {
init->ve[i] = vp->part[i].sill; /* remember init. values for updating */
vp->part[i].sill = 1;
Vk[i] = m_resize(MNULL, X->m, X->m);
}
dzero2 = gl_zero * gl_zero;
for (i = 0; i < data->n_list; i++) {
for (j = 0; j < vp->n_models; j++) /* fill diagonals */
Vk[j]->me[i][i] = Covariance(vp->part[j], 0.0, 0.0, 0.0);
for (j = 0; j < i; j++) { /* off-diagonal elements: */
dpa = data->list[i];
dpb = data->list[j];
/*
* if different points coincide on a locations, shift them,
* or the covariance matrix will become singular
*/
dx = dpa->x - dpb->x;
dy = dpa->y - dpb->y;
dz = dpa->z - dpb->z;
if (data->pp_norm2(dpa, dpb) < dzero2) {
if (data->mode & X_BIT_SET)
dx = (dx >= 0 ? gl_zero : -gl_zero);
if (data->mode & Y_BIT_SET)
dy = (dy >= 0 ? gl_zero : -gl_zero);
if (data->mode & Z_BIT_SET)
dz = (dz >= 0 ? gl_zero : -gl_zero);
}
for (k = 0; k < vp->n_models; k++)
Vk[k]->me[i][j] = Vk[k]->me[j][i] =
Covariance(vp->part[k], dx, dy, dz);
}
}
if (reml(Y, X, Vk, vp->n_models, gl_iter, gl_fit_limit, init))
vp->ev->refit = 0;
else /* on convergence */
pr_warning("no convergence while fitting variogram");
for (i = 0; i < vp->n_models; i++)
vp->part[i].sill = init->ve[i];
update_variogram(vp);
if (DEBUG_VGMFIT)
logprint_variogram(vp, 1);
for (i = 0; i < vp->n_models; i++)
m_free(Vk[i]);
efree(Vk);
m_free(X);
v_free(Y);
v_free(init);
return vp;
}
static void wls_fit(VARIOGRAM *vp) {
/*
* non-linear iterative reweighted least squares fitting of variogram model to
* sample variogram (..covariogram model to sample covariogram, cross, etc.)
* all information necessary is contained in *vp.
*
* uses Marquardt-Levenberg algorithm;
* the implementation follows gnuplot's fit.c
*/
static PERM *p = PNULL;
int i, j, n_iter = 0, bounded = 0, timetostop;
double SSErr, oldSSErr = DBL_MAX, step;
LM *lm;
p = px_resize(p, vp->ev->n_est);
if (! vp->ev->cloud) {
for (i = j = 0; i < (vp->ev->zero == ZERO_AVOID ?
vp->ev->n_est-1 : vp->ev->n_est); i++) {
if (vp->ev->nh[i] > 0)
p->pe[j++] = i;
}
p->size = j;
}
lm = init_lm(NULL);
/* oldSSErr = getSSErr(vp, p, lm); */
do {
print_progress(n_iter, gl_iter);
/* if (DEBUG_VGMFIT)
printlog("%s: ", vp->descr); */
if ((vp->fit_is_singular = fit_GaussNewton(vp, p, lm, n_iter, &bounded))) {
pr_warning("singular model in variogram fit");
print_progress(gl_iter, gl_iter);
vp->SSErr = getSSErr(vp, p, lm);
return;
}
update_variogram(vp);
SSErr = getSSErr(vp, p, lm);
/* we can't use lm->SSErr here since that's only in the
X-filled-with-derivatives, not the true residuals */
step = oldSSErr - SSErr;
if (SSErr > gl_zero)
step /= SSErr;
n_iter++;
if (DEBUG_VGMFIT)
printlog("after it. %d: SSErr %g->%g, step=%g (fit_limit %g%s)\n",
n_iter, oldSSErr, SSErr, step, gl_fit_limit,
bounded ? "; bounded" : "");
oldSSErr = SSErr;
timetostop = (step < gl_fit_limit && step >= 0.0 && bounded == 0) || n_iter == gl_iter;
} while (! timetostop);
print_progress(gl_iter, gl_iter);
if (n_iter == gl_iter)
pr_warning("No convergence after %d iterations: try different initial values?", n_iter);
if (DEBUG_VGMFIT) {
printlog("# iterations: %d, SSErr %g, last step %g", n_iter, SSErr, step);
if (step < 0.0)
printlog(", last step was in the wrong direction.\n");
else
printlog("\n");
}
free_lm(lm);
vp->SSErr = SSErr;
return;
} /* wls_fit */