inst/shinyApp/server.R
ca2b622a
 function(input, output, session) {
ce727bdf
   
ca2b622a
   # CREATE REACTIVE FOR CONSOLE TEXT PROGRESS BAR
   rout <- tempfile("consoleText", fileext = ".txt")
   file.create(rout)
   console.text <- reactiveFileReader(200, session, rout, readLines, warn=F)
   
   # ERRORS MESSAGES
   output$errorsGsva <- renderText({
     req(argInp$varMinsz(), argInp$varMaxsz(), argInp$selectedTau())
     rv$errors.gsva
   })
ce727bdf
 
ca2b622a
   # ENABLING 'RUN' BTN
   observe({
     if(!is.null(matrix()) && !is.null(genesets())){
       enable("button")
     } else {
       disable("button")
ce727bdf
     }
ca2b622a
   })
   
   ### INPUTS ###
   
   # DATA MATRIX
   matrix <- matrixServer("matrix1")
   
   # GENES
   genesets <- geneSetsServer("genes1")
   
   # ARGUMENTS
   argInp <- argumentsDataServer("argumentsInput")
ce727bdf
 
ca2b622a
   #### GSVA RESULTS ####
   
   rv <- reactiveValues(gs=NULL, dat.t=NULL, n=NULL, dd.col=NULL, p=NULL, 
                        errors.gsva = NULL, matrix=NULL, genesets=NULL)
   gsva.cancel <- reactiveVal(FALSE)
   
   observeEvent( input$button, {
     rv$gs <- NULL
     rv$dat.t <- NULL
     rv$p <- NULL
055f2806
     rv$p2 <- NULL
     rv$p3 <- NULL
ca2b622a
     rv$errors.gsva = NULL
     rv$matrix <- isolate(matrix())
     rv$genesets <- isolate(genesets())
     gsva.cancel(FALSE)
     modalGSVAUI("modal.text")
     # future() cannot take reactive values, so we must isolate() them
     future({
       sink(rout)
       result <- gsva(isolate(matrix()),
                      isolate(genesets()), 
                      method=isolate(argInp$method()),
                      kcdf=isolate(argInp$kcdf()),
                      abs.ranking=isolate(argInp$absRanking()),
                      min.sz= isolate(argInp$varMinsz()),
                      max.sz=isolate(argInp$varMaxsz()),
                      parallel.sz=1L, ## by now, disable parallelism
                      mx.diff=isolate(argInp$mxDiff()),
                      tau=isolate(argInp$selectedTau()),
                      ssgsea.norm=isolate(argInp$ssgseaNorm()),
                      verbose=TRUE)
       sink()
       write("", file=rout)
       return(result)
     }, seed = TRUE) %...>%
       (function(result){
         rv$gs <- result
         rv$dat.t <- melt(as.data.table(rv$gs, keep.rownames = "gene.sets"),
                          variable.name = "Sample", id.vars="gene.sets")
         rv$n <- length(levels(rv$dat.t$Sample))
         rv$dd.col <- hcl(h = seq(15, 375, length=rv$n), l = 65, c = 100)[1:rv$n]
         names(rv$dd.col)  <- levels(rv$dat.t$Sample)
         write("", file=rout)
         removeModal()
       }) %...!%
       (function(error){
         removeModal()
         write("", file=rout)
         if(gsva.cancel()){
           rv$errors.gsva <- NULL
         } else {
           rv$errors.gsva <- as.character(error)
         }
         
       })
     NULL
ce727bdf
   })
ca2b622a
   
   # PRINTING CONSOLE.TEXT
359519f7
   modalGSVAServer("modal.text", console.text, gsva.cancel, rout)
ca2b622a
   
   # PLOT1 RENDER
   plot1_Server("plot1", rv)
630c31e3
 
ce727bdf
 
ca2b622a
   # PLOT2 RENDER
   eventData1 <- reactive({
     req(rv$dat.t)
     ind <- event_data("plotly_click", source = "click1")
     ind <- ind$curveNumber+1
   })
   plot2_Server("plot2", eventData1, rv)
   
   
   # PLOT3 RENDER
   eventData2 <- reactive({
     req(rv$p2)
     ind <- event_data("plotly_click", source = "click2")
     ind <- ind$pointNumber+1
   })
   plot3_Server("plot3", eventData2, rv, rv$matrix, rv$genesets)
   
   # DWN BTN
359519f7
   downloadServer("download", reactive(rv$gs))
e32501d2
   
   # CLOSE BTN
   closeBtnServer("close", reactive(rv$gs))
10197c62
 
ca2b622a
   
   # TEXT1
10197c62
   output$text1 <- renderUI({
ca2b622a
     req(rv$gs)
10197c62
     HTML(paste("<br/>", "\t To see the Empirical Cumulative Distribution Function 
     of a Sample, click on its line in this plot and go
       to the 'Gene.Set' Panel", "<br/>", sep="<br/>"))
   })
   
ca2b622a
   # TABLE
   output$result <- renderTable({
     req(rv$gs)
     resultInformation <- data.frame("Nr of gene sets" = nrow(rv$gs),
                                     "Nr of samples" = ncol(rv$gs))
     resultInformation
10197c62
   })
630c31e3
   
ca2b622a
   # TEXT2
d6d54be4
   output$text2 <- renderUI({
ca2b622a
     title1 <- rv$sample.c
5cee189f
     h2(tags$b(title1), align ="center")
   })
   
ca2b622a
   # TEXT3
5cee189f
   output$text3 <- renderUI({
d6d54be4
     HTML(paste("<br/>", "\t To see the Kernel Density Estimation of genes of 
     any given Gene Set in this Sample,  click on any point in this plot and a
     second plot will appear bellow it", "<br/>", sep="<br/>"))
   })
   
ca2b622a
   # SESSION INFO
630c31e3
   output$sessionInfo <- renderPrint({
     sessionInfo()
   })
ce727bdf
 
fd21ac54
 }