https://github.com/cran/fields
Raw File
Tip revision: 92636eaee56714c89c7b7e7cdc52e0c77aeb79b3 authored by Doug Nychka on 07 February 2005, 00:00:00 UTC
version 2.3
Tip revision: 92636ea
Krig.coef.r
"Krig.coef" <-
function(out, u = NULL, lambda = NULL, yM = NULL)
{
	# check for C argument.
	C.arg.missing <- is.null(formals(get(out$call.name))$C)
	#
	# the key to computing the estimate are the coeffients c and d
	# or if these need to be recomputed, the vector u
	# for new data, u needs to be found 
	#
	if(is.null(u)) {
		u <- out$matrices$u
	}
	if(is.null(lambda)) {
		lambda <- out$lambda
	}
	if(is.null(yM)) {
		temp.yM <- out$yM
	}
	else {
		temp.yM <- yM
	}
	# use a different lambda or new data so we need to get the # new temp.d and
	#   temp.c  coefficients
	nt <- out$nt
	np <- out$np
	if(out$decomp == "DR") {
		beta <- out$matrices$G %*% ((1/(1 + lambda * out$matrices$
			D)) * u)
		temp.d <- beta[1:nt]
		temp <- c(rep(0, nt), beta[(nt + 1):np])
		#
		#
		# tranform the beta into the parameter associated with the covariance
		# function  basis set 
		#
		temp.c <- c(qr.qy(out$matrices$qr.T, temp))
	}
	if(out$decomp == "WBW") {
		xc <- out$transform$x.center
		xs <- out$transform$x.scale
		knots <- scale(out$knots, xc, xs)
		beta <- out$matrices$G %*% ((1/(1 + lambda * out$matrices$
			D)) * u)
		temp.c <- c(qr.qy(out$matrices$qr.T, c(rep(0, nt), beta[(nt +
			1):np])))
		temp.c <- temp.c * sqrt(out$weightsM)
		# end of if C.arg.missing stmt
		if(C.arg.missing) {
				temp <- temp.yM - lambda * temp.c - do.call(
					out$call.name, c(out$args, list(x1 = 
					knots, x2 = knots))) %*% temp.c
		}
		else {
				temp <- temp.yM - lambda * temp.c - do.call(
					out$call.name, c(out$args, list(x1 = 
					knots, x2 = knots, C = temp.c)))
		}
		# end of if else C.arg.missing stmt
		# multiply through by weights
		temp <- sqrt(out$weightsM) * temp
		temp.d <- qr.coef(out$matrices$qr.T, temp)
	}
	return(list(c = temp.c, d = temp.d))
}
back to top