R/tab_vs_rnaseq_plots.R

In systemPipeR/systemPipeShiny: systemPipeShiny: An Interactive Framework for Workflow Management and Visualization

# plot tab template
# tagList(
#     renderDesc(ns("desc"), desc),
#     fluidRow(
#         column(
#             3,
#             div(
#                 class = "panel panel-info",
#                 id = ns("panel_left"),
#                 style = "min-height: 500px;",
#                 div(
#                     id = "",
#                     class = "panel-heading",
#                     h4(class = "panel-title", "Plot control")
#                 ),
#                 div(
#                     class = "panel-body",
#                     style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
#                     fluidRow(
#                         style = 'margin-top: 25px;',
#                         class = "text-center",
#                         canvasBtn(ns('plot_main'))
#                     ),
#                     spsHr(),
#                     fluidRow(
#                         class = "center-child",
#                         p("")
#                     ) %>%
#                         bsHoverPopover(
#                             "tip title",
#                             "tip text",
#                             placement = "bottom"
#                         )
#                 )
#             )
#         ),
#         column(
#             9,
#             div(
#                 class = "panel panel-info",
#                 id = ns("panel_right"),
#                 style = "min-height: 500px;",
#                 div(
#                     id = "",
#                     class = "panel-heading",
#                     h4(class = "panel-title", "XX plot")
#                 ),
#                 div(
#                     class = "panel-body",
#                     style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
#                     shinyjqui::jqui_resizable(plotly::plotlyOutput(ns('plot_main')))
#                 )
#             )
#         ),
#         heightMatcher(ns("panel_left"), ns("panel_right"))
#     )
# )

############ vs_rnaseq_glm sub tab ####################
vs_rnaseq_glmUI <- function(id){
    ns <- NS(id)
    desc <-
        '
    ## GLM-PCA
    generalized principal component analysis (GLM-PCA) for dimension
    reduction of non-normally distributed data can be plotted with the
    `GLMplot` function. This option does not offer
    transformation or normalization of raw data.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                ## glmpca is performed on raw counts
                                # count_mat is the raw count table
                                # that you can download from "Normalize Data" sub-tab.
                                # Use functions like `read.csv` to read it.
                                # factors is the unique sample name, or experiment groups
                                nozero <- count_mat[which(rowSums(count_mat) > 0), ]
                                gpca <- glmpca::glmpca(nozero, L=2)
                                gpca.dat <- gpca$factors
                                gpca.dat$condition <- factors
                                Sample <- factors
                                p1 <- ggplot2::ggplot(gpca.dat, ggplot2::aes(dim1, dim2)) +
                                    ggplot2::geom_point(size = 2, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                                    ggplot2::ggtitle("GLM-PCA") +
                                    ggplot2::xlab("PC1") +
                                    ggplot2::ylab("PC1") +
                                    ggplot2::theme_minimal() +
                                    ggplot2::theme(
                                        axis.line.x = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        axis.line.y = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        plot.title = ggplot2::element_text(size = 14, hjust = 0.5),
                                        axis.title.x = ggplot2::element_text(size = 12),
                                        axis.title.y = ggplot2::element_text(size = 12)
                                    )
                                plotly::ggplotly(p1)
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("point_size"),
                                label = "Point Size",
                                min = 1,
                                max = 10,
                                step = 1,
                                value = 2,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover(
                                "Point Size",
                                "How large should the points be? 1-10",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("plot_title"),
                                label = "Plot title",
                                value = "Generalized PCA (GLM-PCA)"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Plot title",
                                "Type your plot title",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("title_size"),
                                label = "Plot title Size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 20,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Plot title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("xlab"),
                                label = "X axis label",
                                value = "Dim 1"
                            )
                        ) %>%
                            bsHoverPopover(
                                "X axis label",
                                "Type your X axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("xlab_size"),
                                label = "X axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("X axis  title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("ylab"),
                                label = "Y axis label",
                                value = "Dim 2"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Y axis label",
                                "Type your Y axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("ylab_size"),
                                label = "Y axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Y axis  title size", "", placement = "top")
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "GLM-PCA Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotly::plotlyOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}

#' @importFrom ggplot2 ggplot aes aes_string geom_point coord_fixed ggtitle ggsave
#' @importFrom plotly ggplotly
vs_rnaseq_glmServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "glm"

        output$plot_main <- renderPlotly({
            shiny::validate(
                need(shared$rnaseq$trans_method == "raw", message = "Need to use raw transformation"),
                need(not_empty(shared$rnaseq$trans_table), message = "Count table not transformed")
            )
            shinyCatch(blocking_level = "error", {
                count_mat <- shared$rnaseq$trans_table
                factors <-  shared$rnaseq$condition
                ## glmpca is performed on raw counts
                nozero <- count_mat[which(rowSums(count_mat) > 0), ]
                gpca <- glmpca::glmpca(nozero, L=2)
                gpca.dat <- gpca$factors
                gpca.dat$condition <- factors
                Sample <- factors
                p1 <- ggplot2::ggplot(gpca.dat, ggplot2::aes(dim1, dim2)) +
                    ggplot2::geom_point(size = input$point_size, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                    ggplot2::ggtitle(input$plot_title) +
                    ggplot2::xlab(input$xlab) +
                    ggplot2::ylab(input$ylab) +
                    ggplot2::theme_minimal() +
                    ggplot2::theme(
                        axis.line.x = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        axis.line.y = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        plot.title = ggplot2::element_text(size = input$title_size, hjust = 0.5),
                        axis.title.x = ggplot2::element_text(size = input$xlab_size),
                        axis.title.y = ggplot2::element_text(size = input$ylab_size)
                    )
                plotly::ggplotly(p1)
            })
        })
    }
    moduleServer(id, module)
}

############ vs_rnaseq_pca sub tab ####################
vs_rnaseq_pcaUI <- function(id){
    ns <- NS(id)
    desc <-
        '
    ## PCA
    A Principal Component Analysis (PCA) plot can be created using the `PCAplot`
    function which uses the `DESeq2` package. The input data frame can be
    transformed with the `rlog` or Variance-stabilizing Transformation (`vst`)
    methods from the `DESeq2` package, or can be done without transformation.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                ## pca is performed on DESeq2 rlog or vst transformed counts
                                # spsRNA_trans is the DESeq2 rlog or vst transformed count object
                                # that is exported to your global environment if you stop SPS app locally or
                                # can be download from "Normalize Data" sub-tab as an RDS file.
                                # Sample is the unique sample name, or experiment groups (Sample column in your targets file)
                                pcaData <- DESeq2::plotPCA(spsRNA_trans, intgroup = "condition", returnData = TRUE)
                                percentVar <- round(100 * attr(pcaData, "percentVar"))

                                p1 <- ggplot2::ggplot(pcaData, ggplot2::aes(PC1, PC2)) +
                                    ggplot2::geom_point(size = 2, ggplot2::aes(color=Sample)) +
                                    ggplot2::coord_fixed() +
                                    ggplot2::ggtitle("PCA") +
                                    ggplot2::xlab(paste0("PC1 ", percentVar[1],"% variance")) +
                                    ggplot2::ylab(paste0("PC2 ", percentVar[2],"% variance")) +
                                    ggplot2::theme_minimal() +
                                    ggplot2::theme(
                                        axis.line.x = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        axis.line.y = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        plot.title = ggplot2::element_text(size = 14, hjust = 0.5),
                                        axis.title.x = ggplot2::element_text(size = 12),
                                        axis.title.y = ggplot2::element_text(size = 12)
                                    )
                                plotly::ggplotly(p1)
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("point_size"),
                                label = "Point Size",
                                min = 1,
                                max = 10,
                                step = 1,
                                value = 2,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover(
                                "Point Size",
                                "How large should the points be? 1-10",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("plot_title"),
                                label = "Plot title",
                                value = "Principal Component Analysis (PCA)"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Plot title",
                                "Type your plot title",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("title_size"),
                                label = "Plot title Size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 20,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Plot title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("xlab"),
                                label = "X axis label",
                                value = "PC1"
                            )
                        ) %>%
                            bsHoverPopover(
                                "X axis label",
                                "Type your X axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("xlab_size"),
                                label = "X axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("X axis  title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("ylab"),
                                label = "Y axis label",
                                value = "PC2"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Y axis label",
                                "Type your Y axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("ylab_size"),
                                label = "Y axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Y axis  title size", "", placement = "top")
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "PCA Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotly::plotlyOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}


vs_rnaseq_pcaServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "pca"
        output$plot_main <- renderPlotly({
            shiny::validate(
                need(shared$rnaseq$trans_method %in% c("rlog", "vst"), message = "Need to use rlog or vst transformation"),
                need(not_empty(spsRNA_trans), message = "Count table not transformed")
            )
            shinyCatch(blocking_level = "error", {
                pcaData <- DESeq2::plotPCA(spsRNA_trans, intgroup = "condition", returnData = TRUE)
                percentVar <- round(100 * attr(pcaData, "percentVar"))
                Sample <- shared$rnaseq$condition

                p1 <- ggplot2::ggplot(pcaData, ggplot2::aes(PC1, PC2)) +
                    ggplot2::geom_point(size = input$point_size, ggplot2::aes(color=Sample)) +
                    ggplot2::coord_fixed() +
                    ggplot2::ggtitle(input$plot_title) +
                    ggplot2::xlab(paste0(input$xlab, " ", percentVar[1],"% variance")) +
                    ggplot2::ylab(paste0(input$ylab, " ", percentVar[2],"% variance")) +
                    ggplot2::theme_minimal() +
                    ggplot2::theme(
                        axis.line.x = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        axis.line.y = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        plot.title = ggplot2::element_text(size = input$title_size, hjust = 0.5),
                        axis.title.x = ggplot2::element_text(size = input$xlab_size),
                        axis.title.y = ggplot2::element_text(size = input$ylab_size)
                    )
                plotly::ggplotly(p1)
            })
        })
    }
    moduleServer(id, module)
}
############ vs_rnaseq_mds sub tab ####################
vs_rnaseq_mdsUI <- function(id){
    ns <- NS(id)
    desc <-
        '
    ## MDS
    A Multidimensional Scaling (MDS) plot can be created using the `MDSplot`
    function. The input data frame can be transformed with either the `rlog` or
    Variance-stabilizing Transformation (`vst`) methods from the `DESeq2`
    package. From the input data, it computes a spearman correlation-based
    distance matrix and performs MDS analysis on it.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                # spsRNA_trans is the DESeq2 rlog or vst transformed count object
                                # that is exported to your global environment if you stop SPS app locally or
                                # can be download from "Normalize Data" sub-tab as an RDS file.
                                # You can also use the csv format file from download but you
                                # need to use `read.csv` instead of `SummarizedExperiment::assay` method below.
                                # Sample is the unique sample name, or experiment groups (Sample column in your targets file)
                                d <- stats::cor(SummarizedExperiment::assay(RNA_trans))
                                distmat <- stats::dist(1 - d)
                                ## perform MDS
                                mdsData <- data.frame(stats::cmdscale(distmat))
                                mds <- cbind(mdsData, as.data.frame(Sample))

                                p1 <- ggplot2::ggplot(mdsData, ggplot2::aes(X1, X2)) +
                                    ggplot2::geom_point(size = 2, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                                    ggplot2::ggtitle("Multidimensional Scaling (MDS) plot") +
                                    ggplot2::xlab("X1") +
                                    ggplot2::ylab("X2") +
                                    ggplot2::theme_minimal() +
                                    ggplot2::theme(
                                        axis.line.x = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        axis.line.y = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        plot.title = ggplot2::element_text(size = 14, hjust = 0.5),
                                        axis.title.x = ggplot2::element_text(size = 12),
                                        axis.title.y = ggplot2::element_text(size = 12)
                                    )
                                plotly::ggplotly(p1)
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            selectizeInput(
                                inputId = ns("cor_method"),
                                label = "Correlation Method",
                                choices = c("pearson", "kendall", "spearman"),
                                width = "100%"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Correlation Method",
                                'one of \"pearson\" (default), \"kendall\", or \"spearman\"',
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("point_size"),
                                label = "Point Size",
                                min = 1,
                                max = 10,
                                step = 1,
                                value = 2,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover(
                                "Point Size",
                                "How large should the points be? 1-10",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("plot_title"),
                                label = "Plot title",
                                value = "Multidimensional Scaling (MDS)"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Plot title",
                                "Type your plot title",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("title_size"),
                                label = "Plot title Size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 20,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Plot title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("xlab"),
                                label = "X axis label",
                                value = "X1"
                            )
                        ) %>%
                            bsHoverPopover(
                                "X axis label",
                                "Type your X axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("xlab_size"),
                                label = "X axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("X axis  title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("ylab"),
                                label = "Y axis label",
                                value = "X2"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Y axis label",
                                "Type your Y axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("ylab_size"),
                                label = "Y axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Y axis  title size", "", placement = "top")
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "MDS Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotly::plotlyOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}

vs_rnaseq_mdsServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "mds"
        output$plot_main <- renderPlotly({
            shiny::validate(
                need(shared$rnaseq$trans_method %in% c("rlog", "vst"), message = "Need to use rlog or vst transformation"),
                need(not_empty(spsRNA_trans), message = "Count table not transformed")
            )
            shinyCatch(blocking_level = "error", {

                d <- stats::cor(SummarizedExperiment::assay(spsRNA_trans), method = input$cor_method)
                distmat <- stats::dist(1 - d)
                ## perform MDS
                mdsData <- data.frame(stats::cmdscale(distmat))
                mds <- cbind(mdsData, as.data.frame(SummarizedExperiment::colData(spsRNA_trans)))
                Sample <- shared$rnaseq$condition

                p1 <- ggplot2::ggplot(mdsData, ggplot2::aes(X1, X2)) +
                    ggplot2::geom_point(size = input$point_size, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                    ggplot2::ggtitle(input$plot_title) +
                    ggplot2::xlab(input$xlab) +
                    ggplot2::ylab(input$ylab) +
                    ggplot2::theme_minimal() +
                    ggplot2::theme(
                        axis.line.x = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        axis.line.y = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        plot.title = ggplot2::element_text(size = input$title_size, hjust = 0.5),
                        axis.title.x = ggplot2::element_text(size = input$xlab_size),
                        axis.title.y = ggplot2::element_text(size = input$ylab_size)
                    )
                plotly::ggplotly(p1)
            })
        })
    }
    moduleServer(id, module)
}

############ vs_rnaseq_heatmapsub tab ####################
vs_rnaseq_heatmapUI <- function(id){
    ns <- NS(id)
    desc <-
        '
    ## Heatmap
    A heatmap of the results of hierarchical clustering performed with the
    `hclust` function can be created with the `heatMaplot` function. The
    sample-wise Spearman correlation coefficients are computed before
    hierarchical clustering. The count data frame can be transformed with the
    `rlog` or Variance-stabilizing Transformation (`vst`) methods from the
    `DESeq2` package.

    Heatmap by using a list of genes is provided in the `DEG report` subtab. Please
    use `Normalize Data` subtab to create calculate some DEGs and then go to
    `DEG report` to make a heatmap over there.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                # spsRNA_trans is the DESeq2 rlog or vst transformed count object
                                # that is exported to your global environment if you stop SPS app locally or
                                # can be download from "Normalize Data" sub-tab as an RDS file.
                                # You can also use the csv format file from download but you
                                # need to use `read.csv` instead of `SummarizedExperiment::assay` method below.
                                # Sample is the unique sample name, or experiment groups (Sample column in your targets file)
                                anno <- as.data.frame(Sample); colnames(anno) <- "Condition"
                                sampleDists <- stats::dist(t(SummarizedExperiment::assay(spsRNA_trans)))
                                sampleDistMatrix <- as.matrix(sampleDists)
                                rownames(anno) <- colnames(sampleDistMatrix)

                                pheatmap::pheatmap(
                                    mat = sampleDistMatrix,
                                    clustering_distance_rows = sampleDists,
                                    clustering_distance_cols = sampleDists,
                                    annotation_col = anno
                                )
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            numericInput(
                                inputId = ns("tree_rows"),
                                label = "Cut tree by rows",
                                min = 1,
                                max = 1000,
                                step = 1,
                                value = 1,
                                width = "100%"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Cut tree by rows",
                                "How many branches should it cut the tree by rows",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            numericInput(
                                inputId = ns("tree_cols"),
                                label = "Cut tree by columns",
                                min = 1,
                                max = 1000,
                                step = 1,
                                value = 1,
                                width = "100%"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Cut tree by columns",
                                "How many branches should it cut the tree by columns",
                                placement = "top"
                            )
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Heatmap Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}


vs_rnaseq_heatmapServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "heatmap"
        output$plot_main <- renderImage({
            shiny::validate(
                need(shared$rnaseq$trans_method %in% c("rlog", "vst"), message = "Need to use rlog or vst transformation"),
                need(not_empty(shared$rnaseq$trans_table), message = "Count table not transformed")
            )
            outfile <- tempfile(fileext='.png')
            p1 <- shinyCatch(blocking_level = "error", {
                count_mat <- shared$rnaseq$trans_table
                anno <- as.data.frame(shared$rnaseq$condition); colnames(anno) <- "Condition"
                sampleDists <- stats::dist(t(shared$rnaseq$trans_table))
                sampleDistMatrix <- as.matrix(sampleDists)
                rownames(anno) <- colnames(sampleDistMatrix)

                pheatmap::pheatmap(
                    mat = sampleDistMatrix,
                    clustering_distance_rows = sampleDists,
                    clustering_distance_cols = sampleDists,
                    annotation_col = anno,
                    cutree_rows = input$tree_rows,
                    cutree_cols = input$tree_cols,
                    silent = TRUE
                )
            })
            png(outfile,
                width=session$clientData[[paste0('output_', ns(""), "plot_main_width")]],
                height=session$clientData[[paste0('output_', ns(""), "plot_main_height")]])
            grid::grid.draw(p1)
            dev.off()
            list(src = outfile,
                 alt = "Plot not displayed, plotting device problem")
        }, deleteFile = TRUE)
    }
    moduleServer(id, module)
}

############ vs_rnaseq_dendro sub tab ####################
vs_rnaseq_dendroUI <- function(id){
    ns <- NS(id)
    desc <-
        '
    ## Dendrogram
    A dendrogram of the results of hierarchical clustering performed with
    the `hclust` function can be created with the `hclustplot` function.
    The sample-wise Spearman correlation coefficients are computed, and then
    the results are transformed to a distance matrix before the hierarchical
    clustering is performed. The count dataframe can be transformed with the
    `rlog` or Variance-stabilizing Transformation (`vst`) methods from the
    `DESeq2` package.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                # spsRNA_trans is the DESeq2 rlog or vst transformed count object
                                # that is exported to your global environment if you stop SPS app locally or
                                # can be download from "Normalize Data" sub-tab as an RDS file.
                                # You can also use the csv format file from download but you
                                # need to use `read.csv` instead of `SummarizedExperiment::assay` method below.
                                d <- stats::cor(SummarizedExperiment::assay(spsRNA_trans))
                                ## Hierarchical cluster analysis
                                hc <- stats::hclust(stats::dist(1 - d))
                                tree <- ape::as.phylo(hc)
                                # Cut the tree to groups
                                cls <- cutree(hc, 2) # change the number
                                p_colors <- hcl.colors(2, palette = "Set 2")[cls]
                                # one of "phylogram", "fan", "radial", "unrooted", "cladogram"
                                plot(
                                    tree, type = "phylogram", no.margin = TRUE, cex = 1,
                                    edge.color = "steelblue", tip.color = p_colors
                                )
                                title("Dendrogram", line = -1)
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            selectizeInput(
                                inputId = ns("cor_method"),
                                label = "Correlation Method",
                                choices = c("pearson", "kendall", "spearman"),
                                width = "100%"
                            )
                        ),
                        fluidRow(
                            class = "center-child",
                            selectizeInput(
                                inputId = ns("layout"),
                                label = "Tree layout",
                                choices = c("phylogram", "fan", "radial", "unrooted", "cladogram"),
                                width = "100%"
                            )
                        ),
                        fluidRow(
                            class = "center-child",
                            numericInput(
                                inputId = ns("tree_cut"),
                                label = "Cut the tree",
                                value = 1,
                                min = 1
                            )
                        ) %>%
                            bsHoverPopover(
                                "Cut the tree to groups",
                                "How many groups do you want to cut the tree to?",
                                placement = "top"
                            ),

                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("plot_title"),
                                label = "Plot title",
                                value = "Dendrogram of count table"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Plot title",
                                "Type your plot title",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            numericInput(
                                inputId = ns("cex"),
                                label = "Label size",
                                value = 1,
                                min = 0.1,
                                step = 0.1
                            )
                        ) %>%
                            bsHoverPopover(
                                "Label size",
                                "How large should the labels be",
                                placement = "top"
                            )
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Dendro/tree Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}

vs_rnaseq_dendroServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "dendro"
        output$plot_main <- renderPlot({
            shiny::validate(
                need(shared$rnaseq$trans_method %in% c("rlog", "vst"), message = "Need to use rlog or vst transformation"),
                need(not_empty(shared$rnaseq$trans_table), message = "Count table not transformed")
            )
            ## cor() computes the correlation coefficient
            d <- stats::cor(shared$rnaseq$trans_table, method = input$cor_method)
            ## Hierarchical cluster analysis
            hc <- stats::hclust(stats::dist(1 - d))
            tree <- ape::as.phylo(hc)
            cls <- cutree(hc, as.numeric(input$tree_cut))
            p_colors <- hcl.colors(as.numeric(input$tree_cut), palette = "Set 2")[cls]

            plot(
                tree, type = input$layout,no.margin = TRUE, cex = input$cex,
                edge.color = "steelblue", tip.color = p_colors
            )
            title(input$plot_title, line = -1)
        })
    }
    moduleServer(id, module)
}

############ vs_rnaseq_tsne sub tab ####################
vs_rnaseq_tsneUI <- function(id){
    ns <- NS(id)
    desc <- '
    ## t-SNE plot
    A Barnes-Hut t-Distributed Stochastic Neighbor Embedding (t-SNE) plot can be created
    using the `tSNEplot` function, which uses the `Rtsne` package to
    compute t-SNE values. The function removes duplicates in the input data frame,
    performs an initial PCA step. The function also
    allows for a user-set perplexity value for the computation.

    Generally, t-SNE will be good for a large N (number of samples) and cluster
    sub types within these samples. A good application for t-SNE is single cell
    RNAseq where you usually obtain hundreds to thousands of samples.
    If the sample N is small, there are a few
    duplicates for some different treatments, and there are a lot of genes (dimensions),
    PCA can be a better option.
    '
    tagList(
        renderDesc(ns("desc"), desc),
        fluidRow(
            column(
                3,
                div(
                    class = "panel panel-info",
                    id = ns("panel_left"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "Plot control")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        fluidRow(
                            style = 'margin-top: 25px;',
                            class = "text-center",
                            canvasBtn(ns('plot_main')), br(),
                            spsCodeBtn(
                                ns("plot_code"), color = "white", label = "Plot code",
                                '
                                # spsRNA_trans is the DESeq2 rlog or vst transformed count object
                                # that is exported to your global environment if you stop SPS app locally or
                                # can be download from "Normalize Data" sub-tab as an RDS file.
                                # You can also use the csv format file from download but you
                                # need to use `read.csv` instead of `SummarizedExperiment::assay` method below.
                                countDF_uni <- t(unique(SummarizedExperiment::assay(spsRNA_trans))) # removes duplicates and transpose matrix, samples perspective
                                tsne_out <- Rtsne::Rtsne(countDF_uni, dims = 2, theta = 0.0, perplexity = 3)
                                plotdata <- data.frame(dim1 = tsne_out$Y[,1], dim2 = tsne_out$Y[,2])

                                p1 <- ggplot2::ggplot(plotdata, ggplot2::aes(dim1, dim2)) +
                                    ggplot2::geom_point(size = 2, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                                    ggplot2::ggtitle("t-SNE") +
                                    ggplot2::xlab("Dim 1") +
                                    ggplot2::ylab("Dim 2") +
                                    ggplot2::theme_minimal() +
                                    ggplot2::theme(
                                        axis.line.x = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        axis.line.y = ggplot2::element_line(colour = \'black\', size=0.5, linetype=\'solid\'),
                                        plot.title = ggplot2::element_text(size = 14, hjust = 0.5),
                                        axis.title.x = ggplot2::element_text(size = 12),
                                        axis.title.y = ggplot2::element_text(size = 12)
                                    )
                                plotly::ggplotly(p1)
                                '
                            )
                        ),
                        spsHr(),
                        fluidRow(
                            class = "center-child",
                            numericInput(
                                inputId = ns("perplexity"),
                                label = "Number of perplexity",
                                min = 1,
                                max = 1000,
                                step = 1,
                                value = 3,
                                width = "100%"
                            )
                        ) %>%
                            bsHoverPopover(
                                "perplexity",
                                "perplexity should < (N samples - 1)/3",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("point_size"),
                                label = "Point Size",
                                min = 1,
                                max = 10,
                                step = 1,
                                value = 2,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover(
                                "Point Size",
                                "How large should the points be? 1-10",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("plot_title"),
                                label = "Plot title",
                                value = "t-SNE"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Plot title",
                                "Type your plot title",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("title_size"),
                                label = "Plot title Size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 20,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Plot title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("xlab"),
                                label = "X axis label",
                                value = "Dim 1"
                            )
                        ) %>%
                            bsHoverPopover(
                                "X axis label",
                                "Type your X axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("xlab_size"),
                                label = "X axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("X axis  title size", "", placement = "top"),
                        fluidRow(
                            class = "center-child",
                            clearableTextInput(
                                inputId = ns("ylab"),
                                label = "Y axis label",
                                value = "Dim 2"
                            )
                        ) %>%
                            bsHoverPopover(
                                "Y axis label",
                                "Type your Y axis label",
                                placement = "top"
                            ),
                        fluidRow(
                            class = "center-child",
                            sliderInput(
                                inputId = ns("ylab_size"),
                                label = "Y axis  title size",
                                min = 1,
                                max = 100,
                                step = 1,
                                value = 16,
                                width = "100%",
                                ticks = TRUE
                            )
                        ) %>%
                            bsHoverPopover("Y axis  title size", "", placement = "top")
                    )
                )
            ),
            column(
                9,
                div(
                    class = "panel panel-info",
                    id = ns("panel_right"),
                    style = "min-height: 500px;",
                    div(
                        id = "",
                        class = "panel-heading",
                        h4(class = "panel-title", "t-SNE Plot")
                    ),
                    div(
                        class = "panel-body",
                        style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
                        shinyjqui::jqui_resizable(plotly::plotlyOutput(ns('plot_main')))
                    )
                )
            ),
            heightMatcher(ns("panel_left"), ns("panel_right"))
        )
    )
}


vs_rnaseq_tsneServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "tsne"
        output$plot_main <- renderPlotly({
            shiny::validate(
                need(shared$rnaseq$trans_method %in% c("rlog", "vst"), message = "Need to use rlog or vst transformation"),
                need(not_empty(shared$rnaseq$trans_table), message = "Count table not transformed")
            )
            shinyCatch(blocking_level = "error", {
                countDF_uni <- t(unique( shared$rnaseq$trans_table)) # removes duplicates and transpose matrix, samples perspective
                tsne_out <- Rtsne::Rtsne(countDF_uni, dims = 2, theta = 0.0, perplexity = input$perplexity)
                Sample <- shared$rnaseq$condition
                plotdata <- data.frame(dim1 = tsne_out$Y[,1], dim2 = tsne_out$Y[,2])

                p1 <- ggplot2::ggplot(plotdata, ggplot2::aes(dim1, dim2)) +
                    ggplot2::geom_point(size = input$point_size, ggplot2::aes(color=Sample)) + ggplot2::coord_fixed() +
                    ggplot2::ggtitle(input$plot_title) +
                    ggplot2::xlab(input$xlab) +
                    ggplot2::ylab(input$ylab) +
                    ggplot2::theme_minimal() +
                    ggplot2::theme(
                        axis.line.x = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        axis.line.y = ggplot2::element_line(colour = 'black', size=0.5, linetype='solid'),
                        plot.title = ggplot2::element_text(size = input$title_size, hjust = 0.5),
                        axis.title.x = ggplot2::element_text(size = input$xlab_size),
                        axis.title.y = ggplot2::element_text(size = input$ylab_size)
                    )
                plotly::ggplotly(p1)
            })
        })
    }
    moduleServer(id, module)
}