1. GSVA
  2. Commit f2b69b6111cf6c1d290cc3e47a342537897d9137
Browse code

modules in shinyApp

pablo-rodr-bio2 authored on 12/04/2021 19:41:34
Showing 13 changed files
DESCRIPTION
History View file @ f2b69b6
... ... 
@@ -1,5 +1,5 @@
1 1 
 Package: GSVA
2 
-Version: 1.39.22
2 
+Version: 1.39.23
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"),
... ... 
@@ -12,7 +12,7 @@ Imports: methods, stats, utils, graphics, S4Vectors, IRanges,
12 12 
          DelayedMatrixStats, HDF5Array, BiocSingular
13 13 
 Suggests: BiocGenerics, RUnit, BiocStyle, knitr, markdown, limma, RColorBrewer,
14 14 
           genefilter, edgeR, GSVAdata, shiny, shinythemes, ggplot2, data.table,
15 
-          plotly
15 
+          plotly, shinyjs, future, promises, shinybusy
16 16 
 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 17 
 License: GPL (>= 2)
18 18 
 VignetteBuilder: knitr
inst/shinyApp/argumentsDataModule.R
History View file @ f2b69b6
19 19 
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
inst/shinyApp/downloadModule.R
History View file @ f2b69b6
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
inst/shinyApp/geneSetsModule.R
History View file @ f2b69b6
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
inst/shinyApp/global.R
History View file @ f2b69b6
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
inst/shinyApp/matrixModule.R
History View file @ f2b69b6
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
inst/shinyApp/modalGSVAModule.R
History View file @ f2b69b6
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
inst/shinyApp/plot1_Module.R
History View file @ f2b69b6
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
inst/shinyApp/plot2_Module.R
History View file @ f2b69b6
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
inst/shinyApp/plot3_Module.R
History View file @ f2b69b6
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
inst/shinyApp/server.R
History View file @ f2b69b6
... ... 
@@ -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 
 }
inst/shinyApp/ui.R
History View file @ f2b69b6
... ... 
@@ -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 
 )
inst/shinyApp/www/style.css
History View file @ f2b69b6
... ... 
@@ -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