Nothing
getOutputTable = function(object) {
what = object$outputWhat
pred = object$predictions
nCols = length(what)
blockWhat = object$blockWhat
bCols = length(names(blockWhat))
nsim = ifelse("nsim" %in% names(what),what$nsim,0)
out = matrix(NA, length(pred[[1]]), nCols+bCols+max(nsim-1,0))
ns = c("x", "y")
if (dim(coordinates(pred))[2] == 3) ns = c("x", "y", "z")
ntype = NULL
if (all(c("var1.pred","var1.var") %in% names(pred))) ntype = "gstat"
if (length(grep("sim",names(pred)))>0) {
ntype = c(ntype,"simul")
sims = pred@data[,grep("sim",names(pred@data))]
}
for (i in 1:nCols) {
if (names(what)[i] == "mean") {
if ("mean" %in% names(pred)) {
out[,i] = pred$mean
} else if ("var1.pred" %in% names(pred)) {
out[,i] = pred$var1.pred
} else if ("simul" %in% ntype) {
out[,i] = apply(sims,MARGIN=1,FUN=function(arr) mean(arr))
} else {
stop(paste("Warning: Could not create variable mean, returning NA"))
out[,i] = NA
}
ns = c(ns, "mean")
} else if (names(what)[i] == "variance") {
if ("variance" %in% names(pred)) {
out[,i] = pred$variance
} else if ("var1.var" %in% names(pred)) {
out[,i] = pred$var1.var
} else if ("simul" %in% ntype) {
out[,i] = apply(sims,MARGIN=1,FUN=function(arr) var(arr))
} else {
stop(paste("Warning: Could not create variable variance, returning NA"))
out[,i] = NA
}
ns = c(ns, "variance")
} else if (names(what)[i] == "quantile") {
qname = paste("quantile",what[[i]],sep="")
if (length(grep("quantile",names(pred)))>0) {
out[,i] = pred[[qname]]
} else if ("gstat" %in% ntype) {
out[,i] = qnorm(what[[i]], pred$var1.pred, sqrt(pred$var1.var))
} else if ("simul" %in% ntype) {
out[,i] = apply(sims,MARGIN=1,FUN=function(arr) quantile(arr,what[[i]]))
} else {
stop(paste("Warning: Could not create variable quantile = ", what[i],", returning NA"))
out[,i] = NA
}
ns = c(ns, qname)
} else if (names(what)[i] == "cumdistr") {
cname = paste("cumdistr",what[[i]],sep="")
if (length(grep("cumdistr",names(pred)))>0) {
out[,i] = pred[[cname]]
} else if ("gstat" %in% ntype) {
out[,i] = pnorm(what[[i]], pred$var1.pred, sqrt(pred$var1.var))
} else if ("simul" %in% ntype) {
out[,i] = apply(sims,MARGIN=1,FUN=function(arr) sum(I(arr) < what[[i]])/length(arr))
} else {
stop(paste("Warning: Could not create variable cumdistr = ", what[i],", returning NA"))
out[,i] = NA
}
ns = c(ns, cname)
} else if (names(what)[i] == "excprob") {
ename = paste("excprob",what[[i]],sep="")
if (length(grep("excprob",names(pred)))>0) {
out[,i] = pred[[ename]]
} else if ("gstat" %in% ntype) {
out[,i] = 1 - pnorm(what[[i]], pred$var1.pred, sqrt(pred$var1.var))
} else if ("simul" %in% ntype) {
out[,i] = apply(sims,MARGIN=1,FUN=function(arr) sum(I(arr) > what[[i]])/length(arr))
} else {
stop(paste("Warning: Could not create variable excprob = ", what[i],", returning NA"))
out[,i] = NA
}
ns = c(ns, ename)
} else if (names(what)[i] == "MOK") {
mname = paste("MOK",what[[i]],sep="")
if (length(grep("MOK",names(pred)))>0) {
out[,i] = pred[[mname]]
} else {
stop(paste("Warning: Could not create variable MOK = ", what[i],", returning NA"))
out[,i] = NA
}
ns = c(ns, mname)
} else if (names(what)[i] == "IWQSEL") {
iname = paste("IWQSEL",what[[i]],sep="")
if (length(grep("IWQSEL",names(pred)))>0) {
out[,i] = pred[[iname]]
} else {
stop(paste("Warning: Could not create variable IWQSEL = ", what[i],", returning NA"))
out[,i] = NA
}
ns = c(ns, iname)
} else if (names(what)[i] == "nsim") {
if ("simul" %in% ntype && dim(sims)[2] >= nsim) {
out[,i:(i+nsim-1)] = as.matrix(sims[,1:nsim])
} else {
stop(paste("Warning: Number of simulations is zero or smaller than nsim = ",nsim))
}
ns = c(ns,names(sims))
} else
stop(paste("unknown request: ", names(what)[i]))
}
# Block Predictions:
i = 0
for (j in numeric(length(names(blockWhat)))) {
i = i+1
ib = nCols+i
if (names(blockWhat)[i] == "fat") {
vname = paste("fat",blockWhat[[i]],sep="")
if (length(grep("fat",names(pred)))>0) {
out[,ib] = pred[[vname]]
} else {
stop(paste("Warning: Could not create variable fat, returning NA"))
out[,ib] = NA
}
ns = c(ns, vname)
} else if (names(blockWhat)[i] == "fatVar") {
vname = paste("fatVar",blockWhat[[i]],sep="")
if (length(grep("fatVar",names(pred)))>0) {
out[,ib] = pred[[vname]]
} else {
stop(paste("Warning: Could not create variable fatVar, returning NA"))
out[,ib] = NA
}
ns = c(ns, vname)
} else if (names(blockWhat)[i] == "blockMax") {
if ("blockMax" %in% names(pred)) {
out[,ib] = pred$blockMax
} else {
stop(paste("Warning: Could not create variable blockMax, returning NA"))
out[,ib] = NA
}
ns = c(ns, "blockMax")
} else if (names(blockWhat)[i] == "blockMaxVar") {
if ("blockMaxVar" %in% names(pred)) {
out[,ib] = pred$blockMaxVar
} else {
stop(paste("Warning: Could not create variable blockMaxVar, returning NA"))
out[,ib] = NA
}
ns = c(ns, "blockMaxVar")
} else if (names(blockWhat)[i] == "blockMin") {
if ("blockMin" %in% names(pred)) {
out[,ib] = pred$blockMin
} else {
stop(paste("Warning: Could not create variable blockMin, returning NA"))
out[,ib] = NA
}
ns = c(ns, "blockMin")
} else if (names(blockWhat)[i] == "blockMinVar") {
vname = paste("blockMinVar",blockWhat[[i]],sep="")
if (length(grep("blockMinVar",names(pred)))>0) {
out[,ib] = pred$blockMinVar
} else {
stop(paste("Warning: Could not create variable blockMinVar, returning NA"))
out[,ib] = NA
}
ns = c(ns, "blockMinVar")
} else if (names(blockWhat)[i] != "none") {
stop(paste("unknown request: ", names(blockWhat)[i]))
}
}
out = signif(out,digits = 6)
ret = cbind(coordinates(object$predictions), out)
colnames(ret) = ns
ret
}
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.