inst/app/R/tab_vs_plot_hclust.R

In systemPipeR/spsBio: spsBio: A systemPipeShiny plugin for biological data visualization

## UI

#' @importFrom plotly plotlyOutput
#' @importFrom shinyjqui jqui_resizable
#' @importFrom shinyWidgets pickerInput
plot_hclustUI <- function(id){
    ns <- NS(id)
    desc <- "
    #### Generalized linear models (GLMs) 
    Generalized linear models (GLMs) is a non-linear model and operates on raw 
    counts reads, performing dimensional reduction on the data.
    "
    tagList(
        # in case you need more than one data input, uncomment lines below
        pgPaneUI(ns("pg"),
                 titles = c("Package Requirements",
                            # "Input Metadata" = "meta",
                            "Input Dataframe",
                            # "Validate Meta",
                            "Validate Dataframe"),
                 pg_ids = c(ns("pkg"),
                            # ns("meta"),
                            ns("data"),
                            # ns("vd_meta"),
                            ns("vd_data"))
        ),
        tabTitle("MA Plot"),
        spsHr(), renderDesc(id = ns("desc"), desc),
        spsHr(), h3("Data preparation"),
        fluidRow(
            column(6,
                   genHrefTab(
                       c("data_targets"),
                       title = "You need to meta data from these tabs:")),
            column(6,
                   genHrefTab(
                       c("data_countmatrix"),
                       title = "You need to tabular data from these tabs:"))
        ),
        h5("Once you have prepared the data,
           select which tab(s) your data is coming from:"),
        column(6, shinyWidgets::pickerInput(ns("source_meta"), "Meta Data",
                    choices = c("Meta Data" = "data_targets"),
                    options = list(style = "btn-primary"))),
        column(6, shinyWidgets::pickerInput(ns("source_data"), "Count Matrix Input",
                    choices = c("Count Matrix Tab" = "data_countmatrix"),
                    options = list(style = "btn-primary"))), spsHr(),
        div(style = "text-align: center;",
            strong("Click the button below to start or reload data"), br(),
            actionButton(inputId = ns("validate_start"), label = "Start/Reload")
        ),
        spsHr(), h3("Plotting"),
        spsHr(), h5("Add plot options"),
        div(
            id = ns("tab_main"), class = "shinyjs-hide",
            #uiExamples(ns), 
            spsHr(),
            fluidRow(
                actionButton(ns("render"), label = "Render/Snapshot plot",
                             icon("paper-plane")),
            ),
            div(class = "sps-plot-container",
                shinyjqui::jqui_resizable(
                    sps_plots$addUI(plotly::plotlyOutput(ns("plot")), id)
                ),
                tags$script(glue('stretchPlotTab("{ns("plot")}")'))
            )
        )
    )
}

## server
#' @importFrom shinytoastr toastr_success toastr_info
#' @importFrom plotly renderPlotly ggplotly
#' @importFrom shinyjs show
plot_hclustServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "plot_hclust"
        # define data containers
        mydata <- reactiveValues()
        # start the tab by checking if required packages are installed
        observeEvent(input$validate_start, {
            req(shinyCheckPkg(session = session,
                                cran_pkg = c("base"),
                                bioc_pkg = c(""),
                                github = c("")
            ))
            pgPaneUpdate('pg', 'pkg', 100)
            mydata$dds <- getData(isolate(input$source_data), shared)
            print(mydata)
            pgPaneUpdate('pg', 'data', 100)
            spsValidate({
                if (class(mydata$dds) == "DESeqTransform") TRUE
                else stop("class 'DESeqTransform'")
            }, "Raw data column check")

            pgPaneUpdate('pg', 'vd_data', 100)
            shinyjs::show(id = "tab_main")
            shinytoastr::toastr_success(
                title = "Ready for plotting!", message = "", timeOut = 5000,
                position = "bottom-right"
            )
        })
        observeEvent(input$render, {
            dds <- mydata$dds
                print(dds)
            output$plot <- sps_plots$addServer(plotly::renderPlotly, tab_id, {
                hclustplot(dds, plotly = TRUE)
                
            })
            shared$snap_signal <- sps_plots$notifySnap(tab_id)
            req(shared$snap_signal)
            shinytoastr::toastr_info(
                glue("Snapshot {glue_collapse(shared$snap_signal, '-')}",
                     "added to canvas"),
                position = "bottom-right")
        })
    }
    moduleServer(id, module)
}