R/clustering.R

In maxsonBraunLab/CITE-Viz: "CITEViz: Classifying Cell Clusters in CITE-Seq Data using the Flow Cytometry Gating Workflow"

#' Clustering: 2D Dimension Reduction Plot
#'
#' Visualize a dimension reduction in 2 dimensions.
#' @param input Shiny internal parameter object containing UI user input values
#' @param input_data_type An integer value indicating if the user-uploaded input files are RDS files holding Seurat objects or SingleCellExperiment objects (1 = Seurat object, 2 = SingleCellExperiment object, etc.)
#' @param rds_object An RDS object containing metadata, assays, and reductions for a CITE-seq experiment. Can be NULL if the user uploaded an alternate supported file instead of an RDS file.
#' @param input_file_df A dataframe generated by retrieving file input data from a fileInput element in the UI (i.e., by running input$file_input in the app server). This dataframe contains information about each file uploaded by the user, such as the name of each file as it appears on the user's local filesystem (input_file_df$name) and the temporary datapath with which data from the file can be read in (input_file_df$datapath).
#' @importFrom shiny req
#' @importFrom stats quantile
#' @importFrom ggplot2 ggplot aes labs theme ggtitle xlab ylab geom_vline scale_color_manual scale_fill_manual scale_x_log10 geom_bar geom_density
#' @importFrom plotly plot_ly config layout plotly_empty event_register
#' @param x integer vector
#' @noRd
#'
#' @return numeric vector for color values used in coexpression plot
reduction_2d <- function(input, input_data_type, rds_object, input_file_df) {

    req(
        input$file_input,
        input$reduction,
        input$color1
    )

    # create string for reduction to plot
    reduc <- input$reduction

    # selected metadata to color clusters by
    color <- input$color1

    metadata_df <- get_data(
        category = "metadata",
        input_data_type = input_data_type,
        rds_object = rds_object,
        input_file_df = input_file_df,
        assay_name = NULL,
        reduction_name = NULL
    )

    # interpolate the base color palette so that exact number of colors in custom palette is same as number of unique values for selected metadata category
    custom_palette <- get_palette(length(unique(metadata_df[[color]])))

    # create dataframe from reduction selected
    cell_data <- get_data(
        category = "reductions",
        input_data_type = input_data_type,
        rds_object = rds_object,
        input_file_df = input_file_df,
        assay_name = NULL,
        reduction_name = reduc
    )

    if (ncol(cell_data) < 2) {
        return( plotly_empty() )
    }

    # create list containing all column names of cell_data
    cell_col <- colnames(cell_data)

    # show plot
    p <- plot_ly(cell_data,
        x = ~ cell_data[, 1],
        y = ~ cell_data[, 2],
        customdata = rownames(cell_data),
        color = stats::as.formula(paste0("~metadata_df$", color)),
        colors = custom_palette,
        type = "scatter",
        mode = "markers",
        marker = list(size = 3, width = 2),
        source = "A",
        width = "400px"
    ) %>%
    config(
        toImageButtonOptions = list(
            format = "png",
            scale = 10)
    ) %>%
    layout(
        title = toupper(reduc),
        xaxis = list(title = cell_col[1]),
        yaxis = list(title = cell_col[2]),
        dragmode = "select",
        legend = list(itemsizing = "constant")
    ) %>%
        event_register("plotly_selected")

    return(p)

}

#' Clustering: 3D Dimension Reduction Plot
#'
#' Visualize a dimension reduction in 3 dimensions.
#' @param input Shiny internal parameter object containing UI user input values
#' @param input_data_type An integer value indicating if the user-uploaded input files are RDS files holding Seurat objects or SingleCellExperiment objects (1 = Seurat object, 2 = SingleCellExperiment object, etc.)
#' @param rds_object An RDS object containing metadata, assays, and reductions for a CITE-seq experiment. Can be NULL if the user uploaded an alternate supported file instead of an RDS file.
#' @param input_file_df A dataframe generated by retrieving file input data from a fileInput element in the UI (i.e., by running input$file_input in the app server). This dataframe contains information about each file uploaded by the user, such as the name of each file as it appears on the user's local filesystem (input_file_df$name) and the temporary datapath with which data from the file can be read in (input_file_df$datapath).
#' 
#' @importFrom shiny req
#' @importFrom stats quantile
#' @importFrom ggplot2 ggplot aes labs theme ggtitle xlab ylab geom_vline scale_color_manual scale_fill_manual scale_x_log10 geom_bar geom_density
#' @importFrom plotly plot_ly config layout plotly_empty event_register
#' @param x integer vector
#' @noRd
#'
#' @return numeric vector for color values used in coexpression plot
reduction_3d <- function(input, input_data_type, rds_object, input_file_df) {

    req(
        input$file_input,
        input$reduction,
        input$color1
    )

    # create string for reduction to plot
    reduc <- input$reduction

    # selected metadata to color clusters by
    color <- input$color1

    metadata_df <- get_data(
        category = "metadata",
        input_data_type = input_data_type,
        rds_object = rds_object,
        input_file_df = input_file_df,
        assay_name = NULL,
        reduction_name = NULL
    )

    # interpolate the base color palette so that exact number of colors in custom palette is same as number of unique values for selected metadata category
    custom_palette <- get_palette(length(unique(metadata_df[[color]])))

    # create dataframe from reduction selected
    cell_data <- get_data(
        category = "reductions",
        input_data_type = input_data_type,
        rds_object = rds_object,
        input_file_df = input_file_df,
        assay_name = NULL,
        reduction_name = reduc
    )

    # create list containing all column names of cell_data
    cell_col <- colnames(cell_data)

    # plot 3D reductions plot if given the right data
    if (ncol(cell_data) >= 3) {
        p <- plot_ly(
            cell_data,
            x = ~ cell_data[, 1],
            y = ~ cell_data[, 2],
            z = ~ cell_data[, 3],
            customdata = rownames(cell_data),
            color = stats::as.formula(paste0("~metadata_df$", color)),
            colors = custom_palette,
            type = "scatter3d",
            mode = "markers",
            marker = list(size = 2, width = 1),
            width = "400px"
        ) %>%
        config(
            toImageButtonOptions = list(
                format = "png",
                scale = 10)
        ) %>%
        layout(
            title = toupper(paste(reduc, "(3D)")),
            legend = list(itemsizing = "constant"),
            scene = list(
                xaxis = list(title = cell_col[1]),
                yaxis = list(title = cell_col[2]),
                zaxis = list(title = cell_col[3]),
                dragmode = "orbit"
            )
        )
    } else {
        # or else raise an error message with a plotly object
        error_msg <- paste0("Third dimension missing\nfrom reduction: ", reduc)

        ax <- list(
            title = "",
            zeroline = FALSE,
            showline = FALSE,
            showticklabels = FALSE,
            showgrid = FALSE
        )

        p <- plot_ly(width = "400px") %>%
            layout(
                xaxis = ax,
                yaxis = ax,
                annotations = list(
                    text = error_msg,
                    font = list(size = 16),
                    showarrow = FALSE
                )
            )
    }

    return(p)

}