Nothing
#### Image plotting for ResultSet ####
setMethod("image",
signature = c(x = "ResultSet"),
function(x, formula,
model = pData(modelData(x)),
feature,
feature.groups,
superpose = TRUE,
strip = TRUE,
key = superpose,
...,
column,
col = if (superpose) rainbow(nlevels(feature.groups)) else "black",
lattice = FALSE)
{
.Deprecated_Cardinal1()
if ( is.list(model) || any(names(model) %in% varLabels(modelData(x))) ) {
model <- model
} else {
model <- pData(modelData(x))[model,,drop=FALSE]
}
# parse formula and result data to be plotted
fm <- .parseFormula(formula)
formula <- paste("~", paste(names(fm$right), collapse="*"))
formula <- as.formula(paste(c(formula, "model"), collapse="|"))
data <- lapply(resultData(x), function(ob) ob[[names(fm$left)]])
# set up model data.frame
if ( is.factor(data[[1]]) ) {
data <- lapply(data, function(class) {
sapply(levels(class),
function(Ck) as.integer(class == Ck))
})
}
if ( is.matrix(data[[1]]) ) {
ntimes <- mapply(rep,
seq_len(nrow(modelData(x))),
sapply(data, ncol))
} else {
ntimes <- seq_len(nrow(modelData(x)))
}
ntimes <- as.vector(unlist(ntimes))
df <- pData(modelData(x))[ntimes,,drop=FALSE]
df <- as.data.frame(lapply(df, as.factor))
if ( !is.null(dim(data[[1]])) ) {
if ( is.null(colnames(data[[1]])) ) {
df$column <- as.vector(unlist(sapply(sapply(data, ncol),
function(times) seq_len(times))))
} else {
df$column <- as.vector(unlist(sapply(data, colnames)))
}
df$column <- factor(df$column, levels=unique(df$column))
} else {
df$column <- factor(rep(TRUE, nrow(df)), labels=names(fm$left))
}
data <- SImageSet(data=matrix(as.vector(unlist(data)),
ncol=ncol(x), byrow=TRUE), coord=coord(x))
fData(data) <- df
fData(data)$model <- factor(names(resultData(x))[ntimes],
levels=names(resultData(x)),
labels=names(resultData(x)))
# get which models should be plotted
if ( is.data.frame(model) ) {
which <- unlist(apply(model, 1, function(par) {
do.call("features", c(list(data), par))
}))
} else {
which <- do.call("features", c(list(data), model))
}
if ( !setequal(which, features(data)) )
data <- data[which,]
if ( missing(column) ) {
column <- list(column=unique(df$column))
} else if ( is.numeric(column) ) {
column <- list(column=levels(df$column)[column])
} else {
column <- list(column=as.factor(column))
}
if ( missing(feature) )
feature <- do.call("features", c(list(data), column))
if ( missing(feature.groups) )
feature.groups <- factor(fData(data)$column[feature], levels=levels(df$column))
image(data, formula=formula, feature=feature, feature.groups=feature.groups,
superpose=superpose, key=key, strip=strip, col=col,
lattice=lattice, ...)
})
#### Image plotting for CrossValidated ####
setMethod("image",
signature = c(x = "CrossValidated"),
function(x, fold = 1:length(x), layout, ...)
{
if ( !missing(layout) ) .setup.layout(rev(layout))
for ( i in fold ) image(resultData(x)[[i]], ...)
})
setMethod("image3D",
signature = c(x = "CrossValidated"),
function(x, fold = 1:length(x), layout, ...)
{
if ( !missing(layout) ) .setup.layout(rev(layout))
for ( i in fold ) image3D(resultData(x)[[i]], ...)
})
#### Image plotting for PCA ####
setMethod("image",
signature = c(x = "PCA"),
function(x, formula = substitute(mode ~ x * y),
mode = "scores",
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "PCA"),
function(x, formula = substitute(mode ~ x * y * z),
mode = "scores",
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
#### Image plotting for PLS ####
setMethod("image",
signature = c(x = "PLS"),
function(x, formula = substitute(mode ~ x * y),
mode = c("fitted", "scores", "y"),
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "PLS"),
function(x, formula = substitute(mode ~ x * y * z),
mode = c("fitted", "scores", "y"),
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
#### Image plotting for OPLS ####
setMethod("image",
signature = c(x = "OPLS"),
function(x, formula = substitute(mode ~ x * y),
mode = c("fitted", "scores", "Oscores", "y"),
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "OPLS"),
function(x, formula = substitute(mode ~ x * y * z),
mode = c("fitted", "scores", "Oscores", "y"),
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
#### Image plotting for SpatialFastmap ####
setMethod("image",
signature = c(x = "SpatialFastmap"),
function(x, formula = substitute(mode ~ x * y),
mode = "scores",
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "SpatialFastmap"),
function(x, formula = substitute(mode ~ x * y * z),
mode = "scores",
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
#### Image plotting for SpatialShrunkenCentroids ####
setMethod("image",
signature = c(x = "SpatialShrunkenCentroids"),
function(x, formula = substitute(mode ~ x * y),
mode = c("probabilities", "classes", "scores"),
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "SpatialShrunkenCentroids"),
function(x, formula = substitute(mode ~ x * y * z),
mode = c("probabilities", "classes", "scores"),
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
#### Image plotting for SpatialKMeans ####
setMethod("image",
signature = c(x = "SpatialKMeans"),
function(x, formula = substitute(mode ~ x * y),
mode = "cluster",
...)
{
mode <- match.arg(mode)
callNextMethod(x, formula=formula, ...)
})
setMethod("image3D",
signature = c(x = "SpatialKMeans"),
function(x, formula = substitute(mode ~ x * y * z),
mode = "cluster",
...)
{
mode <- match.arg(mode)
image(x, formula=formula, ...)
})
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.