R/plotting.R

In csoneson/SEE: Interactive SummarizedExperiment Explorer

############################################
# Aesthetics constants -----
############################################

.all_aes_names <- c("x", "y", "color", "shape", "size", "fill", "group")
.all_aes_values <- c("X", "Y", "ColorBy", "ShapeBy", "SizeBy", "FillBy", "GroupBy")
names(.all_aes_values) <- .all_aes_names

############################################
# Title and labels constants -----
############################################

.all_labs_names <- c(.all_aes_names, "title", "subtitle")

############################################
# Lasso constants -----
############################################

# Default behaviour
.lassoStartShape <- 22
.lassoWaypointShape <- 20

# If shape is being used for data aesthetics, fall back on size
.lassoStartSize <- 1.5
.lassoWaypointSize <- 0.25

#' Choose the plot type
#'
#' Define and execute commands to prepare X and/or Y for plotting, depending on whether they are categorical or continuous.
#' This mostly involves coercing categorical variables to factors.
#'
#' @param envir Environment containing a \code{plot.data} data.frame with \code{X} and \code{Y} fields.
#'
#' @return
#' A character vector is returned containing commands to perform calculations for each plot type
#' (or \code{NULL}, if no commands need to be executed).
#' All commands are also evaluated within \code{envir} to modify \code{plot.data}.
#'
#' A \code{plot.type} string is added to \code{envir}, indicating the type of plot that should be created
#' based on whether the x- and/or y-axes are categorical or continuous.
#'
#' @details
#' \code{envir} is effectively passed by reference, as the setup commands are executed in the environment by this function.
#'
#' @author Aaron Lun
#' @rdname INTERNAL_choose_plot_type
#' @seealso
#' \code{\link{.violin_setup}},
#' \code{\link{.square_setup}},
#' \code{\link{.generateDotPlotData}}
.choose_plot_type <- function(envir) {
    group_X <- .is_groupable(envir$plot.data$X)
    group_Y <- .is_groupable(envir$plot.data$Y)
    if (!group_Y && !group_X) {
        mode <- "scatter"
        specific <- NULL
    } else if (!group_Y) {
        mode <- "violin"
        specific <- .violin_setup(envir$plot.data, horizontal=FALSE)
    } else if (!group_X) {
        mode <- "violin_horizontal"
        specific <- .violin_setup(envir$plot.data, horizontal=TRUE)

        if (exists("plot.data.all", envir)) { # flipping plot.data.all as well, otherwise it becomes chaotic in .violin_plot().
            specific <- c(specific,
                "tmp <- plot.data.all$X;
                plot.data.all$X <- plot.data.all$Y;
                plot.data.all$Y <- tmp;")
        }
    } else {
        mode <- "square"
        specific <- .square_setup(envir$plot.data)
    }

    .textEval(specific, envir)
    envir$plot.type <- mode
    return(specific)
}

############################################
# Internal functions: downsampler ----
############################################

#' Downsampling commands
#'
#' Define and execute commands to downsample points for speed.
#'
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param envir Environment containing a \code{plot.data} data.frame with \code{X} and \code{Y} fields.
#' @param priority Logical scalar indicating whether a \code{.priority} variable was generated by \code{\link{.prioritizeDotPlotData}}.
#' @param rescaled Logical scalar indicating whether a \code{.rescaled} variable was generated by \code{\link{.prioritizeDotPlotData}}.
#'
#' @details
#' Density-dependent downsampling for speed is performed in this function, based on \code{\link{subsetPointsByGrid}}.
#' \code{envir} is effectively passed by reference, as the setup commands are executed in the environment by this function.
#' A \code{plot.data.pre} data.frame is also added to \code{envir} to keep the pre-subsetted information, e.g., for use in \code{.violin_plot}.
#'
#' \code{priority} and \code{rescaled} are used to adjust the priority and resolution of downsampling.
#' See \code{?link{.prioritizeDotPlotData}} for details.
#'
#' @return
#' A character vector is returned containing commands to perform downsampling.
#' All commands are evaluated within \code{envir}.
#'
#' @author Aaron Lun
#' @rdname INTERNAL_downsample_points
#' @seealso
#' \code{\link{subsetPointsByGrid}}
.downsample_points <- function(param_choices, envir, priority=FALSE, rescaled=FALSE) {
    if (slot(param_choices, .plotPointDownsample)) {
        xtype <- "X"
        ytype <- "Y"

        plot_type <- envir$plot.type
        if (plot_type == "square") {
            xtype <- "jitteredX"
            ytype <- "jitteredY"
        } else if (plot_type == "violin" || plot_type == "violin_horizontal") {
            xtype <- "jitteredX"
        }

        res <- slot(param_choices, .plotPointSampleRes)
        subset.args <- sprintf("resolution=%i", res)
        if (priority) {
            if (rescaled) {
                subset.args <- paste0(subset.args, "*.rescaled")
            }
            subset.args <- paste0(subset.args, ", grouping=.priority")
        }

        ## If we color by sample name in a column-based plot, or by feature name
        ## in a row-based plot, we make sure to keep the selected column/row in
        ## the downsampling
        color_choice <- slot(param_choices, .colorByField) 
        always_keep <- ""
        if ((color_choice == .colorBySampNameTitle && is(param_choices, "ColumnDotPlot")) ||
                (color_choice == .colorByFeatNameTitle && is(param_choices, "RowDotPlot"))) {
            always_keep <- " | as.logical(plot.data$ColorBy)"
        }

        downsample_cmds <- c(
            "plot.data.pre <- plot.data;",
            sprintf(".subsetted <- subsetPointsByGrid(plot.data$%s, plot.data$%s, %s)", xtype, ytype, subset.args),
            sprintf("plot.data <- plot.data[.subsetted%s,,drop=FALSE];", always_keep),
            ""
        )

        .textEval(downsample_cmds, envir)
        downsample_cmds
    } else {
        NULL
    }
}

############################################
# Internal functions: scatter plotter ----
############################################

#' Produce a scatter plot
#'
#' Generate (but not evaluate) commands to create a scatter plot of numeric X/Y.
#'
#' @param plot_data A data.frame containing all of the plotting information,
#' returned by \code{\link{.generateDotPlotData}} in \code{envir$plot.data}.
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param x_lab A character label for the X axis.
#' Set to \code{NULL} to have no x-axis label.
#' @param y_lab A character label for the Y axis.
#' Set to \code{NULL} to have no y-axis label.
#' @param color_lab A character label for the color scale.
#' Set to \code{NULL} to have no color label.
#' @param shape_lab A character label for the shape scale.
#' Set to \code{NULL} to have no shape label.
#' @param size_lab A character label for the size scale.
#' Set to \code{NULL} to have no size label.
#' @param title A character title for the plot.
#' Set to \code{NULL} to have no title.
#' @param by_row A logical scalar specifying whether the plot deals with row-level metadata.
#' @param is_subsetted A logical scalar specifying whether \code{plot_data} was subsetted during \code{\link{.process_selectby_choice}}.
#' @param is_downsampled A logical scalar specifying whether \code{plot_data} was downsampled.
#'
#' @return A character vector of commands to be parsed and evaluated by \code{\link{.generateDotPlot}} to produce the scatter plot.
#'
#' @details
#' As described in \code{?\link{.generateDotPlot}}, the \code{.scatter_plot} function should only contain commands to generate the final ggplot object.
#'
#' \code{plot.data.all} will be used to define the plot boundaries when selecting points to restrict (see \code{?\link{.process_selectby_choice}}).
#' If there is no restriction and we are downsampling for speed, \code{plot.data.pre} will be used to define the boundaries.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun.
#' @rdname INTERNAL_scatter_plot
#'
#' @seealso
#' \code{\link{.generateDotPlot}}
#'
#' @importFrom ggplot2 ggplot coord_cartesian theme_bw theme element_text geom_density_2d coord_fixed
.scatter_plot <- function(plot_data, param_choices,
    x_lab, y_lab, color_lab, shape_lab, size_lab, title,
    by_row=FALSE, is_subsetted=FALSE, is_downsampled=FALSE)
{
    plot_cmds <- list()
    plot_cmds[["ggplot"]] <- "dot.plot <- ggplot() +"

    # Adding points to the plot.
    color_set <- !is.null(plot_data$ColorBy)
    shape_set <- slot(param_choices, .shapeByField) != .shapeByNothingTitle
    size_set <- slot(param_choices, .sizeByField) != .sizeByNothingTitle

    new_aes <- .buildAes(color=color_set, shape=shape_set, size=size_set,
        alt=c(color=.set_colorby_when_none(param_choices)))

    plot_cmds[["points"]] <- .create_points(param_choices, !is.null(plot_data$SelectBy),
        new_aes, color_set, size_set)

    # Defining the color commands.
    color_scale_cmd <- .colorDotPlot(param_choices, plot_data$ColorBy)
    guides_cmd <- .create_guides_command(param_choices, plot_data$ColorBy)

    # Adding axes labels.
    plot_cmds[["labs"]] <- .buildLabs(x=x_lab, y=y_lab, color=color_lab, shape=shape_lab, size=size_lab, title=title)

    if (slot(param_choices, .fixAspectRatio)) {
        coordfun <- "coord_fixed"
    } else {
        coordfun <- "coord_cartesian"
    }
    
    # Defining boundaries if zoomed.
    bounds <- slot(param_choices, .zoomData)
    if (length(bounds)) {
        plot_cmds[["coord"]] <- sprintf(
            "%s(xlim=c(%s, %s), ylim=c(%s, %s), expand=FALSE) +", # FALSE, to get a literal zoom.
            coordfun,
            deparse(bounds["xmin"]), deparse(bounds["xmax"]),
            deparse(bounds["ymin"]),  deparse(bounds["ymax"])
        )
    } else {
        full_data <- ifelse(is_subsetted, "plot.data.all", ifelse(is_downsampled, "plot.data.pre", "plot.data"))
        plot_cmds[["coord"]] <- sprintf("%s(xlim=range(%s$X, na.rm=TRUE),
    ylim=range(%s$Y, na.rm=TRUE), expand=TRUE) +", coordfun, full_data, full_data)
    }

    if (slot(param_choices, .contourAdd)) {
        plot_cmds[["contours"]] <- sprintf("geom_density_2d(aes(x=X, y=Y), plot.data, colour='%s') +", slot(param_choices, .contourColor))
    }

    # Retain axes when no points are present.
    if (nrow(plot_data) == 0 && is_subsetted) {
        plot_cmds[["select_blank"]] <- "geom_blank(data=plot.data.all, inherit.aes=FALSE, aes(x=X, y=Y)) +"
    }

    # Adding further aesthetic elements.
    plot_cmds[["scale_color"]] <- color_scale_cmd
    plot_cmds[["guides"]] <- guides_cmd
    plot_cmds[["theme_base"]] <- "theme_bw() +"

    font_size <- slot(param_choices, .plotFontSize)
    plot_cmds[["theme_custom"]] <- sprintf(
        "theme(legend.position='%s', legend.box='vertical', legend.text=element_text(size=%s), legend.title=element_text(size=%s),
        axis.text=element_text(size=%s), axis.title=element_text(size=%s), title=element_text(size=%s))",
        tolower(slot(param_choices, .plotLegendPosition)),
        font_size * .plotFontSizeLegendTextDefault,
        font_size * .plotFontSizeLegendTitleDefault,
        font_size * .plotFontSizeAxisTextDefault,
        font_size * .plotFontSizeAxisTitleDefault,
        font_size * .plotFontSizeTitleDefault)

    unlist(plot_cmds)
}

############################################
# Internal functions: violin plotter ----
############################################

#' Produce a violin plot
#'
#' Generate (but not evaluate) the commands required to produce a vertical or
#' horizontal violin plot.
#'
#' @param plot_data A data.frame containing all of the plotting information, returned by \code{\link{.generateDotPlotData}} in \code{envir$plot.data}.
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param x_lab A character label for the X axis.
#' Set to \code{NULL} to have no x-axis label.
#' @param y_lab A character label for the Y axis.
#' Set to \code{NULL} to have no y-axis label.
#' @param color_lab A character label for the color scale.
#' Set to \code{NULL} to have no color label.
#' @param shape_lab A character label for the shape scale.
#' Set to \code{NULL} to have no shape label.
#' @param size_lab A character label for the size scale.
#' Set to \code{NULL} to have no size label.
#' @param title A character title for the plot.
#' Set to \code{NULL} to have no title.
#' @param horizontal A logical value that indicates whether violins should be drawn horizontally
#' (i.e., Y axis categorical and X axis continuous).
#' @param by_row A logical scalar specifying whether the plot deals with row-level metadata.
#' @param is_subsetted A logical scalar specifying whether \code{plot_data} was subsetted during \code{\link{.process_selectby_choice}}.
#' @param is_downsampled A logical scalar specifying whether \code{plot_data} was downsampled.
#'
#' @return
#' For \code{\link{.violin_setup}}, a character vector of commands to be parsed
#' and evaluated by \code{\link{.generateDotPlotData}} to set up the
#' required fields.
#'
#' For \code{.violin_plot}, a character vector of commands to be parsed
#' and evaluated by \code{\link{.generateDotPlot}} to produce the violin plot.
#'
#' @details
#' Any commands to modify \code{plot.data} in preparation for creating a violin plot should be placed in \code{\link{.violin_setup}},
#' to be called by \code{\link{.generateDotPlotData}}.
#' This includes swapping of X and Y variables when \code{horizontal=TRUE}, and adding of horizontal/vertical jitter to points.
#'
#' As described in \code{?\link{.generateDotPlot}}, the \code{.violin_plot} function should only contain commands to generate the final ggplot object.
#'
#' \code{plot.data.all} will be used to define the y-axis boundaries (or x-axis boundaries when \code{horizontal=TRUE}).
#' This ensures consistent plot boundaries when selecting points to restrict (see \code{?\link{.process_selectby_choice}}),
#' or when downsampling for speed (see \code{?\link{.generateDotPlot}}.
#'
#' Similarly, \code{envir$plot.data.pre} will be used to create the violins (see \code{\link{.generateDotPlot}}).
#' This ensures consistent violins when downsampling for speed - otherwise the violins will be computed from the downsampled set of points.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun, Charlotte Soneson.
#' @rdname INTERNAL_violin_plot
#'
#' @seealso
#' \code{\link{.generateDotPlotData}},
#' \code{\link{.generateDotPlot}}
#'
#' @importFrom ggplot2 ggplot geom_violin coord_cartesian theme_bw theme
#' coord_flip scale_x_discrete scale_y_discrete
.violin_plot <- function(plot_data, param_choices,
    x_lab, y_lab, color_lab, shape_lab, size_lab, title,
    by_row=FALSE, is_subsetted=FALSE, is_downsampled=FALSE, horizontal=FALSE)
{
    plot_cmds <- list()
    plot_cmds[["ggplot"]] <- "dot.plot <- ggplot() +" # do NOT put aes here, it does not play nice with shiny brushes.
    if (slot(param_choices, .violinAdd)) {
        plot_cmds[["violin"]] <- sprintf(
            "geom_violin(%s, alpha=0.2, data=%s, scale='width', width=0.8) +",
            .buildAes(color=FALSE, group=TRUE),
            ifelse(is_downsampled, "plot.data.pre", "plot.data")
        )
    }

    # Adding the points to the plot (with/without point selection).
    color_set <- !is.null(plot_data$ColorBy)
    shape_set <- slot(param_choices, .shapeByField) != .shapeByNothingTitle
    size_set <- slot(param_choices, .sizeByField) != .sizeByNothingTitle

    new_aes <- .buildAes(color=color_set, shape=shape_set, size=size_set,
        alt=c(x="jitteredX", color=.set_colorby_when_none(param_choices)))

    plot_cmds[["points"]] <- .create_points(param_choices, !is.null(plot_data$SelectBy),
        new_aes, color_set, size_set)

    # Defining the color commands.
    color_scale_cmd <- .colorDotPlot(param_choices, plot_data$ColorBy, x_aes="jitteredX")
    guides_cmd <- .create_guides_command(param_choices, plot_data$ColorBy)

    # Adding axis labels.
    if (horizontal) {
        tmp <- y_lab
        y_lab <- x_lab
        x_lab <- tmp
    }

    plot_cmds[["labs"]] <- .buildLabs(x=x_lab, y=y_lab, color=color_lab, shape=shape_lab, size=size_lab, title=title)

    # Defining boundaries if zoomed. This requires some finesse to deal with horizontal plots,
    # where the point selection is computed on the flipped coordinates.
    bounds <- slot(param_choices, .zoomData)
    if (horizontal) {
        coord_cmd <- "coord_flip"
        if (length(bounds)) {
            names(bounds) <- c(xmin="ymin", xmax="ymax", ymin="xmin", ymax="xmax")[names(bounds)]
        }
    } else {
        coord_cmd <- "coord_cartesian"
    }

    if (length(bounds)) {
        # Ensure zoom preserves the data points and width ratio of visible groups
        bounds["xmin"] <- ceiling(bounds["xmin"]) - 0.5
        bounds["xmax"] <- floor(bounds["xmax"]) + 0.5

        plot_cmds[["coord"]] <- sprintf(
            "%s(xlim=c(%s, %s), ylim=c(%s, %s), expand=FALSE) +", # FALSE, to get a literal zoom.
            coord_cmd, deparse(bounds["xmin"]), deparse(bounds["xmax"]),
            deparse(bounds["ymin"]), deparse(bounds["ymax"])
        )
    } else {
        plot_cmds[["coord"]] <- sprintf("%s(ylim=range(%s$Y, na.rm=TRUE), expand=TRUE) +",
            coord_cmd, ifelse(is_subsetted, "plot.data.all", ifelse(is_downsampled, "plot.data.pre", "plot.data"))
        )
    }

    plot_cmds[["scale_color"]] <- color_scale_cmd
    plot_cmds[["guides"]] <- guides_cmd

    # Retain axes when no points are generated.
    if (nrow(plot_data) == 0 && is_subsetted) {
        plot_cmds[["select_blank"]] <- "geom_blank(data=plot.data.all, inherit.aes=FALSE, aes(x=X, y=Y)) +"
    }

    # Preserving the x-axis range when no zoom is applied.
    # This applies even for horizontal violin plots, as this command is executed internally before coord_flip().
    scale_x_cmd <- "scale_x_discrete(drop=FALSE%s) +"
    if (!length(bounds)) {
        scale_x_extra <- ""
    } else {
        # Restrict axis ticks to visible levels
        scale_x_extra <- sprintf(
            ", breaks=levels(plot.data$X)[%i:%i]",
            ceiling(bounds["xmin"]), floor(bounds["xmax"]))
    }

    plot_cmds[["scale_x"]] <- sprintf(scale_x_cmd, scale_x_extra)
    plot_cmds[["theme_base"]] <- "theme_bw() +"

    font_size <- slot(param_choices, .plotFontSize)
    plot_cmds[["theme_custom"]] <- sprintf(
        "theme(legend.position='%s', legend.text=element_text(size=%s),
        legend.title=element_text(size=%s), legend.box='vertical',
        axis.text.x=element_text(angle=90, size=%s, hjust=1, vjust=0.5),
        axis.text.y=element_text(size=%s),
        axis.title=element_text(size=%s), title=element_text(size=%s))",
        tolower(slot(param_choices, .plotLegendPosition)),
        font_size * .plotFontSizeLegendTextDefault,
        font_size * .plotFontSizeLegendTitleDefault,
        font_size * .plotFontSizeAxisTextDefault,
        font_size * .plotFontSizeAxisTextDefault,
        font_size * .plotFontSizeAxisTitleDefault,
        font_size * .plotFontSizeTitleDefault)

    unlist(plot_cmds)
}

#' @rdname INTERNAL_violin_plot
.violin_setup <- function(plot_data, horizontal=FALSE) {
    setup_cmds <- list()

    # Switching X and Y axes if we want a horizontal violin plot.
    if (horizontal) {
        setup_cmds[["swap"]] <- c("tmp <- plot.data$X;
plot.data$X <- plot.data$Y;
plot.data$Y <- tmp;")
    }
    setup_cmds[["group"]] <- "plot.data$GroupBy <- plot.data$X;"

    # Handling the specification of the jitter-by-group argument.
    groupvar <- ""
    if (!is.null(plot_data$FacetRow) || !is.null(plot_data$FacetColumn)) {
        groupvar <- character(0)
        if (!is.null(plot_data$FacetRow)) {
            groupvar <- c(groupvar, "FacetRow=plot.data$FacetRow")
        }
        if (!is.null(plot_data$FacetColumn)) {
            groupvar <- c(groupvar, "FacetColumn=plot.data$FacetColumn")
        }
        groupvar <- paste0("\n    list(", paste(groupvar, collapse=", "), "),")
    }

    # Figuring out the jitter. This is done ahead of time to guarantee the
    # same results regardless of the subset used for point selection. Note adjust=1
    # for consistency with geom_violin (differs from geom_quasirandom default).
    setup_cmds[["seed"]] <- "set.seed(100);"
    setup_cmds[["calcX"]] <- sprintf(
"plot.data$jitteredX <- iSEE::jitterViolinPoints(plot.data$X, plot.data$Y, %s
    width=0.4, varwidth=FALSE, adjust=1,
    method='quasirandom', nbins=NULL);", groupvar)

    unlist(setup_cmds)
}

############################################
# Internal functions: rectangle plotter ----
############################################

#' Produce a square plot
#'
#' Generate (but not evaluate) the commands required to produce a square plot.
#'
#' @param plot_data A data.frame containing all of the plotting information,
#' returned by \code{\link{.generateDotPlotData}} in \code{envir$plot.data}.
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param x_lab A character label for the X axis.
#' Set to \code{NULL} to have no x-axis label.
#' @param y_lab A character label for the Y axis.
#' Set to \code{NULL} to have no y-axis label.
#' @param color_lab A character label for the color scale.
#' Set to \code{NULL} to have no color label.
#' @param title A character title for the plot.
#' Set to \code{NULL} to have no title.
#' @param by_row Ignored argument, only provided for consistency with \code{.scatter_plot}.
#' @param is_subsetted A logical scalar specifying whether \code{plot_data} was subsetted during \code{\link{.process_selectby_choice}}.
#' @param is_downsampled Ignored argument, only provided for consistency with \code{.scatter_plot}.
#' @param shape_lab A character label for the shape scale.
#' Set to \code{NULL} to have no shape label.
#' @param size_lab A character label for the size scale.
#' Set to \code{NULL} to have no size label.
#'
#' @return
#' For \code{\link{.square_setup}}, a character vector of commands to be parsed and evaluated by \code{\link{.generateDotPlotData}} to set up the required fields.
#'
#' For \code{.square_plot}, a character vector of commands to be parsed and evaluated by \code{\link{.generateDotPlot}} to produce the square plot.
#'
#' @details
#' Any commands to modify \code{plot.data} in preparation for creating a square plot should be placed in \code{\link{.square_setup}}.
#' This function will subsequently be called by \code{\link{.generateDotPlotData}}.
#'
#' The square plot is set up so that the widths on the x-axis are constant when there is only one y-axis level.
#' This means that the dimensions of the squares on the y-axis are directly comparable, without any need to compare areas.
#' Similarly, the widths on the y-axis default are constant when there is only one x-axis level.
#'
#' As described in \code{?\link{.generateDotPlot}}, the \code{.square_plot} function should only contain commands to generate the final ggplot object.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun, Charlotte Soneson.
#' @rdname INTERNAL_square_plot
#'
#' @seealso
#' \code{\link{.generateDotPlotData}},
#' \code{\link{.generateDotPlot}}
#'
#' @importFrom ggplot2 ggplot geom_tile coord_cartesian theme_bw theme
#' scale_x_discrete scale_y_discrete guides
.square_plot <- function(plot_data, param_choices,
    x_lab, y_lab, color_lab, shape_lab, size_lab, title,
    by_row=FALSE, is_subsetted=FALSE, is_downsampled=FALSE)
{
    plot_cmds <- list()
    plot_cmds[["ggplot"]] <- "dot.plot <- ggplot(plot.data) +"
    plot_cmds[["tile"]] <-
"geom_tile(aes(x=X, y=Y, height=2*YWidth, width=2*XWidth, group=interaction(X, Y)),
    summary.data, color='black', alpha=0, size=0.5) +"

    # Adding the points to the plot (with/without point selection).
    color_set <- !is.null(plot_data$ColorBy)
    shape_set <- slot(param_choices, .shapeByField) != .shapeByNothingTitle
    size_set <- slot(param_choices, .sizeByField) != .sizeByNothingTitle

    new_aes <- .buildAes(color=color_set, shape=shape_set, size=size_set,
        alt=c(x="jitteredX", y="jitteredY", color=.set_colorby_when_none(param_choices)))

    plot_cmds[["points"]] <- .create_points(param_choices, !is.null(plot_data$SelectBy),
        new_aes, color_set, size_set)

    # Defining the color commands.
    color_scale_cmd <- .colorDotPlot(param_choices, plot_data$ColorBy, x_aes="jitteredX", y_aes="jitteredY")
    guides_cmd <- .create_guides_command(param_choices, plot_data$ColorBy)

    # Adding the commands to color the points and the point selection area (NULL if undefined).
    plot_cmds[["scale_color"]] <- color_scale_cmd
    # Adding the commands to color the points and the point selection area (NULL if undefined).
    plot_cmds[["guides"]] <- guides_cmd

    # Creating labels.
    plot_cmds[["labs"]] <- .buildLabs(x=x_lab, y=y_lab, color=color_lab, shape=shape_lab, size=size_lab, title=title)

    # Defining boundaries if zoomed.
    bounds <- slot(param_choices, .zoomData)
    if (length(bounds)) {

        # Ensure zoom preserves the data points and width ratio of visible groups
        bounds["xmin"] <- ceiling(bounds["xmin"]) - 0.5
        bounds["xmax"] <- floor(bounds["xmax"]) + 0.5
        bounds["ymin"] <- ceiling(bounds["ymin"]) - 0.5
        bounds["ymax"] <- floor(bounds["ymax"]) + 0.5

        plot_cmds[["coord"]] <- sprintf(
            "coord_cartesian(xlim=c(%s, %s), ylim=c(%s, %s), expand=FALSE) +",
            deparse(bounds["xmin"]), deparse(bounds["xmax"]),
            deparse(bounds["ymin"]), deparse(bounds["ymax"])
        )
    }

    scale_x_cmd <- "scale_x_discrete(drop=FALSE%s) +"
    scale_y_cmd <- "scale_y_discrete(drop=FALSE%s) +"
    if (!length(bounds)) {
        scale_x_extra <- ""
        scale_y_extra <- ""
    } else {
        # Restrict axis ticks to visible levels
        scale_x_extra <- sprintf(
            ", breaks=levels(plot.data$X)[%i:%i]",
            ceiling(bounds["xmin"]), floor(bounds["xmax"]))
        scale_y_extra <- sprintf(
            ", breaks=levels(plot.data$Y)[%i:%i]",
            ceiling(bounds["ymin"]), floor(bounds["ymax"]))
    }
     plot_cmds[["scale_x"]] <- sprintf(scale_x_cmd, scale_x_extra)
     plot_cmds[["scale_y"]] <- sprintf(scale_y_cmd, scale_y_extra)

    # Retain axes when no points are present.
    if (nrow(plot_data) == 0 && is_subsetted) {
        plot_cmds[["select_blank"]] <- "geom_blank(data=plot.data.all, inherit.aes=FALSE, aes(x=X, y=Y)) +"
    }

    # Do not display the size legend (saves plot space, as well)
    plot_cmds[["theme_base"]] <- "theme_bw() +"

    font_size <- slot(param_choices, .plotFontSize)
    plot_cmds[["theme_custom"]] <- sprintf("theme(legend.position='%s', legend.text=element_text(size=%s),
    legend.title=element_text(size=%s), legend.box='vertical',
    axis.text.x=element_text(angle=90, size=%s, hjust=1, vjust=0.5),
    axis.text.y=element_text(size=%s),
    axis.title=element_text(size=%s), title=element_text(size=%s))",
        tolower(slot(param_choices, .plotLegendPosition)),
        font_size * .plotFontSizeLegendTextDefault,
        font_size * .plotFontSizeLegendTitleDefault,
        font_size * .plotFontSizeAxisTextDefault,
        font_size * .plotFontSizeAxisTextDefault,
        font_size * .plotFontSizeAxisTitleDefault,
        font_size * .plotFontSizeTitleDefault)

    unlist(plot_cmds)
}

#' @rdname INTERNAL_square_plot
#' @importFrom stats runif
.square_setup <- function(plot_data) {
    setup_cmds  <- list()

    # Handling the specification of the jitter-by-group argument.
    groupvar <- ""
    if (!is.null(plot_data$FacetRow) || !is.null(plot_data$FacetColumn)) {
        groupvar <- character(0)
        if (!is.null(plot_data$FacetRow)) {
            groupvar <- c(groupvar, "FacetRow=plot.data$FacetRow")
        }
        if (!is.null(plot_data$FacetColumn)) {
            groupvar <- c(groupvar, "FacetColumn=plot.data$FacetColumn")
        }
        groupvar <- paste0(",\n    list(", paste(groupvar, collapse=", "), ")")
    }

    # Setting the seed to ensure reproducible results.
    setup_cmds[["jitter"]] <- sprintf("set.seed(100);
j.out <- iSEE:::jitterSquarePoints(plot.data$X, plot.data$Y%s);
summary.data <- j.out$summary;
plot.data$jitteredX <- j.out$X;
plot.data$jitteredY <- j.out$Y;", groupvar)

    unlist(setup_cmds)
}

############################################
# Internal functions: coloring ----
############################################

#' Set a default variable to color by
#'
#' Specify a variable in \code{plot.data} to color by when \code{ColorBy="None"}.
#' Typically used for plots that have some sensible default coloring scheme.
#'
#' @param x A \linkS4class{DotPlot} instance.
#'
#' @return A string containing the variable name, if \code{ColorBy="None"}; otherwise \code{NULL}.
#'
#' @details
#' This function is simply a utility to avoid having to write the conditionals in each of the plotting functions above.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_set_colorby_when_none
.set_colorby_when_none <- function(x) {
    if (slot(x, .colorByField)==.colorByNothingTitle) {
        .colorByNoneDotPlotField(x)
    } else {
        NULL
    }
}

#' Choose between discrete and continuous color scales
#'
#' Generates a ggplot \code{color_scale} command depending on the number of
#' levels in the coloring variable.
#'
#' @param command A string containing an ExperimentColorMap accessor.
#' @param choice An argument to pass to the accessor in \code{command} to
#' specify the colormap to use.
#' @param colorby A vector of values to color points by, taken from
#' \code{plot.data$ColorBy} in upstream functions.
#'
#' @return A string containing an appropriate ggplot \code{color_scale}
#' command.
#'
#' @details
#' The appropriate ggplot coloring command will depend on whether
#' \code{colorby} is categorical or not.
#' If it is, \code{\link{scale_color_manual}} is used with the appropriate
#' number of levels.
#' Otherwise, \code{\link{scale_color_gradientn}} is used.
#' The \code{discrete=} argument of the accessor in \code{command} will also
#' be set appropriately.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun, Charlotte Soneson.
#' @rdname INTERNAL_create_color_scale
#' @seealso
#' \code{\link{.colorDotPlot,RowDotPlot-method}},
#' \code{\link{.colorDotPlot,ColumnDotPlot-method}}
#'
#' @importFrom ggplot2 scale_color_manual scale_fill_manual
#' scale_color_gradientn scale_fill_gradientn
.create_color_scale <- function(command, choice, colorby) {
    discrete_color <- is.factor(colorby)
    if (discrete_color) {
        ncolors <- nlevels(colorby)
    } else {
        ncolors <- 21L
    }

    cm_cmd <- sprintf(
        "%s(colormap, %s, discrete=%s)(%i)",
        command, choice, discrete_color, ncolors)

    if (discrete_color){
        return(c(
            sprintf(
                "scale_color_manual(values=%s, na.value='grey50', drop=FALSE) +",
                cm_cmd),
            sprintf(
                "scale_fill_manual(values=%s, na.value='grey50', drop=FALSE) +",
                cm_cmd)))
    } else {
        return(c(
            sprintf(
                "scale_color_gradientn(colors=%s, na.value='grey50', limits=range(plot.data$ColorBy, na.rm=TRUE)) +",
                cm_cmd)#,
            # sprintf(
            #     "scale_fill_gradientn(colors=%s, na.value='grey50') +",
            #     cm_cmd)
        ))
    }
}

#' Override point size in the plot legend
#' 
#' Conditionally generates a ggplot `guides` command if a custom point size is requested for the plot legend,
#' when the coloring covariate is discrete.
#'
#' @param x A [DotPlot-class] instance.
#' @param colorby A vector of values to color points by, taken from
#' \code{plot.data$ColorBy} in upstream functions.
#'
#' @return A string containing an appropriate ggplot \code{color_scale}
#' command, or `NULL`.
#'
#' @details
#' The appropriate ggplot coloring command will depend on whether
#' \code{colorby} is categorical or not.
#' If it is, and the point size for the legend and the plot are different ,
#' the function returns a `ggplot2::guides()` command that overrides the point size of the legend with the requested value.
#' Otherwise, `NULL` is returned.
#'
#' @author Kevin Rue-Albrecht
#' @rdname INTERNAL_create_guides_command
#'
#' @importFrom ggplot2 guides guide_legend
.create_guides_command <- function(x, colorby) {
    discrete_color <- is.factor(colorby)
    legend_size <- slot(x, .legendPointSize)
    point_size <- slot(x, .plotPointSize)
    custom_point_size <- !identical(legend_size, point_size)

    if (custom_point_size && discrete_color) {
        sprintf(
            "guides(colour = guide_legend(override.aes = list(size=%i)), fill = guide_legend(override.aes = list(size=%i))) +",
            legend_size, legend_size
        )
    } else {
        NULL
    }
}

############################################
# Internal functions: Point selection ----
############################################

#' Add points to plot
#'
#' Generate ggplot commands to control the appearance of data points while
#' accounting for a point selection effect, if active.
#'
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param selected A logical scalar indicating whether any points were
#' selected on the transmitting plot, via a Shiny brush or lasso path.
#' @param aes A string containing the ggplot aesthetic instructions.
#' @param color A logical scalar indicating whether coloring information is
#'   already included in the \code{aes}.
#' @param size A logical scaler indicating whether sizing information is already
#'   included in the \code{aes}.
#'
#' @return A character vector containing ggplot commands to add points
#' to the plot.
#'
#' @details
#' Addition of point commands is done via \code{geom_point} on the
#' X/Y coordinates (in the \code{plot.data} of the evaluation environment).
#' This involves some work to highlight selected data points.
#' Any color specifications are passed in via \code{aes}.
#'
#' A separate \code{selected} argument is necessary here, despite the fact
#' that most point selection information can be retrieved from
#' \code{param_choices},
#' This is because \code{param_choices} does not contain any information on
#' whether the transmitter actually contains a selection of points.
#' If no Shiny select or closed lasso path is defined in the transmitter,
#' \code{selected=FALSE} and the default appearance of the points is used.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun.
#' @rdname INTERNAL_create_points
#' @seealso
#' \code{.scatter_plot},
#' \code{.violin_plot},
#' \code{.square_plot}
#'
#' @importFrom ggplot2 geom_point geom_blank
.create_points <- function(param_choices, selected, aes, color, size) {
    plot_cmds <- list()

    # If there is already coloring information available in the aes, don't add an
    # additional color= statement to the geom_point() command, since this will
    # overrule the one given in aes().
    if (color || !is.null(.set_colorby_when_none(param_choices))) {
        default_color <- ""
    } else {
        default_color <- sprintf(", color='%s'", slot(param_choices, .colorByDefaultColor))
    }

    ## If there is already size information available in the aes, don't add an
    ## additional size=statement to the geom_point() command.
    if (size) {
        common_size <- ""
    } else {
        common_size <- sprintf(", size=%s", slot(param_choices, .plotPointSize))
    }

    if (selected && (select_alpha <- slot(param_choices, .selectTransAlpha)) < 1) {
        plot_cmds[["select_other"]] <- sprintf(
            "geom_point(%s, subset(plot.data, !SelectBy), alpha=%.2f%s%s) +",
            aes, select_alpha, default_color, common_size
        )
        plot_cmds[["select_alpha"]] <- sprintf(
            "geom_point(%s, subset(plot.data, SelectBy)%s%s) +",
            aes, default_color, common_size
        )
    } else {
        plot_cmds[["point"]] <- sprintf(
            "geom_point(%s, alpha=%s, plot.data%s%s) +",
            aes, slot(param_choices, .plotPointAlpha), default_color,
            common_size
        )
    }

    unlist(plot_cmds)
}

############################################
# Internal functions: aesthetics ----
############################################

#' Generate ggplot aesthetic instructions
#'
#' @param x A \code{logical} that indicates whether to enable \code{x} in the
#' aesthetic instructions (default: \code{TRUE}).
#' @param y A \code{logical} that indicates whether to enable \code{y} in the
#' aesthetic instructions (default: \code{TRUE}).
#' @param color A \code{logical} that indicates whether to enable
#' \code{color} in the aesthetic instructions (default: \code{FALSE}).
#' @param shape A \code{logical} that indicates whether to enable
#' \code{shape} in the aesthetic instructions (default: \code{FALSE}).
#' @param size A \code{logical} that indicates whether to enable
#' \code{size} in the aesthetic instructions (default: \code{FALSE}).
#' @param fill A \code{logical} that indicates whether to enable
#' \code{fill} in the aesthetic instructions (default: \code{FALSE}).
#' @param group A \code{logical} that indicates whether to enable
#' \code{group} in the aesthetic instructions (default: \code{FALSE}).
#' @param alt Alternative aesthetics, supplied as a named character vector.
#'
#' @return Aesthetic instructions for \code{\link{ggplot}} as a character
#' value.
#'
#' @author Kevin Rue-Albrecht
#' @name aes-utils
#' @export
#'
#' @importFrom ggplot2 aes
#'
#' @examples
#' .buildAes()
.buildAes <- function(
    x=TRUE, y=TRUE, color=FALSE, shape=FALSE, size=FALSE, fill=FALSE,
    group=FALSE, alt=NULL) {
    active_aes <- .all_aes_values[c(x, y, color, shape, size, fill, group)]
    if (!is.null(alt)) {
        active_aes <- c(active_aes, alt)
        active_aes <- active_aes[!duplicated(names(active_aes), fromLast=TRUE)]
    }
    aes_specs <- mapply(
        FUN=.make_single_aes, names(active_aes), active_aes, USE.NAMES=FALSE)
    aes_specs <- paste(aes_specs, collapse=", ")
    return(sprintf("aes(%s)", aes_specs))
}

#' Generate a single aesthetic instruction for ggplot
#'
#' @param name The name of a ggplot aesthetic.
#' @param value The name of a column in the plot data that will be mapped to
#' the aesthetic declared in \code{name}.
#'
#' @return A character value of the form \code{name=value}.
#'
#' @author Kevin Rue-Albrecht
#' @rdname INTERNAL_make_single_aes
#' @seealso
#' \code{\link{.buildAes}}.
.make_single_aes <- function(name, value){
    sprintf("%s=%s", name, value)
}

#' Generate ggplot title and label instructions
#'
#' @param x The character label for the horizontal axis.
#' @param y x The character label for the vertical axis.
#' @param color The character title for the color scale legend.
#' @param shape The character title for the point shape legend.
#' @param size The character title for the point size legend.
#' @param fill The character title for the color fill legend.
#' @param group The character title for the group legend.
#' @param title The character title for the plot title.
#' @param subtitle The character title for the plot subtitle
#'
#' @details
#' If any argument is \code{NULL}, the corresponding label is not set.
#'
#' @return Title and label instructions for \code{\link{ggplot}} as a character value.
#'
#' @author Kevin Rue-Albrecht
#' @rdname labs-utils
#' @export
#'
#' @importFrom ggplot2 labs
#' @examples
#' cat(.buildLabs(y = "Title for Y axis", color = "Color label"))
.buildLabs <- function(x=NULL, y=NULL, color=NULL, shape=NULL, size=NULL, fill=NULL, group=NULL, title=NULL, subtitle=NULL){
    labs_specs <- list(x, y, color, shape, size, fill, group, title, subtitle)
    names(labs_specs) <- .all_labs_names
    labs_specs <- labs_specs[lengths(labs_specs)>0L]
    if (identical(length(labs_specs), 0L)){
        return(NULL)
    }
    labs_specs <- mapply(FUN=.make_single_lab, names(labs_specs), labs_specs, USE.NAMES=FALSE)
    labs_specs <- paste(labs_specs, collapse=", ")
    return(sprintf("labs(%s) +", labs_specs))
}

#' Generate a single title or label instruction for ggplot
#'
#' @param name The name of a ggplot label.
#' @param value A character value for the title or label declared in
#' \code{name}.
#'
#' @return A character value of the form \code{name=value}.
#'
#' @author Kevin Rue-Albrecht
#' @rdname INTERNAL_make_single_lab
#' @seealso
#' \code{\link{.buildLabs}}.
.make_single_lab <- function(name, value){
    sprintf("%s=%s", name, deparse(value))
}

############################################
# Internal functions: grouping ----
############################################

#' Coerce data to a specific type
#'
#' This function ensures that a specific column of the \code{plot.data} data.frame is either a numeric or factor.
#' If that is not the case, it returns a command (as a string) that coerces the column into the desired type.
#'
#' @param values Input vector that must be coerced to \code{numeric}.
#' @param field Column name in the \code{plot.data} data.frame that contains \code{values}.
#' @param max_levels Integer scalar specifying the maximum number unique values for \code{x} to be considered as categorical.
#' @param df String containing the variable name of the data.frame containing the plotting data.
#'
#' @return A command that coerces the plot data.frame column to the specified type, or \code{NULL} if no coercion is required.
#'
#' @author Kevin Rue-Albrecht
#' @rdname INTERNAL_coerce_type
#' @seealso
#' \code{\link{.generateDotPlot}}.
.coerce_type <- function(values, field, max_levels=Inf, df="plot.data") {
    if (!.is_groupable(values, max_levels)) {
        if (!is.numeric(values)) {
            warning("covariate has too many unique values, coercing to numeric")
            col_var <- sprintf("%s$%s", df, field)
            if (!is.factor(values)) {
                col_var <- sprintf("as.factor(%s)", col_var)
            }
            return(sprintf("%s$%s <- as.numeric(%s);", df, field, col_var))
        }
    } else {
        if (!is.factor(values)) {
            return(sprintf('%s[["%s"]] <- factor(%s[["%s"]]);', df, field, df, field))
        }
    }
    return(NULL)
}

############################################
# Internal functions: faceting ----
############################################

#' Process faceting choices
#'
#' Generate ggplot instructions to facet a plot by row and/or column
#'
#' @param x A single-row DataFrame that contains all the
#' input settings for the current panel.
#'
#' @return A string containing a command to define the row and column faceting
#' covariates.
#'
#' @author Kevin Rue-Albrecht.
#' @export
#'
#' @name plot-utils
#' @aliases .addFacets
#' @importFrom ggplot2 facet_grid
#'
#' @examples
#' x <- ReducedDimensionPlot(
#'     FacetRowBy = "Column data", FacetRowByColData="Covariate_1", 
#'     FacetColumnBy = "Column data", FacetColumnByColData="Covariate_2") 
#' .addFacets(x)
.addFacets <- function(x){
    row_facet <- slot(x, .facetRow)!=.facetByNothingTitle
    col_facet <- slot(x, .facetColumn)!=.facetByNothingTitle
    if (!row_facet && !col_facet) {
        return(NULL)
    }

    facet_x <- if (row_facet) "FacetRow" else "."
    facet_y <- if (col_facet) "FacetColumn" else "."
    sprintf("facet_grid(%s ~ %s)", facet_x, facet_y)
}

############################################
# Plot update functions ----
############################################

#' Draw brushes and lassos
#'
#' Generate \link{ggplot} instructions to draw all active and saved multiple selections in a \linkS4class{DotPlot} panel.
#' This utility is intended for use within \code{\link{.generateDotPlot}} methods.
#'
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param flip A \code{logical} value that indicates whether \code{\link{coord_flip}} was applied to the plot.
#'
#' @return A character vector containing \link{ggplot} commands to create rectangles (for Shiny brushes)
#' or polygons (for closed lassos) or paths (for open lassos) in the current plot.
#'
#' @details
#' Evaluation of the output commands require:
#' \itemize{
#' \item a list object called \code{all_active} where each entry is named by the plot name.
#' The entry corresponding to the current plot should contain the contents of \code{.brushData} in \code{param_choices}.
#' \item a list object called \code{all_saved} where each entry is named by the plot name.
#' The entry corresponding to the current plot should contain the contents of \code{.multiSelectHistory} in \code{param_choices}.
#' }
#' Both of these objects should exist in the environment in which the commands are evaluated.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun.
#' @rdname INTERNAL_self_select_boxes
#' @seealso
#' \code{\link{.generateDotPlot}}
#'
#' @importFrom ggplot2 geom_rect geom_text
.self_select_boxes <- function(param_choices, flip=FALSE) {
    active <- slot(param_choices, .brushData)
    saved <- slot(param_choices, .multiSelectHistory)

    has_active <- as.integer(length(active) > 0)
    total <- has_active + length(saved)
    if (total == 0L) {
        return(NULL)
    }

    # Note: Faceting simultaneously on row and column produces a 'flip' effect on the brush data
    if (slot(param_choices, .facetRow)!=.facetByNothingTitle && 
            slot(param_choices, .facetColumn)!=.facetByNothingTitle) {
        facet_row <- 'panelvar2'
        facet_column <- 'panelvar1'
    } else {
        facet_row <- facet_column <- 'panelvar1'
    }

    mode <- .encodedName(param_choices)
    plot_name <- .getEncodedName(param_choices)
    stroke_color <- .getPanelColor(param_choices)
    fill_color <- .lighten_color_for_fill(stroke_color)

    cmds <- character(0)
    for (i in seq_len(total) - has_active) {
        if (i==0L) {
            chosen <- active
        } else {
            chosen <- saved[[i]]
        }

        if (.is_brush(chosen)) {
            draw_cmd <- .draw_brush(plot_name, param_choices, index=i,
                flip=flip, facet_row=facet_row, facet_column=facet_column,
                stroke_color=stroke_color, fill_color=fill_color)
        } else {
            draw_cmd <- .draw_lasso(plot_name, param_choices, index=i,
                facet_row=facet_row, facet_column=facet_column,
                stroke_color=stroke_color, fill_color=fill_color)
        }

        cmds <- c(cmds, draw_cmd)
    }

    cmds
}

.draw_brush <- function(plot_name, param_choices, index, flip,
    facet_row, facet_column, stroke_color, fill_color)
{
    if (index == 0L) {
        brush_src <- sprintf("all_active[['%s']]", plot_name)
    } else {
        brush_src <- sprintf("all_saved[['%s']][[%i]]", plot_name, index)
    }

    # Build up the aes call, to account for flipped behavior.
    if (flip) {
        xmin <- 'ymin'
        xmax <- 'ymax'
        ymin <- 'xmin'
        ymax <- 'xmax'
    } else {
        xmin <- 'xmin'
        xmax <- 'xmax'
        ymin <- 'ymin'
        ymax <- 'ymax'
    }
    aes_call <- sprintf("xmin=%s, xmax=%s, ymin=%s, ymax=%s", xmin, xmax, ymin, ymax)

    # Initialize the minimal brush information
    brush_data <- sprintf("%s[c('xmin', 'xmax', 'ymin', 'ymax')]", brush_src)

    # Collect additional panel information for the brush
    addPanels <- character(0)
    if (slot(param_choices, .facetRow)!=.facetByNothingTitle) {
        addPanels["FacetRow"] <- sprintf("FacetRow=%s[['%s']]", brush_src, facet_row)
    }
    if (slot(param_choices, .facetColumn)!=.facetByNothingTitle) {
        addPanels["FacetColumn"] <- sprintf("FacetColumn=%s[['%s']]", brush_src, facet_column)
    }

    # If any facting (row, column) is active, add the relevant data fields
    if (length(addPanels)) {
        panel_list <- sprintf("list(%s)", paste(addPanels, collapse=", "))
        brush_data <- sprintf("append(%s, %s)", brush_data, panel_list)
    }

    # Build up the command that draws the brush
    brush_draw_cmd <- sprintf(
"geom_rect(aes(%s), color='%s', alpha=%s, fill='%s',
    data=do.call(data.frame, %s),
    inherit.aes=FALSE)",
        aes_call, stroke_color, .brushFillOpacity, fill_color, brush_data)

    # Put a number for saved brushes.
    if (index!=0L) {
        text_data <- c(sprintf("x=mean(unlist(%s[c('%s', '%s')]))", brush_src, xmin, xmax),
            sprintf("y=mean(unlist(%s[c('%s', '%s')]))", brush_src, ymin, ymax),
            addPanels)

        text_cmd <- sprintf(
"geom_text(aes(x=x, y=y), inherit.aes=FALSE,
    data=data.frame(
        %s),
    label=%i, size=%s, colour='%s')",
            paste(text_data, collapse=",\n        "),
            index, 
            slot(param_choices, .plotFontSize) * .plotFontSizeLegendTextDefault, 
            stroke_color)

        brush_draw_cmd <- c(brush_draw_cmd, text_cmd)
    }

    brush_draw_cmd
}

#' Generate ggplot instructions to draw a lasso selection path
#'
#' @param plot_name String containing the name of the current plot panel.
#' @param param_choices An instance of a \linkS4class{DotPlot} class.
#' @param index Integer scalar indicating whether to draw the lasso in the active selection (\code{NA})
#' or one of the saved selections.
#' @param facet_row,facet_column Strings containing the name of the faceting fields in the lasso.
#' Usually one of \code{"panelvar1"} or \code{"panelvar2"}.
#' @param stroke_color String containing the color to use for the lasso stroke.
#' @param fill_color String containing the color to use for the fill of the closed lasso.
#'
#' @return A character vector containing commands to overlay a point, path or polygon, indicating the position of any active or saved lassos.
#'
#' @details
#' This function will generate commands to add a point to the plot, if there is only one lasso waypoint defined;
#' a path, if multiple waypoints are defined but the lasso is not yet closed;
#' or a polygon, if multiple waypoints are defined for a closed lasso.
#'
#' The starting point of open lassos is distinguished from the waypoints using a shape aesthetic;
#' with one exception, if the shape aesthetic is already being mapped to a covariate for data points,
#' then lasso points switch to the size aesthetic.
#'
#' Evaluation of the output commands require:
#' \itemize{
#' \item a list object called \code{all_active} where each entry is named by the plot name.
#' The entry corresponding to the current plot should contain the contents of \code{.lassoData} in \code{param_choices}.
#' \item a list object called \code{all_saved} where each entry is named by the plot name.
#' The entry corresponding to the current plot should contain the contents of \code{.multiSelectHistory} in \code{param_choices}.
#' }
#' Both of these objects should exist in the environment in which the commands are evaluated.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun.
#' @rdname INTERNAL_self_lasso_path
#' @seealso
#' \code{\link{.generateDotPlot}}
#'
#' @importFrom ggplot2 geom_point geom_polygon geom_path scale_shape_manual
#' scale_fill_manual guides
.draw_lasso <- function(plot_name, param_choices, index,
    facet_row, facet_column, stroke_color, fill_color)
{
    if (index == 0L) {
        lasso_src <- sprintf("all_active[['%s']]", plot_name)
        current <- slot(param_choices, .brushData)
    } else {
        lasso_src <- sprintf("all_saved[['%s']][[%i]]", plot_name, index)
        current <- slot(param_choices, .multiSelectHistory)[[index]]
    }

    # Initialize the minimal lasso information
    lasso_data <- sprintf("X=%s$coord[, 1], Y=%s$coord[, 2]", lasso_src, lasso_src)

    # Collect additional panel information for the lasso.
    addPanels <- character(0)
    if (slot(param_choices, .facetRow)!=.facetByNothingTitle) {
        addPanels["FacetRow"] <- sprintf("FacetRow=%s[['%s']]", lasso_src, facet_row)
    }
    if (slot(param_choices, .facetColumn)!=.facetByNothingTitle) {
        addPanels["FacetColumn"] <- sprintf("FacetColumn=%s[['%s']]", lasso_src, facet_column)
    }
    if (length(addPanels)) {
        panel_data <- paste(unlist(addPanels), collapse=", ")
        lasso_data <- paste(lasso_data, panel_data, sep=", ")
    }

    if (identical(nrow(current$coord), 1L)) { # lasso has only a start point
        point_cmd <- sprintf(
"geom_point(aes(x=%s, y=%s),
    data=data.frame(%s),
    inherit.aes=FALSE, alpha=1, stroke=1, color='%s', shape=%s)",
            current$mapping$x, current$mapping$y, lasso_data, stroke_color, .lassoStartShape)
        full_cmd_list <- point_cmd

    } else if (current$closed){ # lasso is closed
        polygon_cmd <- sprintf(
"geom_polygon(aes(x=%s, y=%s), alpha=%s, color='%s',
    data=data.frame(%s),
    inherit.aes=FALSE, fill='%s')",
            current$mapping$x, current$mapping$y,
            .brushFillOpacity, stroke_color,
            lasso_data, fill_color)

        # Put a number for saved lassos.
        if (index!=0L) {
            text_data <- c(sprintf("X=mean(%s$coord[, 1])", lasso_src),
                sprintf("Y=mean(%s$coord[, 2])", lasso_src),
                addPanels)

            text_cmd <- sprintf(
"geom_text(aes(x=%s, y=%s), inherit.aes=FALSE,
    data=data.frame(
        %s),
    label=%i, size=%s, colour='%s')",
                current$mapping$x, current$mapping$y,
                paste(text_data, collapse=",\n        "),
                index, 
                slot(param_choices, .plotFontSize) * .plotFontSizeLegendTextDefault, 
                stroke_color)

            polygon_cmd <- c(polygon_cmd, text_cmd)
        }

        full_cmd_list <- polygon_cmd

    } else { # lasso is still open
        path_cmd <- sprintf(
"geom_path(aes(x=%s, y=%s),
    data=data.frame(%s),
    inherit.aes=FALSE, alpha=1, color='%s', linetype='longdash')",
            current$mapping$x, current$mapping$y, lasso_data, stroke_color)

        # Do not control the shape of waypoints if shape is already being mapped to a covariate
        if (slot(param_choices, .shapeByField) == .shapeByNothingTitle) {
            point_cmd <- sprintf(
"geom_point(aes(x=%s, y=%s, shape=First),
    data=data.frame(%s,
        First=seq_len(nrow(%s$coord)) == 1L),
    inherit.aes=FALSE, alpha=1, stroke=1, color='%s')",
                current$mapping$x, current$mapping$y,
                lasso_data, lasso_src, stroke_color)

            scale_shape_cmd <- sprintf(
                "scale_shape_manual(values=c('TRUE'=%s, 'FALSE'=%s))",
                .lassoStartShape, .lassoWaypointShape
            )

            guides_cmd <- "guides(shape='none')"
        } else {
            point_cmd <- sprintf(
"geom_point(aes(x=%s, y=%s, size=First),
    data=data.frame(%s,
        First=seq_len(nrow(%s$coord)) == 1L),
    inherit.aes=FALSE, alpha=1, stroke=1, shape=%s, color='%s')",
                current$mapping$x, current$mapping$y,
                lasso_data, lasso_src, .lassoStartShape, stroke_color)

            scale_shape_cmd <- sprintf(
                "scale_size_manual(values=c('TRUE'=%s, 'FALSE'=%s))",
                .lassoStartSize, .lassoWaypointSize
            )

            guides_cmd <- "guides(size='none')"
        }

        full_cmd_list <- c(path_cmd, point_cmd, scale_shape_cmd, guides_cmd)
    }

    full_cmd_list
}

#' Add multiple selection plotting commands
#'
#' Add \link{ggplot} instructions to create brushes and lassos for both saved and active multiple selections in a \linkS4class{DotPlot} panel.
#'
#' @param x An instance of a \linkS4class{DotPlot} class.
#' @param envir The environment in which the \link{ggplot} commands are to be evaluated.
#' @param flip A logical scalar indicating whether the x- and y-axes are flipped,
#' only relevant to horizontal violin plots.
#' @param commands A character vector representing the sequence of commands to create the \link{ggplot} object.
#'
#' @return A character vector containing \code{commands} plus any additional commands required to draw the self selections.
#'
#' @details
#' This is a utility function that is intended for use in \code{\link{.generateDotPlot}}.
#' It will modify \code{envir} by adding \code{all_active} and \code{all_saved} variables,
#' so developers should not use these names for their own variables in \code{envir}.
#'
#' If no self-selection structures exist in \code{x}, \code{commands} is returned directly without modification.
#'
#' @author Aaron Lun
#' @export
#' @rdname addMultiSelectionCommands
.addMultiSelectionPlotCommands <- function(x, envir, commands, flip=FALSE) {
    self_select_cmds <- .self_select_boxes(x, flip=flip)

    if (length(self_select_cmds)) {
        N <- length(commands)
        commands[N] <- paste(commands[N], "+")

        intermediate <- seq_len(length(self_select_cmds)-1L)
        self_select_cmds[intermediate] <- paste(self_select_cmds[intermediate], "+")
        commands <- c(commands, self_select_cmds)

        .populate_selection_environment(x, envir)
        envir$all_active[[1]] <- slot(x, .brushData) # as open lassos are skipped by multiSelectionActive.
    }

    commands
}

#' Add centered label plotting commands
#'
#' Add \link{ggplot} instructions to label the center of each group on a scatter plot.
#' This is a utility function that is intended for use in \code{\link{.generateDotPlot}}.
#'
#' @param x An instance of a \linkS4class{DotPlot} class.
#' @param commands A character vector representing the sequence of commands to create the \link{ggplot} object.
#' 
#' @return A character vector containing \code{commands} plus any additional commands required to generate the labels.
#'
#' @author Aaron Lun
#' @export
#' @rdname addLabelCentersCommands
.addLabelCentersCommands <- function(x, commands) {
    if (slot(x, .plotLabelCenters)) {
        aggregants <- c("LabelCenters=.label_values")

        # Some intelligence involved in accounting for the faceting;
        # in this case, a label is shown on each facet if possible.
        # Note that the same label may differ in locations across facets.
        if (slot(x, .facetRow)!=.facetByNothingTitle) {
            aggregants <- c(aggregants, "FacetRow=plot.data$FacetRow")
        }
        if (slot(x, .facetColumn)!=.facetByNothingTitle) {
            aggregants <- c(aggregants, "FacetColumn=plot.data$FacetColumn")
        }

        cmds <- sprintf("local({
    .label_values <- %s(se)[[%s]][match(rownames(plot.data), %s(se))]
    .aggregated <- aggregate(plot.data[,c('X', 'Y')], FUN=median, na.rm=TRUE,
        by=list(%s))
    ggplot2::geom_text(aes(x=X, y=Y, label=LabelCenters), .aggregated, color=%s, size=%s)
})", .getDotPlotMetadataCommand(x), deparse(slot(x, .plotLabelCentersBy)), .getDotPlotNamesCommand(x),
            paste(aggregants, collapse=", "), deparse(slot(x, .plotLabelCentersColor)), 
            deparse(slot(x, .plotFontSize) * 4))

        N <- length(commands)
        commands[[N]] <- paste(commands[[N]], "+")
        commands <- c(commands, cmds)
    }

    commands
}

#' Add custom label plotting commands
#'
#' Add \link{ggplot} instructions to add custom labels to specified points in a \linkS4class{DotPlot}.
#' This is a utility function that is intended for use in \code{\link{.generateDotPlot}}.
#'
#' @param x An instance of a \linkS4class{DotPlot} class.
#' @param commands A character vector representing the sequence of commands to create the \link{ggplot} object.
#' @param plot_type String specifying the type of plot, e.g., \code{"scatter"}, \code{"square"}, \code{"violin"}.
#'
#' @return A character vector containing \code{commands} plus any additional commands required to generate the labels.
#'
#' @author Kevin Rue-Albrecht, Aaron Lun
#'
#' @export
#' @importFrom ggrepel geom_text_repel
#' @importFrom grid unit
#' @rdname addCustomLabelsCommands
.addCustomLabelsCommands <- function(x, commands, plot_type) {
    if (slot(x, .plotCustomLabels)) {
        N <- length(commands)
        commands[[N]] <- paste(commands[[N]], "+")

        dn <- .convert_text_to_names(slot(x, .plotCustomLabelsText))

        axes <- switch(plot_type,
            scatter=c("X", "Y"),
            square=c("jitteredX", "jitteredY"),
            c("jitteredX", "Y")
        )

        label_cmd <- sprintf('local({
    .sub.data <- plot.data
    .sub.data$LabelBy <- rownames(.sub.data)
    .sub.data <- subset(.sub.data, LabelBy %%in%% %s)
    ggrepel::geom_text_repel(aes(x=%s, y=%s, label=LabelBy), .sub.data, min.segment.length = grid::unit(0, "mm"))
})', .deparse_for_viewing(dn), axes[1], axes[2])
        commands <- c(commands, label_cmd)
    }
    
    commands
}