Nothing
mlegp2 <- function(ZZ, XX, orig.XX, nugget, nugget.known, reps, un.sum, numEstimates,constantMean, simplex.ntries, simplex.maxiter, simplex.reltol, BFGS.maxiter, BFGS.tol, BFGS.h, min.nugget, verbose, param.names = param.names) {
Z = ZZ$Z
i = ZZ$i
seed = ZZ$seed
if (verbose > 0) {
cat("========== FITTING GP # "); cat(i);
cat(" ==============================\n")
}
if (nugget.known == 1 ) {
if(is.null(nugget)) { ## calculate the BLUE of the nugget; each sample variance scaled by (n_i - 1) / (N-k)
## check that reps > 1 for at least one
if (max(reps) < 2) {
stop("error: cannot estimate nugget when replicate runs are not available; set nugget to its known value or include replicate observations")
}
index = reps > 1
nugget = sum( un.sum$uniqueVar[index,i]*(reps[index]-1) / (sum(reps[index]) - sum(index)))
}
if (length(nugget) > 1) { ## nugget matrix is for unique obs
nugget = uniqueSummary(orig.XX, matrix(nugget))$uniqueMeans
}
nugget = nugget / reps
}
if (is.null(nugget) || (length(nugget) == 1 && nugget != 0)) {
if (anyReps(XX)) nugget = estimateNugget(XX,Z )
}
simplex.abstol = -99999
success = 0
estimates = rep(0,numEstimates)
returnFromC = .C("fitGPfromR", as.double(XX), as.integer(nrow(XX)), as.integer(ncol(XX)),
as.double(Z), as.integer(nrow(Z)),
as.integer(constantMean),
as.integer(simplex.ntries), as.integer(simplex.maxiter),
as.double(simplex.abstol), as.double(simplex.reltol),
as.integer(BFGS.maxiter), as.double(BFGS.tol), as.double(BFGS.h),
as.integer(seed), as.double(nugget), as.integer(length(nugget)), as.double(min.nugget),
estimates = as.double(estimates), verbose = as.integer(verbose), nugget.known = as.integer(nugget.known), success = as.integer(success),
PACKAGE="mlegp")
if (returnFromC$success != 0) {
cat("ERROR: GP cannot be created\n")
return (NULL)
}
estimates = returnFromC$estimates
numParams = dim(XX)[2]
regSize = 1
meanReg = estimates[1]
if (constantMean == 0) {
regSize = dim(XX)[2] + 1
meanReg = estimates[1:regSize]
}
## remove meanReg params; now we have correlation params, sig2, and (possibly) nugget
estimates = estimates[(regSize+1):length(estimates)] ## remove mean reg params
beta = estimates[1:numParams]
a = rep(2, numParams)
sig2 = estimates[numParams+1]
if (is.null(nugget)) nugget = 0
if (length(nugget) > 1 && nugget.known == 0) {
if (verbose > 0) {
cat(paste("nugget matrix will be scaled by: ", estimates[numParams+2]))
cat("\n")
}
nugget = nugget * estimates[numParams+2]
}
else {
if ((length(nugget) > 1 || nugget > 0) && nugget.known == 0) {
nugget = estimates[numParams+2]
}
}
if (is.null(param.names)) param.names = paste("p",1:dim(XX)[2],sep="")
nugget = nugget + min.nugget
if (verbose > 0) cat("creating gp object...")
fit1 = createGP(XX, as.matrix(Z), beta, a, meanReg, sig2, nugget,
param.names = param.names, constantMean = constantMean)
if(is.null(fit1)) {
cat("GP #"); cat(i); cat(" cannot be created...exiting mlegp\n")
return (NULL)
}
## report nugget for single observation
if (nugget.known ==1 ) {
fit1$nugget = fit1$nugget*reps
uniqueNug = unique(fit1$nugget)
if(length(uniqueNug) == 1) fit1$nugget = as.numeric(uniqueNug)
}
if (verbose > 0) cat("...done\n\n")
return(fit1)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.