Nothing
###Plot
setMethod("plot",signature(x="Evaluation",y="missing"),
function(x,
runs0=1:nrow(result(x)), dims0=1:ncol(result(x)), ...
){
args0 <- list(x=x, runs0=runs0, dims0=dims0)
mc <- match.call(call = sys.call(sys.parent(1)))
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
plotInfo <- list(call = mc, dots=dots, args=args0)
ldim0 <- min(getdistrTEstOption("MaxNumberofPlottedEvaluationDims"),
length(dims0))
if(ldim0<length(dims0))
warning(paste("your evaluation is too big; only ", ldim0,
"evaluation dimensions are plotted"))
plotInfo$boxplot <- boxplot(result(x)[runs0,dims0[1:ldim0]],...)
plotInfo$usr <- par("usr")
class(plotInfo) <- c("plotInfo","DiagnInfo")
return(invisible(plotInfo))
}
)
setMethod("plot",signature(x="EvaluationList",y="missing"),
function(x,
runs0=1:nrow(result(Elist(x)[[1]])),
dims0= 1: ifelse(sum(grep("\\.id($|\\.)",
colnames(result(Elist(x)[[1]]))))>0,
### contaminated data or not?
ncol(result(Elist(x)[[1]]))/2,
ncol(result(Elist(x)[[1]]))),
evals0=1:length(Elist(x)), ... )
{ args0 <- list(x=x, runs0=runs0, dims0=dims0, evals0=evals0)
mc <- match.call(call = sys.call(sys.parent(1)))
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
plotInfo <- list(call = mc, dots=dots, args=args0)
dots <- list(...)
ldim0 <- min(getdistrTEstOption("MaxNumberofPlottedEvaluationDims"),
length(dims0))
levals0 <- min(getdistrTEstOption("MaxNumberofPlottedEvaluations"),
length(evals0))
if((ldim0<length(dims0))||(levals0<length(evals0)))
warning(gettextf(
"your evaluation list is too big; only %i x%i evaluations x dimensions are plotted",
levals0, ldim0))
evallist <- Elist(x)
len <- length(evallist)
resdim <- ncol(result(evallist[[1]]))
nl <- nrow(result(evallist[[1]]))
# the names for the different columns[1..resdim] of the different
# Evaluations[1..len]
resnames <- matrix(0,len,resdim)
for(i in 1:len)
resnames[i,] <- colnames(result(evallist[[i]]))
### is the data split into ideal/contaminated data?
id0 <-grep("\\.id($|\\.)",resnames[1,])
evallist0 <- Elist(x)[evals0[1:levals0]]
len0 <- length(evallist0)
if (sum(id0 > 0))
{dims1 <- c(dims0[1:ldim0],dims0[1:ldim0]+resdim/2)
resdim0 <- ncol(result(evallist0[[1]])[runs0,dims1])
nl0 <- nrow(result(evallist0[[1]])[runs0,dims1])
}
else
{dims1 <- dims0[1:ldim0]
resdim0 <- ncol(result(evallist0[[1]])[runs0,dims1])
nl0 <- nrow(result(evallist0[[1]])[runs0,dims1])
}
ma <- data.frame(matrix(0,nl0,len0*resdim0))
## reorganize the frames
### --- grouped by result-dimension (e.g. coordinates of an estimator)
### and within this --- if possible --- grouped by ideal/real Data
if( sum(id0 > 0))
{ for(i in 1:(resdim0/2))
for(j in 1:len0)
{ma[,(i-1)*2*len0+j] <- result(evallist0[[j]])[runs0,dims1[i]]
ma[,(2*i-1)*len0+j] <-
result(evallist0[[j]])[runs0,dims1[i+resdim0/2]]
colnames(ma)[(i-1)*2*len0+j] <-
colnames(result(evallist0[[j]]))[dims1[i]]
colnames(ma)[(2*i-1)*len0+j] <-
colnames(result(evallist0[[j]]))[dims1[i+resdim0/2]]
}
resdim0 <- resdim0/2; len0 <- len0*2
}
else
{ for(i in 1:resdim0)
for(j in 1:len0)
{ma[,(i-1)*len0+j] <- result(evallist0[[j]])[runs0,i]
colnames(ma)[(i-1)*len0+j] <- colnames(result(evallist0[[j]]))[i]
}
}
o.warn <- getOption("warn")
on.exit(options("warn"=o.warn))
main0 <- character(resdim0)
if("main" %in% names(dots))
{ options("warn" = -1)
main0[1:resdim0] <- dots[["main"]]
options("warn" = o.warn) }
else
main0 <- paste(gettextf("%d. coordinate",dims1[1:resdim0]))
ylim0<-matrix(0,2,resdim0)
if("ylim" %in% names(dots))
{ options("warn" = -1)
ylim1 <- as.matrix(dots[["ylim"]])
c1 <- ncol(ylim1); c2 <- resdim0%/%c1; c3 <- resdim0%%c1
if(c2>0)
ylim0[,1:(c2*c1)] <- ylim1
if(c3>0)
ylim0[,c2*c1+(1:c3)] <- ylim1[,1:c3]
options("warn" = o.warn) }
opar <- par(no.readonly = TRUE)
# opar$cin <- opar$cra <- opar$csi <- opar$cxy <- opar$din <- NULL
on.exit(par(opar))
par(mfrow=c(resdim0,1))
plotInfo$boxplot <- plotInfo$usr <- plotInfo$bpdots <-vector("list",resdim0)
for(i in 1:resdim0)
{if("main" %in% names(dots))
dots[["main"]] <- main0[i]
else {
dots[[length(dots)+1]] <- main0[i]
names(dots)[length(dots)] <- "main"
}
if("ylim" %in% names(dots))
dots[["ylim"]] <- ylim0[,i]
dots[["x"]]<- as.data.frame(ma[,(i-1)*len0+(1:len0)])
plotInfo$bpdots[[i]] <- dots
plotInfo$boxplot[[i]] <- do.call("boxplot", args = dots)
plotInfo$usr[[i]] <- par("usr")
}
class(plotInfo) <- c("plotInfo","DiagnInfo")
return(invisible(plotInfo))
})
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.