Feature Request: Please update VlnPlot for better raster points

[david-priest]

Motivation

Currently, VlnPlot raster function does not produce ideal output. If you have the time please update it with geom_jitter_rast() as shown for example in the function below.

Feature Description

SingleExIPlot2 <- function (data, idents, split = NULL, type = "violin", sort = FALSE, 
    y.max = NULL, adjust = 1, pt.size = 0, alpha = 1, cols = NULL, 
    seed.use = 42, log = FALSE, add.noise = TRUE, raster = NULL) 
{
    if (!is.null(x = raster) && isTRUE(x = raster)) {
        if (!PackageCheck("ggrastr", error = FALSE)) {
            stop("Please install ggrastr from CRAN to enable rasterization.")
        }
    }
    if (PackageCheck("ggrastr", error = FALSE)) {
        if ((nrow(x = data) > 1e+05) & is.null(x = raster)) {
            message("Rasterizing points since number of points exceeds 100,000.", 
                "\nTo disable this behavior set `raster=FALSE`")
            raster <- TRUE
        }
    }
    if (!is.null(x = seed.use)) {
        set.seed(seed = seed.use)
    }
    if (!is.data.frame(x = data) || ncol(x = data) != 1) {
        stop("'SingleExIPlot requires a data frame with 1 column")
    }
    feature <- colnames(x = data)
    data$ident <- idents
    if ((is.character(x = sort) && nchar(x = sort) > 0) || sort) {
        data$ident <- factor(x = data$ident, levels = names(x = rev(x = sort(x = tapply(X = data[, 
            feature], INDEX = data$ident, FUN = mean), decreasing = grepl(pattern = paste0("^", 
            tolower(x = sort)), x = "decreasing")))))
    }
    if (log) {
        noise <- rnorm(n = length(x = data[, feature]))/200
        data[, feature] <- data[, feature] + 1
    }
    else {
        noise <- rnorm(n = length(x = data[, feature]))/1e+05
    }
    if (!add.noise) {
        noise <- noise * 0
    }
    if (all(data[, feature] == data[, feature][1])) {
        warning(paste0("All cells have the same value of ", feature, 
            "."))
    }
    else {
        data[, feature] <- data[, feature] + noise
    }
    axis.label <- "Expression Level"
    y.max <- y.max %||% max(data[, feature][is.finite(x = data[, 
        feature])])
    if (type == "violin" && !is.null(x = split)) {
        data$split <- split
        vln.geom <- geom_violin
        fill <- "split"
    }
    else if (type == "splitViolin" && !is.null(x = split)) {
        data$split <- split
        vln.geom <- geom_split_violin
        fill <- "split"
        type <- "violin"
    }
    else {
        vln.geom <- geom_violin
        fill <- "ident"
    }
    switch(EXPR = type, violin = {
        x <- "ident"
        y <- paste0("`", feature, "`")
        xlab <- "Identity"
        ylab <- axis.label
        geom <- list(vln.geom(scale = "width", adjust = adjust, 
            trim = TRUE), theme(axis.text.x = element_text(angle = 45, 
            hjust = 1)))
        if (is.null(x = split)) {
            jitter <- if (isTRUE(x = raster)) {
                ggrastr::geom_jitter_rast(height = 0, size = pt.size,shape = 16, alpha = alpha, show.legend = FALSE, raster.dpi = 600)
            } else {
                geom_jitter(height = 0, size = pt.size, alpha = alpha, show.legend = FALSE)
            }
        } else {
            jitter <- if (isTRUE(x = raster)) {
                ggrastr::geom_jitter_rast(position = position_jitterdodge(jitter.width = 0.4, dodge.width = 0.9), shape = 16, raster.dpi = 600 ,size = pt.size, alpha = alpha, show.legend = FALSE)
            } else {
                geom_jitter(position = position_jitterdodge(jitter.width = 0.4, 
                  dodge.width = 0.9), size = pt.size, alpha = alpha, show.legend = FALSE)
            }
        }
        log.scale <- scale_y_log10()
        axis.scale <- ylim
    }, ridge = {
        x <- paste0("`", feature, "`")
        y <- "ident"
        xlab <- axis.label
        ylab <- "Identity"
        geom <- list(geom_density_ridges(scale = 4), theme_ridges(), 
            scale_y_discrete(expand = c(0.01, 0)), scale_x_continuous(expand = c(0, 
                0)))
        jitter <- geom_jitter(width = 0, size = pt.size, alpha = alpha, 
            show.legend = FALSE)
        log.scale <- scale_x_log10()
        axis.scale <- function(...) {
            invisible(x = NULL)
        }
    }, stop("Unknown plot type: ", type))
    plot <- ggplot(data = data, mapping = aes_string(x = x, y = y, 
        fill = fill)[c(2, 3, 1)]) + labs(x = xlab, y = ylab, 
        title = feature, fill = NULL) + theme_cowplot() + theme(plot.title = element_text(hjust = 0.5))
    plot <- do.call(what = "+", args = list(plot, geom))
    plot <- plot + if (log) {
        log.scale
    }
    else {
        axis.scale(min(data[, feature]), y.max)
    }
    if (pt.size > 0) {
        plot <- plot + jitter
    }
    if (!is.null(x = cols)) {
        if (!is.null(x = split)) {
            idents <- unique(x = as.vector(x = data$ident))
            splits <- unique(x = as.vector(x = data$split))
            labels <- if (length(x = splits) == 2) {
                splits
            }
            else {
                unlist(x = lapply(X = idents, FUN = function(pattern, 
                  x) {
                  x.mod <- gsub(pattern = paste0(pattern, "."), 
                    replacement = paste0(pattern, ": "), x = x, 
                    fixed = TRUE)
                  x.keep <- grep(pattern = ": ", x = x.mod, fixed = TRUE)
                  x.return <- x.mod[x.keep]
                  names(x = x.return) <- x[x.keep]
                  return(x.return)
                }, x = unique(x = as.vector(x = data$split))))
            }
            if (is.null(x = names(x = labels))) {
                names(x = labels) <- labels
            }
        }
        else {
            labels <- levels(x = droplevels(data$ident))
        }
        plot <- plot + scale_fill_manual(values = cols, labels = labels)
    }
    return(plot)
}

environment(SingleExIPlot2) <- asNamespace('Seurat')

Alternatives

No response

[samuel-marsh]

Hi @david-priest,

Not member of dev team but hopefully can be helpful. Can you describe what you mean when you say it doesn't produce ideal output? There is currently PR pending (#9665) that will add the raster.dpi parameter which should greatly improving quality of saved plots when larger images are desired.

Best,
Sam

[david-priest]

Hi Sam,

Thanks for that. Yes the resolution is insufficient. And as you know, the smallest point size appears to be too big. I played around with scattermore a bit, but I found that the output from geom_jitter_rast() was better for my needs (see attachment). Shape = 16 is probably better overall too.

Best,
David