inst/app/R/tab_vs_plot_clust.R

## UI
plot_clustUI <- function(id){
    ns <- NS(id)
    tabPanel(title = "Hierarchical Clustering Dendrogram",
             h2("Make a Hierarchical Clustering Dendrogram plot"),
             fluidRow(
                 actionButton(
                     ns("op_1"),
                     label = "Raw",
                     icon("cog")
                 ),
                 actionButton(
                     ns("op_2"),
                     label = "R-log",
                     icon("cog")
                 ),
                 actionButton(
                     ns("op_3"),
                     label = "VST",
                     icon("cog")
                 )
             ),
             fluidRow(
                 actionButton(ns("render"),
                              label = "Render the plot",
                              icon("paper-plane")),
             ),
             uiOutput(ns("plot_ui"))
    )
}

## server
plot_clustServer <- function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        observeEvent(input$render, {
            targets <- data.frame(shared$df$target)
            countDF <- data.frame(shared$count$df)
            colnames(countDF) <- countDF[1,]
            colnames(targets) <- targets[1,]
            countDF <- countDF[-1,]
            targets <- targets[-1,]
            rownames(countDF) <- countDF[,1]
            countDF <- countDF[,-1]
            rownames(targets) <- targets[,1]
            targets <- targets[,-1]
            colData <- data.frame(row.names = targets$SampleName,
                                  condition = targets$Factor)
            countDF[] <- lapply(countDF, function(x) as.numeric(x))
            countDF <- as.matrix(countDF)
            output$plot_ui <- renderUI(
                plotOutput(ns("clust"))
            )
            output$clust <- renderPlot({
                run_CLUST(countDF = countDF, targets = targets, colData = colData, method = "raw")
            })
        })
    }
    moduleServer(id, module)
}
systemPipeR/spsBio documentation built on Oct. 2, 2020, 9:30 a.m.