https://github.com/cran/fields
Raw File
Tip revision: c71fb7f6ffa323303affebf0e35a0070faa9c24d authored by Doug Nychka on 10 May 2004, 00:00:00 UTC
version 1.7.2
Tip revision: c71fb7f
make.Amatrix.Krig.r
"make.Amatrix.Krig" <-
function(out, x0 = out$x, lambda)
{
	if(missing(lambda)) {
		lambda <- out$lambda
	}
	xc <- out$transform$x.center
	xs <- out$transform$x.scale
	xM <- scale(out$xM, xc, xs)
	knots <- scale(out$knots, xc, xs)
	x0 <- scale(x0, xc, xs)
		X <- cbind(make.tmatrix(xM, out$m), qr.yq2(out$matrices$qr.T,
			do.call(out$call.name, c(out$args, list(x1 = xM, x2 = 
			knots)))))
	if(out$decomp == "DR") {
		temp <- (out$matrices$G) %*% diag(1/(1 + lambda * out$matrices$
			D))
		temp <- temp %*% t(out$matrices$G) %*% t(X)
		temp <- temp %*% diag(out$weightsM)
		#
		#
		# At this point temp maps YM 
		# to the beta vector of coefficients
		#
			temp <- cbind(make.tmatrix(x0, out$m), matrix(qr.yq2(
				out$matrices$qr.T, do.call(out$call.name, c(
				out$args, list(x1 = x0, x2 = knots)))), nrow = 
				nrow(x0))) %*% temp
	}
	if(out$decomp == "WBW") {
		nt <- out$nt
		np <- out$np
		temp <- matrix(0, out$np, out$np)
		#
		# matrix that gives the u vector
		temp[(nt + 1):np,  ] <- t(out$matrices$V) %*% qr.q2ty(out$
			matrices$qr.T, diag(sqrt(out$weightsM)))
		#
		# matrix that gives the beta vector
		temp <- out$matrices$G %*% diag((1/(1 + lambda * out$matrices$
			D))) %*% temp
		#
		#		matrix that gives the c vector
		tempc <- diag(sqrt(out$weightsM)) %*% qr.qy(out$matrices$qr.T,
			temp)
		#matrix to get the d vector
			tempd <- diag(1, np) - lambda * tempc - do.call(out$
				call.name, c(out$args, list(x1 = knots, x2 = 
				knots))) %*% tempc
		tempd <- diag(sqrt(out$weightsM)) %*% tempd
		tempd <- qr.coef(out$matrices$qr.T, tempd)
		# hat matrix is finding d and c coefficients and 
		# evaluting at basis functions.
			temp <- make.tmatrix(x0, out$m) %*% tempd + do.call(
				out$call.name, c(out$args, list(x1 = x0, x2 = 
				knots))) %*% tempc
	}
	#
	#
	return(temp)
}
back to top