Nothing
setMethod("plot", signature(x = "IC", y = "missing"),
function(x, ...,withSweave = getdistrOption("withSweave"),
main = FALSE, inner = TRUE, sub = FALSE,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
with.automatic.grid = TRUE,
with.legend = FALSE, legend = NULL, legend.bg = "white",
legend.location = "bottomright", legend.cex = 0.8,
withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"),
lty.MBR = "dashed", lwd.MBR = 0.8, n.MBR = 10000,
x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv,
scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
scaleN = 9, x.ticks = NULL, y.ticks = NULL,
mfColRow = TRUE, to.draw.arg = NULL, withSubst = TRUE){
args0 <- list(x = x, withSweave = withSweave,
main = main, inner = inner, sub = sub,
col.inner = col.inner, cex.inner = cex.inner,
bmar = bmar, tmar = tmar, with.automatic.grid = with.automatic.grid,
with.legend = with.legend, legend = legend, legend.bg = legend.bg,
legend.location = legend.location, legend.cex = legend.cex,
withMBR = withMBR, MBRB = MBRB, MBR.fac = MBR.fac, col.MBR = col.MBR,
lty.MBR = lty.MBR, lwd.MBR = lwd.MBR, n.MBR = n.MBR,
x.vec = x.vec, scaleX = scaleX,
scaleX.fct = if(!missing(scaleX.fct)) scaleX.fct else NULL,
scaleX.inv = if(!missing(scaleX.inv)) scaleX.inv else NULL,
scaleY = scaleY,
scaleY.fct = scaleY.fct,
scaleY.inv = scaleY.inv, scaleN = scaleN, x.ticks = x.ticks,
y.ticks = y.ticks, mfColRow = mfColRow, to.draw.arg = to.draw.arg,
withSubst = withSubst)
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)
mcl <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)
L2Fam <- eval(x@CallL2Fam); trafO <- trafo(L2Fam@param)
dims <- nrow(trafO); to.draw <- 1:dims
dimnms <- c(rownames(trafO))
if(is.null(dimnms))
dimnms <- paste("dim",1:dims,sep="")
if(! is.null(to.draw.arg)){
if(is.character(to.draw.arg))
to.draw <- pmatch(to.draw.arg, dimnms)
else if(is.numeric(to.draw.arg))
to.draw <- to.draw.arg
}
dims0 <- length(to.draw)
MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T)
if(withMBR && all(is.na(MBRB))){
robModel <- InfRobModel(center = L2Fam, neighbor =
ContNeighborhood(radius = 0.5))
ICmbr <- try(optIC(model = robModel, risk = asBias()), silent=TRUE)
if(!is(ICmbr,"try-error"))
MBRB <- .getExtremeCoordIC(ICmbr, distribution(L2Fam), to.draw,
n = n.MBR)
else withMBR <- FALSE
}
mcl$MBRB <- MBRB
mcl$withMBR <- withMBR
plm <- getMethod("plot", signature(x = "IC", y = "missing"),
where="RobAStBase")
ret <- do.call(plm, as.list(mcl[-1]), envir=parent.frame(2))
ret$dots <- ret$args <- ret$call <- NULL
plotInfo <- c(plotInfo, ret)
class(plotInfo) <- c("plotInfo","DiagnInfo")
return(invisible(plotInfo))
})
.getExtremeCoordIC <- function(IC, D, indi, n = 10000){
x <- q.l(D)(seq(1/2/n,1-1/2/n, length=n))
y <- (matrix(evalIC(IC,matrix(x,ncol=1)),ncol=n))[indi,,drop=FALSE]
return(cbind(min=apply(y,1,min),max=apply(y,1,max)))
}
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.