Browse code

modules in shinyApp

pablo-rodr-bio2 authored on 12/04/2021 19:41:34
Showing 15 changed files

... ...
@@ -1,5 +1,9 @@
1 1
 Package: GSVA
2
+<<<<<<< HEAD
2 3
 Version: 1.39.24
4
+=======
5
+Version: 1.39.23
6
+>>>>>>> modules in shinyApp
3 7
 Title: Gene Set Variation Analysis for microarray and RNA-seq data
4 8
 Authors@R: c(person("Justin", "Guinney", role=c("aut", "cre"), email="justin.guinney@sagebase.org"),
5 9
              person("Robert", "Castelo", role="aut", email="robert.castelo@upf.edu"),
... ...
@@ -10,9 +14,15 @@ Imports: methods, stats, utils, graphics, S4Vectors, IRanges,
10 14
          Biobase, SummarizedExperiment, GSEABase, Matrix, parallel,
11 15
          BiocParallel, SingleCellExperiment, sparseMatrixStats, DelayedArray,
12 16
          DelayedMatrixStats, HDF5Array, BiocSingular
17
+<<<<<<< HEAD
13 18
 Suggests: BiocGenerics, RUnit, BiocStyle, knitr, rmarkdown, limma, RColorBrewer,
14 19
           org.Hs.eg.db, genefilter, edgeR, GSVAdata, shiny, shinythemes, ggplot2,
15 20
           data.table, plotly
21
+=======
22
+Suggests: BiocGenerics, RUnit, BiocStyle, knitr, markdown, limma, RColorBrewer,
23
+          genefilter, edgeR, GSVAdata, shiny, shinythemes, ggplot2, data.table,
24
+          plotly, shinyjs, future, promises, shinybusy
25
+>>>>>>> modules in shinyApp
16 26
 Description: Gene Set Variation Analysis (GSVA) is a non-parametric, unsupervised method for estimating variation of gene set enrichment through the samples of a expression data set. GSVA performs a change in coordinate systems, transforming the data from a gene by sample matrix to a gene-set by sample matrix, thereby allowing the evaluation of pathway enrichment for each sample. This new matrix of GSVA enrichment scores facilitates applying standard analytical methods like functional enrichment, survival analysis, clustering, CNV-pathway analysis or cross-tissue pathway analysis, in a pathway-centric manner.
17 27
 License: GPL (>= 2)
18 28
 VignetteBuilder: knitr
19 29
new file mode 100644
... ...
@@ -0,0 +1,79 @@
1
+argumentsDataUI <- function(id) {
2
+  # Create a namespace function using the provided id
3
+  ns <- NS(id)
4
+  
5
+  #UI Definition
6
+  column(
7
+    width=3,
8
+    conditionalPanel(
9
+      condition = "input.arg == 'yes'",
10
+      h3("Parameters"),
11
+      wellPanel(fluidRow(
12
+        column(
13
+          12,
14
+          selectInput(ns("method"), "Choose method:",
15
+                      c("gsva","ssgsea","zscore","plage")),
16
+          selectInput(ns("kcdf"), "Choose kcdf:",
17
+                      c("Gaussian","Poisson","none")),
18
+          radioButtons(ns("absRanking"), "abs.ranking:",
19
+                       c("False" = FALSE,
20
+                         "True" = TRUE)),
21
+          numericInput(ns("minSz"),"min.sz:",value = 1),
22
+          numericInput(ns("maxSz"),"max.sz (Write 0 for infinite):",value = 0),
23
+          radioButtons(ns("mxDiff"), "mx.diff:",
24
+                       c("True" = TRUE,
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)))
36
+        )))
37
+    )
38
+  )
39
+}
40
+
41
+argumentsDataServer <- function(id){
42
+  moduleServer(id, function(input, output, session){
43
+    varMinsz <-  reactive({
44
+      validate(need(!is.na(input$minSz), "Value 'min.sz' cannot be empty and must be an integer value"))
45
+      input$minSz })
46
+    varMaxsz <- reactive({
47
+      validate(need(!is.na(input$maxSz), "Value 'max.sz' cannot be empty and must be an integer value"))
48
+      ifelse(input$maxSz==0, Inf, input$maxSz) })
49
+    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
53
+      } 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
+        }
60
+      }
61
+    })
62
+    method <-  reactive({ input$method })
63
+    kcdf <-  reactive({ input$kcdf })
64
+    absRanking <-   reactive({ as.logical(input$absRanking) })
65
+    mxDiff <-   reactive({ as.logical(input$mxDiff) })
66
+    ssgseaNorm <-  reactive({ as.logical(input$ssgseaNorm) })
67
+    
68
+    return(list(
69
+      varMinsz = varMinsz,
70
+      varMaxsz = varMaxsz,
71
+      selectedTau = selectedTau,
72
+      method = method,
73
+      kcdf = kcdf,
74
+      absRanking = absRanking,
75
+      mxDiff = mxDiff,
76
+      ssgseaNorm = ssgseaNorm
77
+    ))
78
+  })
79
+}
0 80
\ No newline at end of file
1 81
new file mode 100644
... ...
@@ -0,0 +1,34 @@
1
+downloadUI <- function(id) {
2
+  ns <- NS(id)
3
+  tagList(
4
+    downloadButton(ns('downloadData'), 'Download'),
5
+    actionButton(ns('closeSave'),'Save & Close')
6
+  )
7
+}
8
+
9
+downloadServer <- function(id, gs){
10
+  moduleServer(
11
+    id,
12
+    function(input, output, session){
13
+      #Controls the Download button
14
+      output$downloadData <- downloadHandler(
15
+        filename = function() {
16
+          paste("gsva_es-", Sys.Date(), ".csv", sep="")
17
+        },
18
+        content = function(file) {
19
+            if("ExpressionSet" %in% class(gs)) 
20
+            {
21
+              expressionSetObs <- exprs(gs)
22
+              dataFrameObs <- as.data.frame(expressionSetObs)
23
+              write.csv(dataFrameObs, file)
24
+            }
25
+            else
26
+            {
27
+              dataFrameObs <- as.data.frame(gs)
28
+              write.csv(dataFrameObs, file)
29
+            } 
30
+        }
31
+      )
32
+    }
33
+  )
34
+}
0 35
\ No newline at end of file
1 36
new file mode 100644
... ...
@@ -0,0 +1,39 @@
1
+geneSetsUI <- function(id){
2
+  ns <- NS(id)
3
+  tagList(
4
+    radioButtons(ns("genesetSourceType"), "Select gene sets:",
5
+                 c("From file" = "fileGeneset",
6
+                   "From workspace" = "varGeneset")),
7
+    conditionalPanel(
8
+      condition = "input.genesetSourceType == 'fileGeneset'", ns = ns,
9
+      fileInput(ns("genesetFile"), "Choose GeneSet file:",
10
+                accept = ".gmt")
11
+    ),
12
+    conditionalPanel(
13
+      condition = "input.genesetSourceType == 'varGeneset'", ns = ns, 
14
+      selectInput(ns("genesetVar"), "Choose GeneSet var:",
15
+                  ls(envir=.GlobalEnv))
16
+    )
17
+  )
18
+}
19
+
20
+geneSetsServer <- function(id){
21
+  moduleServer( id, function(input, output, session){
22
+    geneSets <- reactive({
23
+      if(input$genesetSourceType == "fileGeneset"){
24
+        if(is.null(input$genesetFile)) return(NULL)
25
+        genesets <- getGmt(input$genesetFile$datapath)
26
+      } else {
27
+        if(is.null(input$genesetVar)) return(NULL)
28
+        genesets <- get(input$genesetVar)
29
+      }
30
+      genesets
31
+    }) %>% bindCache({
32
+      if(input$genesetSourceType == "fileGeneset"){
33
+        input$genesetFile$name
34
+      } else {
35
+        input$genesetVar
36
+      }
37
+    })
38
+  })
39
+}
0 40
\ No newline at end of file
1 41
new file mode 100644
... ...
@@ -0,0 +1,22 @@
1
+library(shiny)
2
+library(shinythemes)
3
+library(plotly)
4
+library(GSVA)
5
+library(GSEABase)
6
+library(limma)
7
+library(ggplot2)
8
+library(data.table)
9
+library(future)
10
+library(promises)
11
+library(shinyjs)
12
+library(shinybusy)
13
+plan(multisession, gc=TRUE)
14
+source("argumentsDataModule.R")
15
+source("modalGSVAModule.R")
16
+source("downloadModule.R")
17
+source("plot1_Module.R")
18
+source("plot2_Module.R")
19
+source("plot3_Module.R")
20
+source("matrixModule.R")
21
+source("geneSetsModule.R")
22
+source("argumentsDataModule.R")
0 23
\ No newline at end of file
1 24
new file mode 100644
... ...
@@ -0,0 +1,42 @@
1
+matrixUI <- function(id){
2
+  ns <- NS(id)
3
+  tagList(
4
+    radioButtons(ns("matrixSourceType"), "Select expression data matrix:",
5
+                 c("From file" = "fileMatrix",
6
+                   "From workspace" = "varMatrix")),
7
+    conditionalPanel(
8
+      condition = "input.matrixSourceType == 'fileMatrix'", ns = ns,
9
+      fileInput(ns("matrixFile"), "Choose matrix file:",
10
+                accept = c(
11
+                  "text/csv",
12
+                  "text/comma-separated-values,text/plain",
13
+                  ".csv",".ods",".xls",".xlt"))
14
+    ),
15
+    conditionalPanel(
16
+      condition = "input.matrixSourceType == 'varMatrix'", ns= ns,
17
+      selectInput(ns("matrixVar"), "Choose matrix var:",
18
+                  ls(envir=.GlobalEnv))
19
+    )
20
+  )
21
+}
22
+
23
+matrixServer <- function(id){
24
+  moduleServer( id, function(input, output, session){
25
+    matrix <- reactive({
26
+      if(input$matrixSourceType=="fileMatrix"){
27
+        if(is.null(input$matrixFile)) return(NULL) #this is in order to disable "run" btn
28
+        matrix <- data.matrix(read.csv(file=input$matrixFile$datapath, row.names = 1L))
29
+      } else {
30
+        if(is.null(input$matrixVar)) return(NULL)
31
+        matrix <- get(input$matrixVar)
32
+      }
33
+      matrix
34
+    }) %>% bindCache({
35
+      if(input$matrixSourceType == "fileMatrix"){
36
+        input$matrixFile$name
37
+      } else {
38
+        input$matrixVar
39
+      }
40
+    })
41
+  })
42
+}
0 43
\ No newline at end of file
1 44
new file mode 100644
... ...
@@ -0,0 +1,36 @@
1
+modalGSVAUI <- function(id){
2
+  ns <- NS(id)
3
+  showModal(
4
+    modalDialog(
5
+      size="l",
6
+      title = "GSVA calculations",
7
+      div(id="install.text", "Calculating, please wait... "),
8
+      div(p("\n")),
9
+      verbatimTextOutput(ns("text")),
10
+      footer = actionButton(ns("cancel"), "Cancel"))
11
+  )
12
+}
13
+
14
+modalGSVAServer <- function(id, console.text, gsva.cancel){
15
+  moduleServer(
16
+    id,
17
+    function(input, output, session){
18
+      
19
+      output$text <- renderText({
20
+        req(console.text())
21
+        max <- length(console.text())
22
+        if(max>1){
23
+          paste(console.text()[1], console.text()[max], sep= "\n")
24
+        } else {
25
+          console.text()
26
+        }
27
+      })
28
+      
29
+      observeEvent(input$cancel, {
30
+        removeModal()
31
+        gsva.cancel(TRUE)
32
+        plan(multisession, gc=TRUE)
33
+      })
34
+    }
35
+  )
36
+}
0 37
\ No newline at end of file
1 38
new file mode 100644
... ...
@@ -0,0 +1,21 @@
1
+plot1_UI <- function(id){
2
+  ns <- NS(id)
3
+  plotlyOutput(ns("plot"))
4
+}
5
+
6
+plot1_Server <- function(id, rv){
7
+  moduleServer(
8
+    id,
9
+    function(input, output, session){
10
+      
11
+      output$plot <- renderPlotly({
12
+        req(rv$dat.t)
13
+        rv$p <- ggplot(data = rv$dat.t, aes(x=value, color=Sample)) +
14
+          stat_density(geom="line", position = "identity") +
15
+          theme(legend.position = "none") + labs(x="GSVA Scores", y="Density") +
16
+          scale_color_manual("Legend", values = rv$dd.col)
17
+        ggplotly(rv$p, tooltip = "Sample", source = "click1")
18
+      })
19
+    }
20
+  )
21
+}
0 22
\ No newline at end of file
1 23
new file mode 100644
... ...
@@ -0,0 +1,24 @@
1
+plot2_UI <- function(id){
2
+  ns <- NS(id)
3
+  plotlyOutput(ns("plot2"))
4
+}
5
+
6
+plot2_Server <- function(id, eventData1, rv){
7
+  moduleServer(
8
+    id, 
9
+    function(input, output, session){
10
+      
11
+      output$plot2 <- renderPlotly({
12
+        # req(eventData1())
13
+        rv$sample.c <- colnames(rv$gs)[eventData1()]
14
+        data <- rv$dat.t[Sample==rv$sample.c]
15
+        p <- ggplot(data = data, aes(x=value, color=Sample)) +
16
+          stat_ecdf(geom="point") + theme(legend.position = "none") +
17
+          labs(x="GSVA Scores in selected sample", y="Empirical Cumulative Density") +
18
+          scale_color_manual("Legend", values = rv$dd.col)
19
+        rv$p2 <- ggplotly(p, source="click2") %>% style(text=data$gene.sets)
20
+        rv$p2
21
+      })
22
+    }
23
+  )
24
+}
0 25
\ No newline at end of file
1 26
new file mode 100644
... ...
@@ -0,0 +1,36 @@
1
+plot3_UI <- function(id){
2
+  ns <- NS(id)
3
+  plotlyOutput(ns("plot3"))
4
+}
5
+
6
+plot3_Server <- function(id, eventData2, rv, matrix, genesets){
7
+  moduleServer(
8
+    id,
9
+    function(input, output, session){
10
+      output$plot3 <- renderPlotly({
11
+        req(eventData2())
12
+        selected.gene.set <- rv$p2$x$data[[1]]$text[eventData2()]
13
+        if(is(genesets, "GeneSetCollection")){
14
+          genes.toplot <- geneIds(genesets)[[selected.gene.set]]
15
+        } else {
16
+          genes.toplot <- genesets[[selected.gene.set]]
17
+        }
18
+        mt <- match(genes.toplot, rownames(matrix))
19
+        x <-  matrix[na.omit(mt), rv$sample.c]
20
+        df <- as.data.frame(x)
21
+        df$x <- as.numeric(df$x)
22
+        df$Gene <- rownames(df)
23
+        df$Sample <- rv$sample.c
24
+        rv$p3 <- ggplot(data = df, aes(x=x, color = Sample, label = Gene)) +
25
+          stat_density(geom="line", position = "identity") +
26
+          geom_rug() + theme(legend.position = "none") +
27
+          labs(x="Gene Expressions in selected sample", y="Density") +
28
+          xlim(as.numeric(range(matrix))) +
29
+          scale_color_manual("legend", values= rv$dd.col)
30
+        ggplotly(rv$p3, tooltip = c("Gene", "x")) %>% style(hoverinfo="none", traces = 1) %>%
31
+          layout(title = list(text = paste0('<br><sup><i>', selected.gene.set, '</i></sup>'),
32
+                              font = list(size=15)))
33
+      })
34
+    }
35
+  )
36
+}
0 37
\ No newline at end of file
... ...
@@ -1,361 +1,158 @@
1
-library(GSVA)
2
-library(shiny)
3
-library(shinythemes)
4
-library(GSEABase)
5
-library(GSVAdata)
6
-library(limma)
7
-library(ggplot2)
8
-library(data.table)
9
-library(plotly)
10
-
11
-argumentsDataInput <- function(id) {
12
-  # Create a namespace function using the provided id
13
-  ns <- NS(id)
1
+function(input, output, session) {
14 2
   
15
-  #UI Definition
16
-  column(
17
-    3,
18
-    conditionalPanel(
19
-      condition = "input.arg == 'yes'",
20
-      h3("Select arguments:"),
21
-      wellPanel(fluidRow(
22
-        column(
23
-          12,
24
-          selectInput("method", "Choose method:",
25
-                      c("gsva","ssgsea","zscore","plage")),
26
-          selectInput("kcdf", "Choose kcdf:",
27
-                      c("Gaussian","Poisson","none")),
28
-          radioButtons("absRanking", "abs.ranking:",
29
-                       c("False" = FALSE,
30
-                         "True" = TRUE)),
31
-          numericInput("minSz","min.sz:",value = 1),
32
-          numericInput("maxSz","max.sz (Write 0 for infinite):",value = 0),
33
-          ## numericInput("parallelSz","parallel.sz:",value = 0),
34
-          ## selectInput("parallelType", "parallel.type:",
35
-          ##             c("SOCK","MPI","NWS")),
36
-          radioButtons("mxDiff", "mx.diff:",
37
-                       c("True" = TRUE,
38
-                         "False" = FALSE)),
39
-          conditionalPanel(
40
-            condition = "input.method == 'gsva'",
41
-            numericInput("tau1","tau:",value = 1)
42
-          ),
43
-          conditionalPanel(
44
-            condition = "input.method == 'ssgsea'",
45
-            numericInput("tau2","tau:",value = 0.25)
46
-          ),
47
-          conditionalPanel(
48
-            condition = "input.method == 'zscore' || input.method == 'plage'"
49
-          ),
50
-          radioButtons("ssgseaNorm", "ssgsea.norm:",
51
-                       c("True" = TRUE,
52
-                         "False" = FALSE)),
53
-          radioButtons("verbose", "verbose:",
54
-                       c("True" = TRUE,
55
-                         "False" = FALSE))
56
-        )))
57
-    )
58
-  )
59
-}
3
+  # CREATE REACTIVE FOR CONSOLE TEXT PROGRESS BAR
4
+  rout <- tempfile("consoleText", fileext = ".txt")
5
+  file.create(rout)
6
+  console.text <- reactiveFileReader(200, session, rout, readLines, warn=F)
7
+  
8
+  # ERRORS MESSAGES
9
+  output$errorsGsva <- renderText({
10
+    req(argInp$varMinsz(), argInp$varMaxsz(), argInp$selectedTau())
11
+    rv$errors.gsva
12
+  })
60 13
 
61
-gsva_validation <- function(input, output, session) {
62
-  success <- FALSE #Variable to control if the GSVA variables are assigned correctly
63
-  if(input$matrixSourceType == "fileMatrix")
64
-  {
65
-    if (is.null(input$matrixFile))
66
-    {
67
-      paste("No matrix file selected!")
68
-      success <- FALSE
69
-    }
70
-    else
71
-    {
72
-      #Matrix file selected
73
-      if(input$genesetSourceType == "fileGeneset")
74
-      {
75
-        if (is.null(input$genesetFile))
76
-        {
77
-          paste("No geneSet file selected!")
78
-          success <- FALSE
79
-        }
80
-        else
81
-        {
82
-          #User selects matrix file and geneSet file
83
-          inFile <- input$matrixFile
84
-          newY <- as.matrix(read.csv(inFile$datapath, header = TRUE, sep = ",")) #Reading file as matrix
85
-          rownames(newY) <- newY[,1] #Taking the first column as rownames
86
-          newY <- newY[,-1] #Deleting the first column
87
-          inGenesetFile <- input$genesetFile
88
-          genes <- getGmt(inGenesetFile$datapath)
89
-          if(input$maxSz == 0) {
90
-            varMaxsz <- Inf
91
-          }else {
92
-            varMaxsz <- input$maxSz
93
-          }
94
-          success <- TRUE
95
-        }
96
-      }
97
-      else
98
-      {
99
-        #User selects matrix file and geneset var
100
-        inFile <- input$matrixFile
101
-        newY <- as.matrix(read.csv(inFile$datapath, header = TRUE, sep = ",")) #Reading file as matrix
102
-        rownames(newY) <- newY[,1] #Taking the first column as rownames
103
-        newY <- newY[,-1] #Deleting the first column
104
-        assign("genes",get(input$genesetVar))
105
-        if(input$maxSz == 0) {
106
-          varMaxsz <- Inf
107
-        }else {
108
-          varMaxsz <- input$maxSz
109
-        }
110
-        success <- TRUE
111
-      }
14
+  # ENABLING 'RUN' BTN
15
+  observe({
16
+    if(!is.null(matrix()) && !is.null(genesets())){
17
+      enable("button")
18
+    } else {
19
+      disable("button")
112 20
     }
113
-  }
114
-  else
115
-  {
116
-    #User selects matrix var and geneset file
117
-    if(input$genesetSourceType == "fileGeneset")
118
-    {
119
-      if (is.null(input$genesetFile))
120
-      {
121
-        paste("No geneSet file selected!")
122
-        success <- FALSE
123
-      }
124
-      else
125
-      {
126
-        assign("newY",get(input$matrixVar))
127
-        inGenesetFile <- input$genesetFile
128
-        genes <- getGmt(inGenesetFile$datapath)
129
-        if(input$maxSz == 0) {
130
-          varMaxsz <- Inf
131
-        }else {
132
-          varMaxsz <- input$maxSz
133
-        }
134
-        success <- TRUE
135
-      }
136
-    }
137
-    else
138
-    {
139
-      #User selects matrix var selected and geneset var
140
-      assign("newY",get(input$matrixVar))
141
-      assign("genes",get(input$genesetVar))
142
-      if(input$maxSz == 0) {
143
-        varMaxsz <- Inf
144
-      }else {
145
-        varMaxsz <- input$maxSz
146
-      }
147
-      success <- TRUE
148
-    }
149
-  }
150
-  if(success==TRUE)
151
-  {
152
-    gsva_generation(input, output, session, newY, genes,varMaxsz)
153
-    gsva_information(input,output,session, newY, genes)
154
-  }
155
-}
21
+  })
22
+  
23
+  ### INPUTS ###
24
+  
25
+  # DATA MATRIX
26
+  matrix <- matrixServer("matrix1")
27
+  
28
+  # GENES
29
+  genesets <- geneSetsServer("genes1")
30
+  
31
+  # ARGUMENTS
32
+  argInp <- argumentsDataServer("argumentsInput")
156 33
 
157
-gsva_generation <- function(input, output, session, newY, genes,varMaxsz) {
158
-  x <- input$method
159
-  selectedTau <- NULL
160
-  switch (x,
161
-          "gsva" = {
162
-            selectedTau <- input$tau1
163
-          },
164
-          "ssgsea" = {
165
-            selectedTau <- input$tau2
166
-          },
167
-          "zscore" = {
168
-            selectedTau <- NULL
169
-          },
170
-          "plage" = {
171
-            selectedTau <- NULL
172
-          }
173
-  )
174
-  # GSVA Generation
175
-  withProgress(message = 'Runing GSVA', value = 0, {
176
-    incProgress(1, detail = "This may take a while...")
177
-    generated_gsva <<- gsva(newY, genes, method=input$method, kcdf=input$kcdf,
178
-                            abs.ranking=as.logical(input$absRanking),
179
-                            min.sz=input$minSz, max.sz=varMaxsz,
180
-                            parallel.sz=1L, ## by now, disable parallelism
181
-                            mx.diff=as.logical(input$mxDiff),
182
-                            tau=selectedTau,
183
-                            ssgsea.norm=as.logical(input$ssgseaNorm),
184
-                            verbose=as.logical(input$verbose))
34
+  #### GSVA RESULTS ####
35
+  
36
+  rv <- reactiveValues(gs=NULL, dat.t=NULL, n=NULL, dd.col=NULL, p=NULL, 
37
+                       errors.gsva = NULL, matrix=NULL, genesets=NULL)
38
+  gsva.cancel <- reactiveVal(FALSE)
39
+  
40
+  observeEvent( input$button, {
41
+    rv$gs <- NULL
42
+    rv$dat.t <- NULL
43
+    rv$p <- NULL
44
+    rv$errors.gsva = NULL
45
+    rv$matrix <- isolate(matrix())
46
+    rv$genesets <- isolate(genesets())
47
+    gsva.cancel(FALSE)
48
+    modalGSVAUI("modal.text")
49
+    # future() cannot take reactive values, so we must isolate() them
50
+    future({
51
+      sink(rout)
52
+      result <- gsva(isolate(matrix()),
53
+                     isolate(genesets()), 
54
+                     method=isolate(argInp$method()),
55
+                     kcdf=isolate(argInp$kcdf()),
56
+                     abs.ranking=isolate(argInp$absRanking()),
57
+                     min.sz= isolate(argInp$varMinsz()),
58
+                     max.sz=isolate(argInp$varMaxsz()),
59
+                     parallel.sz=1L, ## by now, disable parallelism
60
+                     mx.diff=isolate(argInp$mxDiff()),
61
+                     tau=isolate(argInp$selectedTau()),
62
+                     ssgsea.norm=isolate(argInp$ssgseaNorm()),
63
+                     verbose=TRUE)
64
+      sink()
65
+      write("", file=rout)
66
+      return(result)
67
+    }, seed = TRUE) %...>%
68
+      (function(result){
69
+        rv$gs <- result
70
+        rv$dat.t <- melt(as.data.table(rv$gs, keep.rownames = "gene.sets"),
71
+                         variable.name = "Sample", id.vars="gene.sets")
72
+        rv$n <- length(levels(rv$dat.t$Sample))
73
+        rv$dd.col <- hcl(h = seq(15, 375, length=rv$n), l = 65, c = 100)[1:rv$n]
74
+        names(rv$dd.col)  <- levels(rv$dat.t$Sample)
75
+        write("", file=rout)
76
+        removeModal()
77
+      }) %...!%
78
+      (function(error){
79
+        removeModal()
80
+        write("", file=rout)
81
+        if(gsva.cancel()){
82
+          rv$errors.gsva <- NULL
83
+        } else {
84
+          rv$errors.gsva <- as.character(error)
85
+        }
86
+        
87
+      })
88
+    NULL
185 89
   })
90
+  
91
+  # PRINTING CONSOLE.TEXT
92
+  modalGSVAServer("modal.text", console.text, gsva.cancel)
93
+  
94
+  # PLOT1 RENDER
95
+  plot1_Server("plot1", rv)
186 96
 
187
-}
188 97
 
189
-gsva_information <- function(input, output, session, newY, genes) {
190
-  gsva_es <- NA
191
-  if("matrix" %in% class(generated_gsva))
192
-    gsva_es <- as.data.frame(generated_gsva)
193
-  else if ("ExpressionSet" %in% class(generated_gsva))
194
-    gsva_es <- as.data.frame(exprs(generated_gsva))
195
-  else if ("SummarizedExperiment" %in% class(generated_gsva))
196
-    gsva_es <- as.data.frame(assays(generated_gsva)[[1]])
197
-  else
198
-    stop("Unknown output generated by the call to the 'gsva()' function.")
98
+  # PLOT2 RENDER
99
+  eventData1 <- reactive({
100
+    req(rv$dat.t)
101
+    ind <- event_data("plotly_click", source = "click1")
102
+    ind <- ind$curveNumber+1
103
+  })
104
+  plot2_Server("plot2", eventData1, rv)
105
+  
106
+  
107
+  # PLOT3 RENDER
108
+  eventData2 <- reactive({
109
+    req(rv$p2)
110
+    ind <- event_data("plotly_click", source = "click2")
111
+    ind <- ind$pointNumber+1
112
+  })
113
+  plot3_Server("plot3", eventData2, rv, rv$matrix, rv$genesets)
114
+
115
+  # SAVE & CLOSE BTN
116
+  observeEvent(input$closeSave, {
117
+    stopApp(rv$gs) #Stops the app and returns the rv$gs object to the R session
118
+  })
119
+  
120
+  # DWN BTN
121
+  downloadServer("download", rv$gs)
199 122
 
200
-  #Rendering text1
123
+  
124
+  # TEXT1
201 125
   output$text1 <- renderUI({
126
+    req(rv$gs)
202 127
     HTML(paste("<br/>", "\t To see the Empirical Cumulative Distribution Function 
203 128
     of a Sample, click on its line in this plot and go
204 129
       to the 'Gene.Set' Panel", "<br/>", sep="<br/>"))
205 130
   })
206 131
   
207
-  # Rendering graph1
208
-  dat.t <- melt(as.data.table(generated_gsva, keep.rownames = "gene.sets"), 
209
-                variable.name = "Sample", id.vars="gene.sets")
210
-  n <- length(levels(dat.t$Sample))
211
-  dd.col <- hcl(h = seq(15, 375, length=n), l = 65, c = 100)[1:n]
212
-  names(dd.col)  <- levels(dat.t$Sample)
213
-  
214
-  
215
-  output$plot <- renderPlotly({
216
-    p <- ggplot(data = dat.t, aes(x=value, color=Sample)) +
217
-      stat_density(geom="line", position = "identity") +
218
-      theme(legend.position = "none") + labs(x="GSVA Scores", y="Density") +
219
-      scale_color_manual("Legend", values = dd.col)
220
-    ggplotly(p, tooltip = "Sample", source = "click1")
132
+  # TABLE
133
+  output$result <- renderTable({
134
+    req(rv$gs)
135
+    resultInformation <- data.frame("Nr of gene sets" = nrow(rv$gs),
136
+                                    "Nr of samples" = ncol(rv$gs))
137
+    resultInformation
221 138
   })
222 139
   
223
-  # Rendering table
224
-  resultInformation <- matrix(data = c(nrow(generated_gsva),
225
-                                       ncol(generated_gsva)),
226
-                              nrow = 1, ncol = 2)
227
-  colnames(resultInformation) <- c("Nr. of gene sets", "Nr. of samples")
228
-  output$result <- renderTable(resultInformation)
229
-  
230
-  #Rendering text2
140
+  # TEXT2
231 141
   output$text2 <- renderUI({
232
-    title1 <- sample.c()
142
+    title1 <- rv$sample.c
233 143
     h2(tags$b(title1), align ="center")
234 144
   })
235 145
   
236
-  #Rendering text3
146
+  # TEXT3
237 147
   output$text3 <- renderUI({
238 148
     HTML(paste("<br/>", "\t To see the Kernel Density Estimation of genes of 
239 149
     any given Gene Set in this Sample,  click on any point in this plot and a
240 150
     second plot will appear bellow it", "<br/>", sep="<br/>"))
241 151
   })
242 152
   
243
-  #Rendering graph2
244
-  eventData1 <- reactive({
245
-    event_data("plotly_click", source = "click1")
246
-  })
247
-  
248
-  sample.c <- reactive({
249
-    req(eventData1())
250
-    ind <- eventData1()$curveNumber+1
251
-    colnames(generated_gsva)[ind]
252
-  })
253
-  
254
-  plot2 <- reactive({
255
-    req(sample.c())
256
-    data <- dat.t[Sample==sample.c()]
257
-    p <- ggplot(data = data, aes(x=value, color=Sample)) +
258
-      stat_ecdf(geom="point") + theme(legend.position = "none") + 
259
-      labs(x="GSVA Scores in selected sample", y="Empirical Cumulative Density") +
260
-      scale_color_manual("Legend", values = dd.col)
261
-    p <- ggplotly(p, source="click2") %>% style(text=data$gene.sets)
262
-  })
263
-  
264
-  output$plot2 <- renderPlotly({
265
-    req(plot2())
266
-    plot2()
267
-  })
268
-  
269
-  # Rendering graph 3
270
-  eventData2 <- reactive({
271
-    event_data("plotly_click", source = "click2")
272
-  })
273
-  
274
-  gene.set <- reactive({
275
-    plot2()$x$data[[1]]$text[eventData2()$pointNumber+1]
276
-  })
277
-  
278
-  output$plot3 <- renderPlotly({
279
-    req(eventData2())
280
-    genes.toplot <- geneIds(genes)[[gene.set()]]
281
-    mt <- match(genes.toplot, rownames(newY))
282
-    x <-  newY[na.omit(mt), sample.c()]
283
-    df <- as.data.frame(x)
284
-    df$x <- as.numeric(df$x)
285
-    df$Gene <- rownames(df)
286
-    df$Sample <- sample.c()
287
-    p1 <- ggplot(data = df, aes(x=x, color = Sample, label = Gene)) +
288
-      stat_density(geom="line", position = "identity") +
289
-      geom_rug() + theme(legend.position = "none") + 
290
-      labs(x="Gene Expressions in selected sample", y="Density") +
291
-      xlim(as.numeric(range(newY))) +
292
-      scale_color_manual("legend", values= dd.col)
293
-    ggplotly(p1, tooltip = c("Gene", "x")) %>% style(hoverinfo="none", traces = 1) %>%
294
-      layout(title = list(text = paste0('<br><sup><i>', gene.set(), '</i></sup>'),
295
-                          font = list(size=15)))
296
-  })
297
-  
298
-  # Rendering Session Info
153
+  # SESSION INFO
299 154
   output$sessionInfo <- renderPrint({
300 155
     sessionInfo()
301 156
   })
302
-  
303
-  tagList(
304
-    downloadButton('downloadData', 'Download'),
305
-    actionButton('closeSave','Save & Close')
306
-  )
307
-}
308 157
 
309
-download_handler <- function(input, output, session) {
310
-  #Controls the Download button
311
-  output$downloadData <- downloadHandler(
312
-    filename = function() {
313
-      paste("gsva_es-", Sys.Date(), ".csv", sep="")
314
-    },
315
-    content = function(file) {
316
-      if("matrix" %in% class(generated_gsva)) # if the whole object is a matrix
317
-      {
318
-        dataFrameObs <- as.data.frame(generated_gsva)
319
-        write.csv(dataFrameObs, file)
320
-      }
321
-      else
322
-      {
323
-        if("ExpressionSet" %in% class(generated_gsva)) #If the generated gsva result object is an ExpressionSet
324
-        {
325
-          expressionSetObs <- exprs(generated_gsva)
326
-          dataFrameObs <- as.data.frame(expressionSetObs)
327
-          write.csv(dataFrameObs, file)
328
-        }
329
-        else
330
-        {
331
-          dataFrameObs <- as.data.frame(generated_gsva)
332
-          write.csv(dataFrameObs, file)
333
-        } 
334
-      }
335
-    }
336
-  )
337
-}
338
-
339
-function(input, output, session) {
340
- v <- reactiveValues(action = FALSE)
341
-  
342
-  observeEvent(input$button, {
343
-    v$action <- input$button
344
-  })
345
-  
346
-  output$download <- renderUI({
347
-    if(v$action)
348
-    {
349
-      #Isolates the Run event, that allows the program to run the generation only if the user clicks the button.
350
-      isolate({
351
-        gsva_validation(input,output,session)
352
-      })
353
-    }
354
-  })
355
-  download_handler(input,output,session)
356
-  
357
-  #Observe the Save & Close button
358
-  observeEvent(input$closeSave, {
359
-    stopApp(generated_gsva) #Stops the app and returns the generated_gsva object
360
-  })
361 158
 }
362 159
new file mode 100644
... ...
@@ -0,0 +1,3 @@
1
+library(shinytest)
2
+shinytest::testApp("../")
3
+
0 4
new file mode 100644
... ...
@@ -0,0 +1,11 @@
1
+app <- ShinyDriver$new("../../", loadTimeout = 1e+05)
2
+app$snapshotInit("test1")
3
+
4
+app$uploadFile(`matrix1-matrixFile` = "leukemia (1).txt") # <-- This should be the path to the file, relative to the app's tests/shinytest directory
5
+app$uploadFile(`genes1-genesetFile` = "c2.all.v7.0.symbols (1).gmt") # <-- This should be the path to the file, relative to the app's tests/shinytest directory
6
+app$setInputs(button = "click")
7
+app$setInputs(`modal.text-cancel` = "click")
8
+app$setInputs(arg = "yes")
9
+app$setInputs(`argumentsInput-minSz` = 450)
10
+app$setInputs(button = "click")
11
+app$snapshot()
... ...
@@ -1,147 +1,88 @@
1
-library(shiny)
2
-library(shinythemes)
3
-library(plotly)
4
-
5
-selectDataInput <- function(id) {
6
-  # Create a namespace function using the provided id
7
-  ns <- NS(id)
8
-  
9
-  #UI declaration
10
-  column(
11
-    3,
12
-    h3("Data input:"),
13
-    #Select data source
14
-    wellPanel(fluidRow(
15
-      column(
16
-        12,
17
-        #Select expression data matrix
18
-        radioButtons("matrixSourceType", "Select expression data matrix:",
19
-                     c("From file" = "fileMatrix",
20
-                       "From workspace" = "varMatrix"))
21
-        ,
22
-        #If the selected data source is a file
23
-        conditionalPanel(
24
-          condition = "input.matrixSourceType == 'fileMatrix'",
25
-          fileInput("matrixFile", "Choose matrix file:",
26
-                    accept = c(
27
-                      "text/csv",
28
-                      "text/comma-separated-values,text/plain",
29
-                      ".csv",".ods",".xls",".xlt")
30
-          )
31
-        ),
32
-        #If the selected data source is a workspace object
33
-        conditionalPanel(
34
-          condition = "input.matrixSourceType == 'varMatrix'",
35
-          selectInput("matrixVar", "Choose matrix var:",
36
-                      ls(envir=.GlobalEnv))
37
-        ),
38
-        fluidRow(column(12,
39
-                        HTML("<br>"))),
40
-        #Select geneset
41
-        radioButtons("genesetSourceType", "Select gene sets:",
42
-                     c("From file" = "fileGeneset",
43
-                       "From workspace" = "varGeneset"))
44
-        ,
45
-        #If the selected data source is a file
46
-        conditionalPanel(
47
-          condition = "input.genesetSourceType == 'fileGeneset'",
48
-          fileInput("genesetFile", "Choose GeneSet file:",
49
-                    accept = ".gmt")
50
-        ),
51
-        #If the selected data source is a workspace object
52
-        conditionalPanel(
53
-          condition = "input.genesetSourceType == 'varGeneset'",
54
-          selectInput("genesetVar", "Choose GeneSet var:",
55
-                      ls(envir=.GlobalEnv))
56
-        ),
57
-        HTML("<br>"),
58
-        radioButtons("arg", "Change default settings:",
59
-                     c("No" = "no",
60
-                       "Yes" = "yes"))
61
-      )
62
-    ),
63
-    actionButton("button", "Run"))
64
-  )
65
-}
66
-
67
-mainDataInput <- function(id) {
68
-  # Create a namespace function using the provided id
69
-  ns <- NS(id)
70
-  
71
-  #UI Definition
72
-  mainPanel( width = 6,
73
-            tabsetPanel(type="tabs",
74
-                        tabPanel("Samples",
75
-                                 htmlOutput("text1"),
76
-                                 plotlyOutput("plot"),
77
-                                 tableOutput("result"),
78
-                                 uiOutput("download")),
79
-                        tabPanel("Gene Sets",
80
-                                 uiOutput("text2"),
81
-                                 htmlOutput("text3"),
82
-                                 plotlyOutput("plot2"),
83
-                                 plotlyOutput("plot3")),
84
-                        tabPanel("Session Info",
85
-                                 verbatimTextOutput("sessionInfo"))
86
-                                 )
87
-            )
88
-}
89
-
90
-argumentsDataInput <- function(id) {
91
-  # Create a namespace function using the provided id
92
-  ns <- NS(id)
1
+fluidPage( 
2
+  theme = shinytheme("spacelab"),
3
+  shinyjs::useShinyjs(),
4
+  add_busy_spinner(spin = "double-bounce", position = "bottom-right", height = "100px", width = "100px"),
5
+  tags$head(
6
+    tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
7
+  ),
8
+  titlePanel(
9
+    fluidRow(
10
+      column(6,
11
+             h2("GSVA Shiny App", align="left")),
12
+      column(6,
13
+             tags$img(src="GSVA.png", align="right", height=75, width=75))
14
+    ), windowTitle="GSVA"),
93 15
   
94
-  #UI Definition
95
-  column(
96
-    3,
97
-    conditionalPanel(
98
-      condition = "input.arg == 'yes'",
99
-      h3("Parameters:"),
16
+  fluidRow(
17
+    column(
18
+      width=3,
19
+      h3("Data input"),
20
+      #Select data source
100 21
       wellPanel(fluidRow(
101 22
         column(
102 23
           12,
103
-          selectInput("method", "Choose method:",
104
-                      c("gsva","ssgsea","zscore","plage")),
105
-          selectInput("kcdf", "Choose kcdf:",
106
-                      c("Gaussian","Poisson","none")),
107
-          radioButtons("absRanking", "abs.ranking:",
108
-                       c("False" = FALSE,
109
-                         "True" = TRUE)),
110
-          numericInput("minSz","min.sz:",value = 1),
111
-          numericInput("maxSz","max.sz (Write 0 for infinite):",value = 0),
112
-          radioButtons("mxDiff", "mx.diff:",
113
-                       c("True" = TRUE,
114
-                         "False" = FALSE)),
115
-          conditionalPanel(
116
-            condition = "input.method == 'gsva'",
117
-            numericInput("tau1","tau:",value = 1)
118
-          ),
119
-          conditionalPanel(
120
-            condition = "input.method == 'ssgsea'",
121
-            numericInput("tau2","tau:",value = 0.25),
122
-            radioButtons("ssgseaNorm", "ssgsea.norm:",
123
-                         c("True" = TRUE,
124
-                           "False" = FALSE)),
125
-          ),
126
-          radioButtons("verbose", "verbose:",
127
-                       c("True" = TRUE,
128
-                         "False" = FALSE))
129
-        )))
130
-    )
24
+          matrixUI("matrix1"),
25
+          fluidRow(column(12,
26
+                          HTML("<br>"))),
27
+          geneSetsUI("genes1"),
28
+          HTML("<br>"),
29
+          radioButtons("arg", "Change default settings:",
30
+                       c("No" = "no",
31
+                         "Yes" = "yes")),
32
+          actionButton("button", "Run"))
33
+      ))
34
+    ),
35
+    mainPanel(width=6,
36
+              tabsetPanel(type="tabs",
37
+                          tabPanel("Samples",
38
+                                   textOutput("errorsGsva"),
39
+                                   htmlOutput("text1"),
40
+                                   plot1_UI("plot1"),
41
+                                   tableOutput("result"),
42
+                                   downloadUI("download")),
43
+                          tabPanel("Gene Sets",
44
+                                   uiOutput("text2"),
45
+                                   htmlOutput("text3"),
46
+                                   plot2_UI("plot2"),
47
+                                   plot3_UI("plot3")
48
+                                   ),
49
+                          tabPanel("Session Info",
50
+                                   verbatimTextOutput("sessionInfo"))
51
+              )
52
+    ),
53
+    argumentsDataUI("argumentsInput")
54
+    # column(
55
+    #   width=3,
56
+    #   conditionalPanel(
57
+    #     condition = "input.arg == 'yes'",
58
+    #     h3("Parameters"),
59
+    #     wellPanel(fluidRow(
60
+    #       column(
61
+    #         12,
62
+    #         selectInput("method", "Choose method:",
63
+    #                     c("gsva","ssgsea","zscore","plage")),
64
+    #         selectInput("kcdf", "Choose kcdf:",
65
+    #                     c("Gaussian","Poisson","none")),
66
+    #         radioButtons("absRanking", "abs.ranking:",
67
+    #                      c("False" = FALSE,
68
+    #                        "True" = TRUE)),
69
+    #         numericInput("minSz","min.sz:",value = 1),
70
+    #         numericInput("maxSz","max.sz (Write 0 for infinite):",value = 0),
71
+    #         radioButtons("mxDiff", "mx.diff:",
72
+    #                      c("True" = TRUE,
73
+    #                        "False" = FALSE)),
74
+    #         conditionalPanel(
75
+    #           condition = "input.method == 'gsva'", 
76
+    #           numericInput("tau1","tau:",value = 1)
77
+    #         ),
78
+    #         conditionalPanel(
79
+    #           condition = "input.method == 'ssgsea'",
80
+    #           numericInput("tau2","tau:",value = 0.25),
81
+    #           radioButtons("ssgseaNorm", "ssgsea.norm:",
82
+    #                        c("True" = TRUE,
83
+    #                          "False" = FALSE)))
84
+    #       )))
85
+    #   )
86
+    # )
131 87
   )
132
-}
133
-
134
-fluidPage(
135
-  theme = shinytheme("spacelab"),	
136
-  tags$head(
137
-    tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
138
-  ),
139
-  titlePanel(div(h2("GSVA WebApp", align="left"),
140
-             tags$img(src="GSVA.png", align="center", height=75, width=75)),
141
-             windowTitle="GSVA"),
142
-	fluidRow(
143
-	  selectDataInput("dataInput"),
144
-	  mainDataInput("mainInput"),
145
-	  argumentsDataInput("argumentsInput")
146
-	)
147 88
 )
... ...
@@ -1,5 +1,4 @@
1
-.shiny-output-error-validation {
2
-	font-size: 16px;
3
-	font-weight: bold;
4
-	color: green;
5
-      }
6 1
\ No newline at end of file
2
+#errorsGsva{color: red;
3
+font-size: 20px;
4
+font-weight: bold;
5
+}
7 6
\ No newline at end of file