Browse code

Merge branch 'shinyUpdate' of https://github.com/pablo-rodr-bio2/GSVA into pablo-rodr-bio2-shinyUpdate

[rcastelo] authored on 30/04/2021 15:18:40
Showing9 changed files

... ...
@@ -1,5 +1,5 @@
1 1
 Package: GSVA
2
-Version: 1.39.25
2
+Version: 1.39.27
3 3
 Title: Gene Set Variation Analysis for microarray and RNA-seq data
4 4
 Authors@R: c(person("Justin", "Guinney", role=c("aut", "cre"), email="justin.guinney@sagebase.org"),
5 5
              person("Robert", "Castelo", role="aut", email="robert.castelo@upf.edu"),
... ...
@@ -920,11 +920,6 @@ zscore <- function(X, geneSets, parallel.sz, verbose=TRUE,
920 920
   rownames(es) <- names(geneSets)
921 921
   colnames(es) <- colnames(X)
922 922
 
923
-  if (verbose && length(geneSets) > n) {
924
-    setTxtProgressBar(get("progressBar", envir=globalenv()), 1)
925
-    close(get("progressBar", envir=globalenv()))
926
-  }
927
-
928 923
   es
929 924
 }
930 925
 
... ...
@@ -12,27 +12,21 @@ argumentsDataUI <- function(id) {
12 12
         column(
13 13
           12,
14 14
           selectInput(ns("method"), "Choose method:",
15
-                      c("gsva","ssgsea","zscore","plage")),
15
+                      choices = methodChoices),
16 16
           selectInput(ns("kcdf"), "Choose kcdf:",
17 17
                       c("Gaussian","Poisson","none")),
18 18
           radioButtons(ns("absRanking"), "abs.ranking:",
19 19
                        c("False" = FALSE,
20 20
                          "True" = TRUE)),
21
-          numericInput(ns("minSz"),"min.sz:",value = 1),
22
-          numericInput(ns("maxSz"),"max.sz (Write 0 for infinite):",value = 0),
21
+          numericInput(ns("minSz"),"min.sz:", value = 1),
22
+          numericInput(ns("maxSz"),"max.sz (Write 0 for infinite):", value = 0),
23 23
           radioButtons(ns("mxDiff"), "mx.diff:",
24 24
                        c("True" = TRUE,
25 25
                          "False" = FALSE)),
26
-          conditionalPanel(
27
-            condition = "input.method == 'gsva'", ns = ns, 
28
-            numericInput(ns("tau1"),"tau:",value = 1)
29
-          ),
30
-          conditionalPanel(
31
-            condition = "input.method == 'ssgsea'", ns = ns, 
32
-            numericInput(ns("tau2"),"tau:",value = 0.25),
33
-            radioButtons(ns("ssgseaNorm"), "ssgsea.norm:",
34
-                         c("True" = TRUE,
35
-                           "False" = FALSE)))
26
+          numericInput(ns("tau"),"tau:", value = 1),
27
+          radioButtons(ns("ssgseaNorm"), "ssgsea.norm:",
28
+                       c("True" = TRUE,
29
+                         "False" = FALSE))
36 30
         )))
37 31
     )
38 32
   )
... ...
@@ -40,6 +34,27 @@ argumentsDataUI <- function(id) {
40 34
 
41 35
 argumentsDataServer <- function(id){
42 36
   moduleServer(id, function(input, output, session){
37
+    
38
+    observeEvent(input$method, {
39
+      toggleElement("kcdf", condition = input$method %in% c("gsva", "ssgsea"))
40
+      toggleElement("absRanking", condition = input$method %in% c("gsva", "ssgsea"))
41
+      toggleElement("ssgseaNorm", condition = input$method %in% "ssgsea")
42
+      toggleElement("mxDiff", condition = input$method %in% "gsva")
43
+      toggleElement("tau", condition = input$method %in% c("gsva", "ssgsea"))
44
+      
45
+      if(input$method == "gsva"){
46
+        updateNumericInput(inputId = "tau", value = 1)
47
+      } else {
48
+        updateNumericInput(inputId = "tau", value = 0.25)
49
+      }
50
+      
51
+      if(input$method %in% c("zscore", "plage")){
52
+        updateSelectInput(inputId = "kcdf", selected = "Gaussian")
53
+      }
54
+      
55
+    })
56
+    
57
+    #"absRanking", "ssgseaNorm", "mxDiff", "tau"
43 58
     varMinsz <-  reactive({
44 59
       validate(need(!is.na(input$minSz), "Value 'min.sz' cannot be empty and must be an integer value"))
45 60
       input$minSz })
... ...
@@ -47,16 +62,11 @@ argumentsDataServer <- function(id){
47 62
       validate(need(!is.na(input$maxSz), "Value 'max.sz' cannot be empty and must be an integer value"))
48 63
       ifelse(input$maxSz==0, Inf, input$maxSz) })
49 64
     selectedTau <-  reactive({
50
-      if(input$method == "gsva"){
51
-        validate(need(!is.na(input$tau1), "Value 'tau' cannot be empty and must be an integer value"))
52
-        input$tau1
65
+      if(input$method %in% c("gsva", "ssgsea")){
66
+        validate(need(!is.na(input$tau), "Value 'tau' cannot be empty and must be an integer value"))
67
+        input$tau
53 68
       } else {
54
-        if(input$method == "ssgsea"){
55
-          validate(need(!is.na(input$tau2), "Value 'tau' cannot be empty and must be an integer value"))
56
-          input$tau2
57
-        } else {
58
-          NULL
59
-        }
69
+        NULL
60 70
       }
61 71
     })
62 72
     method <-  reactive({ input$method })
... ...
@@ -20,4 +20,9 @@ source("plot3_Module.R")
20 20
 source("matrixModule.R")
21 21
 source("geneSetsModule.R")
22 22
 source("argumentsDataModule.R")
23
-source("closeModule.R")
24 23
\ No newline at end of file
24
+source("closeModule.R")
25
+
26
+methodChoices <- c( "GSVA" = "gsva",
27
+                    "ssGSEA" = "ssgsea",
28
+                    "zscore" = "zscore",
29
+                    "PLAGE" = "plage")
25 30
\ No newline at end of file
... ...
@@ -10,9 +10,14 @@ plot1_Server <- function(id, rv){
10 10
       
11 11
       output$plot <- renderPlotly({
12 12
         req(rv$dat.t)
13
+        # in order to print the name of the method (and not the 
14
+        # selected value from the method) on the 'x' label, this
15
+        # name is retrieved from the list 'methodChoices' declared
16
+        # in 'global.R
17
+        method <- names(methodChoices)[methodChoices == rv$method]
13 18
         rv$p <- ggplot(data = rv$dat.t, aes(x=value, color=Sample)) +
14 19
           stat_density(geom="line", position = "identity") +
15
-          theme(legend.position = "none") + labs(x="GSVA Scores", y="Density") +
20
+          theme(legend.position = "none") + labs(x=paste0(method, " Scores"), y="Density") +
16 21
           scale_color_manual("Legend", values = rv$dd.col)
17 22
         ggplotly(rv$p, tooltip = "Sample", source = "click1")
18 23
       })
... ...
@@ -10,11 +10,18 @@ plot2_Server <- function(id, eventData1, rv){
10 10
       
11 11
       output$plot2 <- renderPlotly({
12 12
         req(eventData1())
13
+        
14
+        # in order to print the name of the method (and not the 
15
+        # selected value from the method) on the 'x' label, this
16
+        # name is retrieved from the list 'methodChoices' declared
17
+        # in 'global.R
18
+        method <- names(methodChoices)[methodChoices == rv$method]
19
+        
13 20
         rv$sample.c <- colnames(rv$gs)[eventData1()]
14 21
         data <- rv$dat.t[Sample==rv$sample.c]
15 22
         p <- ggplot(data = data, aes(x=value, color=Sample)) +
16 23
           stat_ecdf(geom="point") + theme(legend.position = "none") +
17
-          labs(x="GSVA Scores in selected sample", y="Empirical Cumulative Density") +
24
+          labs(x=paste0(method, " Scores in selected sample"), y="Empirical Cumulative Density") +
18 25
           scale_color_manual("Legend", values = rv$dd.col)
19 26
         rv$p2 <- ggplotly(p, source="click2") %>% style(text=data$gene.sets)
20 27
         rv$p2
... ...
@@ -22,7 +22,8 @@ function(input, output, session) {
22 22
   
23 23
   ## REACTIVE VALUES
24 24
   rv <- reactiveValues(gs=NULL, dat.t=NULL, n=NULL, dd.col=NULL, p=NULL, 
25
-                       p2=NULL, p3=NULL, errors.gsva = NULL, sample.c = NULL)
25
+                       p2=NULL, p3=NULL, errors.gsva = NULL, sample.c = NULL,
26
+                       method=NULL)
26 27
   gsva.cancel <- reactiveVal(FALSE)
27 28
   
28 29
   ## GSVA RESULT
... ...
@@ -41,6 +42,7 @@ function(input, output, session) {
41 42
     rv$p3 <- NULL
42 43
     rv$sample.c <- NULL
43 44
     rv$errors.gsva <- NULL
45
+    rv$method <- argInp$method()
44 46
     
45 47
     ## this is a flag for the future. Futures cannot be canceled or
46 48
     ## terminated in a strict way, so when they get interrupted they
... ...
@@ -129,6 +131,12 @@ function(input, output, session) {
129 131
   plot2_Server("plot2", eventData1, rv)
130 132
 
131 133
   # PLOT3 RENDER
134
+  
135
+  ## Whenever the user clicks on the first plot, the third one resets
136
+  observeEvent(eventData1(), {
137
+    runjs("Shiny.setInputValue('plotly_click-click2', null);")
138
+  })
139
+  
132 140
   eventData2 <- reactive({
133 141
     req(rv$p2)
134 142
     ind <- event_data("plotly_click", source = "click2")
... ...
@@ -1,16 +1,17 @@
1 1
 fluidPage( 
2 2
   theme = shinytheme("spacelab"),
3 3
   shinyjs::useShinyjs(),
4
-  add_busy_spinner(spin = "double-bounce", position = "bottom-right", height = "100px", width = "100px"),
4
+  add_busy_spinner(spin = "double-bounce", position = "bottom-right",
5
+                   height = "100px", width = "100px"),
5 6
   tags$head(
6 7
     tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
7 8
   ),
8
-  titlePanel(
9
-    fluidRow(
9
+  titlePanel( 
10
+    fluidRow(id = "title_gsva",
10 11
       column(6,
11
-             h2("GSVA Shiny App", align="left")),
12
+             h2(id="app_title", "GSVA SHINY APP", align="left")),
12 13
       column(6,
13
-             tags$img(src="GSVA.png", align="right", height=75, width=75))
14
+             h2(tags$img(src="GSVA.png", align="right", height=75, width=75)))
14 15
     ), windowTitle="GSVA"),
15 16
   
16 17
   fluidRow(
... ...
@@ -1,4 +1,13 @@
1 1
 #errorsGsva{color: red;
2 2
 font-size: 20px;
3 3
 font-weight: bold;
4
+}
5
+
6
+#title_gsva {
7
+  background-color: black;
8
+}
9
+
10
+#app_title {
11
+  color: white;
12
+  font-weight: bold;
4 13
 }
5 14
\ No newline at end of file