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)
f2b69b61
   
   
30597d38
   ##################### INPUTS  ##################### 
f2b69b61
   
   # DATA MATRIX
   matrix <- matrixServer("matrix1")
   
   # GENES
   genesets <- geneSetsServer("genes1")
   
   # ARGUMENTS
   argInp <- argumentsDataServer("argumentsInput")
eeb542e4
   
ce727bdf
 
30597d38
   ##################### GSVA RESULTS  ##################### 
f2b69b61
   
eeb542e4
   ## REACTIVE VALUES
f2b69b61
   rv <- reactiveValues(gs=NULL, dat.t=NULL, n=NULL, dd.col=NULL, p=NULL, 
663f06af
                        p2=NULL, p3=NULL, errors.gsva = NULL, sample.c = NULL,
                        method=NULL)
f2b69b61
   gsva.cancel <- reactiveVal(FALSE)
   
eeb542e4
   ## GSVA RESULT
f2b69b61
   observeEvent( input$button, {
eeb542e4
     
     ## This js is in order to reset the event_data from the plotlys,
     ## so every time the .user hits the 'run' button, plotlys get back to null
a3844f3d
     runjs("Shiny.setInputValue('plotly_click-click1', null);")
     runjs("Shiny.setInputValue('plotly_click-click2', null);")
eeb542e4
     
     ## here we reset all the reactiveValues to NULL
f2b69b61
     rv$gs <- NULL
     rv$dat.t <- NULL
     rv$p <- NULL
464936e4
     rv$p2 <- NULL
     rv$p3 <- NULL
eeb542e4
     rv$sample.c <- NULL
     rv$errors.gsva <- NULL
663f06af
     rv$method <- argInp$method()
eeb542e4
     
     ## this is a flag for the future. Futures cannot be canceled or
     ## terminated in a strict way, so when they get interrupted they
     ## throw an error that is not related to gsva(). When future is 
     ## interrupted, the flag goes TRUE in order to make the errors
     ## message print NULL
f2b69b61
     gsva.cancel(FALSE)
eeb542e4
     
f2b69b61
     modalGSVAUI("modal.text")
eeb542e4
     
     ## future() cannot take reactive values, so we must isolate() them
f2b69b61
     future({
eeb542e4
       ## sink() will redirect all console cats and prints to a
       ## text file that the main session will be reading in order
       ## to print the progress bar from bplaply()
f2b69b61
       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()
eeb542e4
       ## when gsva() ends, we reset the console text file to empty
f2b69b61
       write("", file=rout)
       return(result)
     }, seed = TRUE) %...>%
       (function(result){
eeb542e4
         ## the future's result will be the gsva() result, and we save it
         ## and transform it in reactiveValues(). In order to make the future
         ## not block the app at an inner-session level, we save the results in
         ## reactiveValues() and then at the end of the observeEvent() we return NULL
         ## in order to make the plots.
         ## https://github.com/rstudio/promises/issues/23#issuecomment-386687705
f2b69b61
         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)
eeb542e4
         
         ## finally, we leave the console.text file empty again and
         ## remove the modal
f2b69b61
         write("", file=rout)
         removeModal()
       }) %...!%
       (function(error){
eeb542e4
         ## there can be two ways to get an error here: 
         ## 1. gsva() fails, which is an ok error and should be returnet to user
         ## 2. User interrupts the future, which shouldn't be printed, that's
         ## why I use a flag to identify if error comes from pressing "Cancel" btn
         ## on the modal
f2b69b61
         removeModal()
         write("", file=rout)
         if(gsva.cancel()){
           rv$errors.gsva <- NULL
         } else {
           rv$errors.gsva <- as.character(error)
         }
         
       })
     NULL
ca2b622a
   })
   
f2b69b61
   # PRINTING CONSOLE.TEXT
0c6ecf40
   modalGSVAServer("modal.text", console.text, gsva.cancel, rout)
f2b69b61
   
64de0b0d
   
   ##################### OUTPUTS ##################
   
f2b69b61
   # PLOT1 RENDER
   plot1_Server("plot1", rv)
630c31e3
 
f2b69b61
   # PLOT2 RENDER
   eventData1 <- reactive({
a80936d3
     if(is.null(rv$p))return(NULL)
f2b69b61
     ind <- event_data("plotly_click", source = "click1")
     ind <- ind$curveNumber+1
10197c62
   })
f2b69b61
   plot2_Server("plot2", eventData1, rv)
30597d38
 
f2b69b61
   # PLOT3 RENDER
b574e85a
   
   ## Whenever the user clicks on the first plot, the third one resets
   observeEvent(eventData1(), {
     runjs("Shiny.setInputValue('plotly_click-click2', null);")
   })
   
f2b69b61
   eventData2 <- reactive({
     req(rv$p2)
     ind <- event_data("plotly_click", source = "click2")
     ind <- ind$pointNumber+1
5cee189f
   })
a3844f3d
   plot3_Server("plot3", eventData2, rv, matrix, genesets)
30597d38
 
64de0b0d
   # ERRORS MESSAGES
   output$errorsGsva <- renderText({
     req(argInp$varMinsz(), argInp$varMaxsz(), argInp$selectedTau())
     rv$errors.gsva
d6d54be4
   })
   
ca2b622a
   # SESSION INFO
630c31e3
   output$sessionInfo <- renderPrint({
     sessionInfo()
   })
64de0b0d
   
   
   ##################### UI SETUPS #####################
   
   ## ENABLING 'RUN' BTN
   observe({
     if(!is.null(matrix()) && !is.null(genesets())){
       enable("button")
     } else {
       disable("button")
     }
   })
   
a80936d3
   ## HIDE 'GeneSets' PANEL WHILE THERE IS NO CLICK EVENT ON THE FIRST PLOT
64de0b0d
   observe({
a80936d3
     if( length(eventData1()) == 0){
       hideTab(inputId = "Panels", target = "GeneSets")
64de0b0d
     } else {
a80936d3
       showTab(inputId = "Panels", target = "GeneSets", select = TRUE)
64de0b0d
     }
   })
   
   # DNLD BTN
0c6ecf40
   downloadServer("download", reactive(rv$gs))
98c1bac6
   
   # CLOSE BTN
   closeBtnServer("close", reactive(rv$gs))
282aaa63
   
f2b69b61
   
   # TEXT1
10197c62
   output$text1 <- renderUI({
f2b69b61
     req(rv$gs)
282aaa63
     tagList(
       br(),
a795b9e4
       div("Non-parametric kernel density estimation of sample
           profiles of GSVA enrichment scores. Clicking on the
           line of a sample will display the empirical cumulative
           distribution of GSVA scores for that sample on the
           'GeneSets' tab", style="text-align: center;")
282aaa63
     )
10197c62
   })
   
f2b69b61
   # TABLE
   output$result <- renderTable({
     req(rv$gs)
a795b9e4
     resultInformation <- data.frame("Nr. of gene sets" = nrow(rv$gs),
                                     "Nr. of samples" = ncol(rv$gs),
                                     check.names=FALSE)
f2b69b61
     resultInformation
f30da782
   }, bordered = TRUE)
630c31e3
   
f2b69b61
   # TEXT2
d6d54be4
   output$text2 <- renderUI({
f2b69b61
     title1 <- rv$sample.c
5cee189f
     h2(tags$b(title1), align ="center")
   })
   
f2b69b61
   # TEXT3
5cee189f
   output$text3 <- renderUI({
8a7cd8e7
     tagList(
       br(),
a795b9e4
       div("Empirical cumulative distribution of GSVA scores, where each
           point is a gene set. Clicking on a gene set will display below
           the individual gene expression values of its constituent genes
           and the non-parametric kernel density estimation of their
           distribution", style = "text-align: center;")
8a7cd8e7
     )
d6d54be4
   })
8a7cd8e7
   
fd21ac54
 }