app.R 66.1 KB
Newer Older
1
# Load packages --------
2
3
library(shiny)
library(shinythemes)
4
5
library(Seurat)
library(dplyr)
6
7
library(ggplot2)
library(viridis)
8
9
library(stringr)
library(plotly)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
10
library(BiocManager)
11
library(shinydashboard)
12
library(shinyjs)
13
library(DT)              
14
library(RColorBrewer) 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
15
library(MAST)     
16
library(data.table)
17
library(clusterProfiler)
18
library(org.Hs.eg.db) 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
19
library(tools)
20
library(PANTHER.db)
Bagueneau Mathias's avatar
update    
Bagueneau Mathias committed
21
library(topGO)
22

23
24
25

### ----------------------------- User interface -----------------------------------------------------

26
27
28
29
30
31
## HEADER --------
useShinyjs()
header <- dashboardHeader(tags$li(class="dropdown",
                                  conditionalPanel(condition="input.tabs == 'visu_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Visualization -")), 
                                  conditionalPanel(condition="input.tabs == 'heatmap_item'",
32
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Heatmap -")),
33
34
35
36
37
38
                                  conditionalPanel(condition="input.tabs == 'genes_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Genes -")),
                                  conditionalPanel(condition="input.tabs == 'compare_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Compare -")),
                                  conditionalPanel(condition="input.tabs == 'pipeline_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Pipeline -")),
39
40
                                  conditionalPanel(condition="input.tabs == 'grid_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","- Grid -")),
41
42
43
44
45
46
47
                                  tags$head(HTML("<link rel='icon' href='min.png'>"))
))
anchor <- tags$a(tags$img(src='logo.png', height='30', width='20'),'Shiny SChnurR', style="color: white")
header$children[[2]]$children <- tags$div(tags$head(tags$style(HTML(".name { background-color:  transparent } .content-wrapper, .right-side {background-color: white}"))),anchor)    
header[["children"]][[2]][["children"]][["name"]] <- "Shiny SChnurR"

## SIDEBAR --------
48
sidebar <- dashboardSidebar(
49
50
51
52
  tags$style(type="text/css",
             ".shiny-output-error { visibility: hidden; }",
             ".shiny-output-error:before { visibility: hidden; }"
  ),
53
  br(),
54
  # Menu -------
55
56
  sidebarMenu(id="tabs",
              menuItem("Visualization", tabName="visu_item", icon=icon("area-chart"), selected = TRUE),
57
              menuItem("Heatmap", tabName = "heatmap_item", icon=icon("fas fa-align-justify")),
58
59
              menuItem("Genes", tabName = "genes_item", icon=icon("dna")),
              menuItem("Compare", tabName="compare_item", icon = icon("table")),
60
              menuItem("Grid", tabName="grid_item", icon = icon("fas fa-th")),
61
              menuItem("Pipeline", tabName="pipeline_item", icon = icon("fas fa-bezier-curve")),
62
              menuItem("About", tabName = "about_item", icon = icon("far fa-id-card"))
63
64
  ),
  br(),
65
  # Genes Panel --------
66
  conditionalPanel(condition="input.tabs=='genes_item'",align="center",
67
68
                   fluidRow(
                     column(1),
69
70
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help2", "", icon = icon("far fa-question-circle")), align="center"),
71
                            verbatimTextOutput(outputId = "no_file2"), 
72
73
                            conditionalPanel(condition= "output.fileUploaded",align="center",
                                             uiOutput("fchoice4"), br(),
74
75
                                             uiOutput("group"), br(),
                                             radioButtons("gographtype", label="Choose a graph type :", choices=c("Dotplot"="dplot", "Barplot"="bplot", "Emapplot" = "eplot")), br(),
76
                                             radioButtons("ontology", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")), br(),
77
                                             textOutput("genesstatut"),
78
                                             actionButton("gogo", icon = icon("far fa-arrow-alt-circle-right"), label="Ontology")
79
80
81
                            )
                     )
                   )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
82
  ),
83
  # About Panel --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
84
85
86
  conditionalPanel(condition="input.tabs=='about_item'",
                   fluidRow(
                     column(1),
87
                     column(10, tags$img(src='logo.png', height='300', width='175')
Bagueneau Mathias's avatar
Bagueneau Mathias committed
88
89
                     )
                   )
90
  ),
91
  # Compare Panel --------
92
  conditionalPanel(condition="input.tabs=='compare_item'", align="center",
93
94
95
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
96
97
                            div(actionLink("help3", "", icon = icon("far fa-question-circle")), align="center"),
                            verbatimTextOutput(outputId = "no_file3"),
98
                            conditionalPanel(condition= "output.fileUploaded",align="center",
99
100
                                             radioButtons(inputId="choice_compare", label= "Compare :", c("Factors" = "f_compare", "Features" = "features_compare"), selected = "f_compare"),
                                             conditionalPanel(condition = "input.choice_compare == 'features_compare'",
101
102
103
104
105
                                                              uiOutput("featurechoice2"),
                                                              conditionalPanel(condition ="input.featuresel2 == 'g2'",
                                                                               selectizeInput(inputId="genes2", label="Choose a gene :", choices ="")),
                                                              conditionalPanel(condition ="input.featuresel2 == 'd2'",
                                                                               uiOutput("nchoice2"))),
106
                                             radioButtons(inputId="graph_compare", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"), selected = "umap"),
107
                                             sliderInput(inputId="ptsize_compare", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
108
                                             conditionalPanel(condition = "input.choice_compare == 'f_compare'",
109
                                                              checkboxInput(inputId="show_clusters_compare", label="Clusters information", value=FALSE)
110
                                             ),
111
                                             radioButtons("ontology2", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC"))
112
                            )
113
114
115
                     )
                   )
  ),
116
  # Heatmap Panel --------
117
118
119
120
121
122
123
124
125
  conditionalPanel(condition="input.tabs=='heatmap_item'", align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help4", "", icon = icon("far fa-question-circle")), align="center"),
                            verbatimTextOutput(outputId = "no_file4"),
                            conditionalPanel(condition= "output.fileUploaded",align="center",
                                             uiOutput("fchoice3"), br(),
                                             uiOutput("heat_numb"), br(),
126
                                             textOutput("heatmapstatut"),
127
                                             actionButton("goheatmap", icon = icon("far fa-arrow-alt-circle-right"), label="Compute Heatmap")
128
                            )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
129
                     )
130
131
132
                   )
  ),
  # Visu Panel --------
133
134
135
136
137
  conditionalPanel(condition="input.tabs=='visu_item'",
                   fluidRow(
                     column(1),
                     column(10,
                            h4(align="center", "Control Panel"), 
138
                            div(actionLink("help1", "", icon = icon("far fa-question-circle")), align="center"),
139
                            fileInput(inputId="file1", label="Upload your *.rds file :", accept = ".rds", placeholder=""),
140
                            uiOutput("selectfile"),
141
                            conditionalPanel(condition= "output.fileUploaded", align="center",
142
                                             radioButtons(inputId="graph", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"), selected = "umap"),
143
                                             checkboxInput(inputId="show_clusters", label="Clusters information", value=FALSE),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
144
                                             sliderInput(inputId="ptsize", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE)
145
146
147
                            )
                     )
                   )
148
149
150
151
152
153
154
155
156
157
  ),

  # Grid Panel --------
  conditionalPanel(condition="input.tabs=='grid_item'", align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help5", "", icon = icon("far fa-question-circle")), align="center"),
                            verbatimTextOutput(outputId = "no_file5"),
                            conditionalPanel(condition= "output.fileUploaded",align="center",
158
                                             radioButtons(inputId="graph_grid", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"), selected = "umap"),
159
160
                                             sliderInput(inputId="ptsize_grid", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE),
                                             hr(),
161
162
                                             selectizeInput(inputId="listminigenes", label="Choose a gene :", choices ="", multiple = TRUE), br(),
                                             uiOutput("dlgrid")
163
164
165
                            )
                     )
                   )
166
167
  )
)
168

169
## BODY --------
170
171
172
173
body <- dashboardBody(
  tabItems(
    
    # Visualize Item --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
174
    tabItem(tabName="visu_item", align="center", 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
175
            conditionalPanel(condition="output.fileUploaded", 
176
177
178
179
180
181
                             br(),
                             htmlOutput(outputId = "information"),
                             br(),
                             uiOutput(outputId = "clusters_infos"),
                             verbatimTextOutput(outputId = "select_infos"),  
                             br(),
182
                             fluidRow(column(align="center", width = 6, plotlyOutput("plot_factors", width='500px', height='500px'), uiOutput("fchoice"),downloadButton("dlleftplot", label="Export Graph")),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
183
                                      column(align="center", width = 6, plotlyOutput("plot_numerics", width='500px', height='500px'),uiOutput("featurechoice"), uiOutput("nchoice"), 
184
                                             conditionalPanel(condition ="input.featuresel == 'g'", selectizeInput(inputId="genes", label="Choose a gene :", choices ="")),downloadButton("dlrightplot", label="Export Graph"))#  br(), verbatimTextOutput(outputId="genes_analyse"))
185
                             ), 
186
187
188
189
190
                             hr(),
                             br(),
                             dataTableOutput("markers_table"),
                             uiOutput(align="left","dlmarkbutton_visu")
                             
191
192
            )         
    ),
193
    
194
    # Heatmap Item --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
195
196
197
    tabItem(tabName="heatmap_item", align="center",
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
198
                             plotOutput("heatmap", height = 850),
199
200
                             br(), 
                             uiOutput(align="left","dlheat")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
201
202
203
                             
            )
    ),
204
    # Genes Item --------
205
    tabItem(tabName="genes_item", align="left",
206
207
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
208
                             fluidRow(column(align="center", width = 6, plotOutput("goplot", height = 600),uiOutput(align="left","dlgenegraph")),
209
                                      column(align="center", width = 6, dataTableOutput("dtgenes"),uiOutput(align="left","dlgenedt"))),
210
211
212
213
                             br(), hr(),
                             br(),
                             dataTableOutput("dtonto"),
                             uiOutput(align="left","dlontodt")
214
            )
215
    ),
216
    
217
    # Compare Item --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
218
    tabItem(tabName="compare_item", align="center", 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
219
            br(),
220
            uiOutput(outputId="compare_helptext"),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
221
222
            verbatimTextOutput(outputId = "select_infos_compare"),  
            uiOutput(outputId = "clusters_infos_compare"),
223
            br(),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
224
            conditionalPanel(condition="output.fileUploaded",
225
226
227
                             fluidRow(column(align="center", width = 2, plotOutput(outputId="miniplot_compare", width="225px", height="225px"), br(), plotOutput(outputId="miniplot_compare2", width="225px", height="225px"), br(), br(), uiOutput("fchoice2"), div(actionLink("add", "", icon = icon("far fa-plus-square")), align="center"), uiOutput("addf"), br(), actionButton("gographs", icon = icon("far fa-arrow-alt-circle-right"), label="Compute Graphs"), align="left", textOutput("comparestatutgraphs")),
                                      column(align="center", width = 5, plotlyOutput("plot1_compare", width="490px", height="490px"), br(), uiOutput("plot1_library"), br(), uiOutput("addg1"), br(), downloadButton("dl_compare1", label="Export Graph"), downloadButton("dl_comparebarcodes1", label="Export barcodes"), br(), downloadButton("export_compare1", label="Export into Seurat object")),
                                      column(align="center", width = 5, plotlyOutput("plot2_compare", width="490px", height="490px"), br(), uiOutput("plot2_library"), br(), uiOutput("addg2"), br(), downloadButton("dl_compare2", label="Export Graph"), downloadButton("dl_comparebarcodes2", label="Export barcodes"), br(), downloadButton("export_compare2", label="Export into Seurat object"))
228
                             ),
229
                             hr(),
230
                             br(), 
231
                             uiOutput(align="left","markbutton"), align="left", textOutput("comparestatutmarkers"), br(), uiOutput(align="left","dlmarkbutton_compare"), br(), 
232
                             dataTableOutput("markers_compare"),
233
                             hr(),
234
                             br(),
235
                             uiOutput(align="left","ontobutton"), textOutput("comparestatutonto"), br(),
236
237
                             fluidRow(column(align="center",width=6, column(align="center", width=2, uiOutput("topgenes1"),br(), uiOutput(align="center","dlontobutton_compare1") ) , column(align="center", width=10, br(), dataTableOutput("onto_compare1"))),
                                      column(align="center",width=6, column(align="center", width=10, br(), dataTableOutput("onto_compare2")), column(align="align", width=2, uiOutput("topgenes2"),br(), uiOutput(align="align","dlontobutton_compare2") )))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
238
            )
239
    ),
240
241
242
243
244
245
246
247
    # Grid Item --------
    tabItem(tabName="grid_item", align="left",
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
                             plotOutput(outputId="minigenes", width="1400px", height="1400px")
            )
    ),
    
248
    # Pipeline Item --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
249
    tabItem(tabName="pipeline_item", align="center", 
250
            br(),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
251
            helpText("Here you can find the pipeline used."),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
252
253
            br(), br(), br(),
            img(src = "pipe.png", height = 250, width = 1000 )
254
    ),
255
    # About Item --------
256
    tabItem(tabName="about_item", align="center", h3(strong("Shiny SChnurR")), br(), br(), br(),
257
258
259
260
261
262
            strong("Centre de Recherche en Cancérologie et Immunologie Nantes-Angers"), br(),
            p("UMR1232, CNRS ERL6001"), 
            p("Equipe 11 'Oncogénomique intégrative de la genèse et de la progression du Myélome Multiple'"), 
            p("IRS-UN"), 
            p("8 Quai Moncousu"), 
            p("44007 Nantes"), br(),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
263
            fluidPage(
Bagueneau Mathias's avatar
Bagueneau Mathias committed
264
265
266
267
268
269
270
              column(width=4, img(src = "hema.png",  align="center")),
              column(width=4, img(src = "crcina.png",  align="center")),
              column(width=4, img(src = "sysmics.png", height = 100, align="center"))), br(),
            fluidPage(
              column(width=4, img(src = "univ.png", height = 150,  align="center")),
              column(width=4, img(src = "chu.png", height = 150,  align="center")),
            column(width=4, img(src = "siric.jpg", height = 100,  align="center"))),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
271
            br(), hr(), br(),  p(em("Development Team : Mathias BAGUENEAU, Jean-Baptiste ALBERGE, Jonathan CRUARD,"), br(), em("Beta-test : Benjamin DELAUNE")),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
272
            br(), p(strong("Git repository :"),a(href="https://gitlab.univ-nantes.fr/MathBgn/myelome", "Shiny SChnurR"), br(), em("A complete tutorial is available at this adress."))
273
274
    )
  )
275
276
)            

277
## PAGE --------
278
ui <- dashboardPage(
Bagueneau Mathias's avatar
Bagueneau Mathias committed
279
  header,
280
281
  sidebar,
  body
282
283
)

284

285
### ----------------------------- Server logic -----------------------------------------------------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
286

287
server <- function(input, output, session) {
288
  options(shiny.maxRequestSize = 2500*1024^2)
289
  # options(shiny.trace=TRUE)
290
  
291
  ## Upload and gestion of files --------
292
293
  filedata <- reactiveValues()
  observe ({
294
295
296
297
    if (!is.null(input$file1)) {
      infile <- input$file1
      if (is.null(infile)) {return (NULL)}
      filedata$data <- readRDS(infile$datapath)
298
      filedata$name <- input$file1$name
299
300
    } else {
      req(input$file)
301
302
      filedata$data <- withProgress(readRDS(paste0("./data/",input$file)), message = "Uploading file...", value=1)
      filedata$name <- input$file
303
    }
304
    genesList <- filedata$data@assays$SCT@data@Dimnames[1]
Bagueneau Mathias's avatar
Bagueneau Mathias committed
305
306
    updateSelectizeInput(session, "genes", choices = genesList[[1]], selected = "IGKC")
    updateSelectizeInput(session, "genes2", choices = genesList[[1]], selected = "IGKC")
307
    updateSelectizeInput(session, "listminigenes", choices = genesList[[1]], selected = "IGKC")
308
    return(filedata$data)
309
    return(filedata$name)
310
  })
311
  output$fileUploaded <- reactive({
312
    return(!is.null(filedata$data))
313
314
315
  })
  outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
  
316
317
318
319
320
321
  ## Select File --
  output$selectfile <- renderUI ({
    req(is.null(input$file1))
    selectInput(inputId="file", label="Or choose a file :", choices = c("",list.files(path = "./data",full.names = FALSE,recursive = FALSE)))
  })
  
322
  ## Creating an object for filedata, assay gestion and color list creation --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
323
324
325
326
327
328
329
330
331
332
  wrfile <- reactive ({
    req(filedata$data)
    wrdata <- filedata$data
    if (!is.null(wrdata@assays$SCT)) {
      DefaultAssay(wrdata) <- "SCT"
    } else {
      DefaultAssay(wrdata) <- "RNA"
    }
    return (wrdata)
  })
333
  
334
335
336
337
338
339
340
341
342
  # Assign.colors function
  assign.colors <- function(obj, ident, palette="Dark2"){
    ident <- as.factor(ident)
    nr.groups <- length(levels(ident))
    colors <- colorRampPalette(brewer.pal(8, palette))(nr.groups)
    colors.df <- data.frame(group=levels(ident), color=colors)
    return(colors.df)
  }
  
343
  # List group <-> color for every class
344
  alldf <- reactive ({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
345
346
    coldf <- lapply(wrfile()@meta.data[,sapply(wrfile()@meta.data, class) %in% c("factor","character")], assign.colors, obj=wrfile(), palette="Dark2")
    return(coldf)
347
  })
348
  
349
  ## Graphs & one table Generations --------
350
  markersData <- reactive ({ # Markers table Visu page
351
352
    mD <- wrfile()@misc$markers[[input$fsel]]
    return(mD)
353
  })
354
  
355
  factorsplotData <- reactive ({ # Left Graph Visu page
Bagueneau Mathias's avatar
Bagueneau Mathias committed
356
357
    withProgress(DimPlot(object = wrfile(), label=FALSE, pt.size = input$ptsize, reduction=input$graph, group.by = input$fsel, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel,"$color"))))), message = "Plot Generation", value=1) + NoLegend() + theme_bw() +theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$fsel)) + theme(aspect.ratio = 1)
    })
358
  
359
  numericsplotData <- reactive ({ # Right Graph Visu page
360
    if (input$featuresel =="d") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
361
      withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize, features = input$nsel, reduction = input$graph), message = "Plot Generation", value=1) + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +  NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$nsel)) + theme(aspect.ratio = 1)
362
    } else if (input$featuresel =="g") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
363
      withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize, features = input$genes, reduction = input$graph), message = "Plot Generation", value=1) + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +   NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$genes))+ theme(aspect.ratio = 1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
364
      
365
    }
366
367
  })
  
368
  miniplot_compareData <- reactive ({ # Mini Graph 1 Compare page
369
    withProgress(DimPlot(object = wrfile(), label=TRUE, pt.size = input$ptsize_compare, legend="none", reduction=input$graph_compare, group.by = input$fsel2, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$color"))) )), message = "Plot Generation", value=1)  + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) + NoAxes() + NoLegend() + theme(aspect.ratio = 1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
370
371
  })
  
372
  miniplot_compare2Data <- reactive ({ # Mini Graph 2 Compare page
Bagueneau Mathias's avatar
Bagueneau Mathias committed
373
    if (input$choice_compare == "features_compare") {
374
      if (input$featuresel2 =="d2") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
375
        withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_compare, features = input$nsel2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoLegend() + NoAxes() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) + theme(aspect.ratio = 1)
376
      } else if (input$featuresel2 =="g2") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
377
        withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_compare, features = input$genes2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoLegend() + NoAxes() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) + theme(aspect.ratio = 1)
378
379
      }      
    }
380
  })
381
  
382
  
383
  ## Graphs & Tables Outputs --------
384
  output$plot_factors <-renderPlotly ({
385
    req(wrfile())
386
    ggplotly(factorsplotData(),tooltip = c("colour","text")) %>% config(displaylogo = F,  modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
387
  })
388
  
389
  output$plot_numerics <-renderPlotly ({
390
    req(wrfile())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
391
    ggplotly(numericsplotData(),tooltip = "none") %>% config(displaylogo = F,  modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
392
  })
393
394
  
  output$markers_table <- renderDataTable ({
395
    req(wrfile())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
396
    req(markersData() != "")
397
    datatable(markersData()[c(7,6,3,4,2,1,5)], rownames = FALSE, filter="top", caption = paste("Table : All significant markers for the class :", input$fsel ,"| Test used : MAST" ))  %>% formatRound(columns=c(3,4,5), digits=3) %>% formatSignif(columns=c(7,6), digits=3)
398
  })
399
  
400
  output$miniplot_compare <- renderPlot({
401
    req(wrfile())
402
403
    plot(miniplot_compareData())
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
404
405
  
  output$miniplot_compare2 <- renderPlot({
406
    req(wrfile())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
407
408
    plot(miniplot_compare2Data())
  })
409
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
410
411
412



413
  ## Grid Genes Miniplots Generation & Outputs --------
414
415
416
417
418
419
420
  
  output$minigenes <- renderPlot({
    req(wrfile())
    plot(gridData())
  })

  gridData <- reactive ({ # Grid MiniGraph
Bagueneau Mathias's avatar
Bagueneau Mathias committed
421
    withProgress(FeaturePlot(object = wrfile(),  cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_grid, features = c(input$listminigenes), reduction = input$graph_grid), message = "Plot Generation", value=1) + theme_bw()+ NoLegend() + NoAxes() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) 
422
423
424
  })

  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
425
  ## Heatmap Generation, Output & Download --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
426
  output$heat_numb <- renderUI ({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
427
    sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
428
  })
429
  observeEvent({list(input$fsel3,input$top_number)},
430
431
               {req(input$goheatmap)
                 output$heatmapstatut <- renderText({"Needs recalculation"})})
Bagueneau Mathias's avatar
Bagueneau Mathias committed
432

433
434
  observeEvent(input$goheatmap, {  
    output$heatmapstatut <- renderText({""})
435
    if (is.null(wrfile()@misc$markers[[input$fsel3]])) { 
436
      showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
437
438
439
440
441
442
      tempfile <- wrfile()
      Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel3)))))
      tempmarkers <- withProgress(FindAllMarkers(tempfile, assay = 'SCT', test.use = "MAST", only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
      topgenesfam <- tempmarkers %>% group_by(cluster) %>% top_n(n = input$top_number, wt = avg_logFC)
      datascalefam <- withProgress(ScaleData(object = wrfile(), features = topgenesfam$gene), message = "Scaling data...", value=1)
      withProgress(DoHeatmap(object = datascalefam, features = topgenesfam$gene, group.by=input$fsel3), message = "Heatmap Generation", value=1) + NoLegend() + ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$fsel3,"- top",input$top_number,"genes")) + theme(plot.title = element_text(size=20))
443
    } else {
444
445
      topgenes <- wrfile()@misc$markers[[input$fsel3]] %>% group_by(cluster) %>% top_n(n = input$top_number, wt = avg_logFC)
      datascale <- withProgress(ScaleData(object = wrfile(), features = topgenes$gene), message = "Scaling data...", value=1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
446
      heatmap <- withProgress(DoHeatmap(object = datascale, features = topgenes$gene, group.by=input$fsel3), message = "Heatmap Generation", value=1) + NoLegend() + ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$fsel3,"- top",input$top_number,"genes")) + theme(plot.title = element_text(size=20))
447
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
448
 
449
  output$heatmap <-renderPlot ({
450
    req(wrfile())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
451
452
453
454
    heatmap
  })
  
  output$dlheat <- renderUI ({ # Download
455
    downloadButton("dl_heatmap", label="Export Heatmap")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
456
457
458
459
460
461
462
463
464
465
466
467
  })
  output$dl_heatmap <- downloadHandler(
    filename = function() {
      paste0(file_path_sans_ext(filedata$name),"_heatmap_",input$fsel3,"_top",input$top_number,"genes",".png")
    },
    content = function(file) {
      png(file, width = 800, height = 600)
      print(heatmap)
      dev.off()
    }
  )
  
468
  })
469
  
470
  ## Genes Page --------
471
  observeEvent({list(input$fsel4,input$group_genepage,input$gographtype,input$ontology)},
472
473
               {req(input$gogo)
                 output$genesstatut <- renderText({"Needs recalculation"})})
474

475
476
477
  observeEvent(input$gogo, {
    if (is.null(input$group_genepage)) {
      showModal(modalDialog("You must choose at least one group to do the Gene Ontology.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
478
479
    } else {

480
    output$genesstatut <- renderText({""})
481
    if (is.null(wrfile()@misc$markers[[input$fsel4]])) { 
482
      showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL )) 
483
484
485
486
487
488
      tempfile <- wrfile()
      Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel4)))))
      tempmarkers <- withProgress(FindAllMarkers(tempfile, assay = 'SCT', test.use = "MAST", only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
      genes <- tempmarkers$cluster == input$group_genepage
      genes <- tempmarkers$gene[genes]
    } else {
489
490
    genes <- wrfile()@misc$markers[[input$fsel4]]$cluster == input$group_genepage
    genes <- wrfile()@misc$markers[[input$fsel4]]$gene[genes]
491
    }
492
493
    genes <- bitr(genes, fromType = "SYMBOL",toType = "ENTREZID",OrgDb = org.Hs.eg.db,drop = TRUE)
    ego <- withProgress(enrichGO(gene = genes$ENTREZID, OrgDb = "org.Hs.eg.db", keyType= "ENTREZID", ont = input$ontology, readable = TRUE), value = 1, message = "Ontology in progress...")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
494
495
496
497

    isolate ({
    req(!is.null(input$group_genepage)) # Graph data
      req(input$gogo)
498
      if (input$gographtype == "dplot") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
499
        goplotData <- dotplot(ego) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
500
      } else if (input$gographtype == "bplot") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
501
        goplotData <- barplot(ego, drop=TRUE) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
502
      } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
503
        goplotData <- emapplot(ego) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
504
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
505
    })
506
  output$goplot <-renderPlot ({
507
    req(wrfile())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
508
    goplotData
509
510
  })
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
511
512
513
  
    req(!is.null(input$group_genepage)) # Genes Table
    filegene <- wrfile() 
514
    Idents(filegene) <- as.factor(paste0(eval(parse(text=paste0("filegene@meta.data$",input$fsel4)))))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
515
516
517
518
    dtgoData <- data.table(filegene@misc$markers[[input$fsel4]]$gene[which(eval(parse(text=paste0("filegene@misc$markers$",input$fsel4,"$cluster"))) %in% input$group_genepage)])
    setDT(dtgoData)[]
    names(dtgoData)[1] <- "Gene"
    
519
520
  output$dtgenes <-renderDataTable ({
    req(wrfile())
521
    datatable(dtgoData, filter="top", caption = paste("Table : Markers for the selected group(s) and class"))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
522
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
523
  
524
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
525
526
527
528
    req(!is.null(input$group_genepage)) # Ontology Table
    dtontoData <- data.table(ego$Description, ego$GeneRatio, ego$pvalue, ego$p.adjust, ego$geneID)[which(ego$Count > 3)]
    colnames(dtontoData) <- c("Description","Gene Ratio","P-value","FDR","GeneID")

529
530
  output$dtonto <-renderDataTable ({
    req(wrfile())
531
    datatable(dtontoData, filter="top", caption = paste("Table : Gene Ontology for the selected group(s) and class | Only takes groups with a ratio > 3/Total, p-value cutoff : 0.05")) %>% formatSignif(columns=c(3,4), digits=3)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
532
533
  })
  
534
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
535
  output$dlgenegraph <- renderUI ({ # Download
536
    downloadButton("dl_gene", label="Export Graph")
537
538
539
540
541
542
543
544
545
546
547
548
549
  })
  output$dl_gene <- downloadHandler(
    filename = function() {
      if (input$gographtype == "dplot") {
        paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_dotplot_",input$fsel4,".png")
      } else if (input$gographtype == "bplot") {
        paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_barplot_",input$fsel4,".png")
      } else {
        paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_emapplot_",input$fsel4,".png")
      }
    },
    content = function(file) {
      png(file, width = 800, height = 600)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
550
      print(goplotData)
551
552
553
554
      dev.off()
    }
  )
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
555
  output$dlgenedt <- renderUI ({ # Download
556
    downloadButton("dl_godt", label="Export Table")
557
558
559
  })
  output$dl_godt <- downloadHandler(
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
560
      paste0(file_path_sans_ext(filedata$name),"_genes_datatable_",input$fsel4,".csv")
561
562
    },
    content = function(file) {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
563
      write.csv(dtgoData, file)
564
565
566
    }
  )
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
567
  output$dlontodt <- renderUI ({ # Download
568
    downloadButton("dl_ontodt", label="Export Table")
569
570
571
  })
  output$dl_ontodt <- downloadHandler(
    filename = function() {
572
      paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology,"_datatable_",input$fsel4,".csv")
573
574
    },
    content = function(file) {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
575
      write.csv(dtontoData, file)
576
577
    }
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
578
579
    }
  })
580
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
581
582
583
  ## Other Downloads functions --------
  output$dlmarkbutton_visu <- renderUI ({ # visualization Page
    req(markersData() != "")
584
    downloadButton("dlmarkers", label="Export Table")
585
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
586
  output$dlmarkers <- downloadHandler( # visualization Page
587
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
588
      paste0(file_path_sans_ext(filedata$name),"_allmarkers_",input$fchoice,".csv")
589
590
    },
    content = function(file) {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
591
      write.csv(markersData(), file)
592
593
594
    }
  )
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
595
  output$dlleftplot <- downloadHandler( # visualization Page
596
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
597
      paste0(file_path_sans_ext(filedata$name),"_plot_",input$fsel,"_",input$graph,".svg")
598
599
600
    },
    content = function(file) {
      svg(file)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
601
602
603
      print(factorsplotData())
      dev.off()
    }
604
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
605
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
606
  output$dlrightplot <- downloadHandler( # visualization Page
607
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
608
609
      if (input$featuresel =="g") {
        paste0(file_path_sans_ext(filedata$name),"_",input$genes,"_plot_",input$graph,".svg")
610
      } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
611
        paste0(file_path_sans_ext(filedata$name),"_",input$nsel,"_plot_",input$graph,".svg")
612
      }
613
614
615
    },
    content = function(file) {
      svg(file)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
616
      print(numericsplotData())
617
618
619
      dev.off()
    }
  )
620
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
621
  
622
623
  output$dlgrid <- renderUI ({ # Grid Page
    req(gridData() != "")
624
    downloadButton("dlminiplots_grid", label="Export Graphs")
625
626
627
628
629
630
631
632
633
634
635
636
637
638
  })
  
  output$dlminiplots_grid <- downloadHandler( # Grid Page
    filename = function() {
      paste0(file_path_sans_ext(filedata$name),"_gridplot_",input$graph_grid,".svg")
    },
    content = function(file) {
      svg(file)
      print(gridData())
      dev.off()
    }
  )
  
  
639
640
  ## Information Visualize text --------
  output$information  <- renderUI({
641
    req(wrfile())
642
    az <- paste(strong("Filename :"), filedata$name)
643
644
645
646
    er <- paste(strong("Genes number :"), length(wrfile()@assays$SCT@data@Dimnames[[1]]), " | ",strong("Cells number :"), length(wrfile()@assays$SCT@data@Dimnames[[2]]), " | ",strong("Median genes/cell :"), median(wrfile()@meta.data$nFeature_SCT))
    ty <- paste(strong("Assay used :"), wrfile()@active.assay)
    HTML(paste(az,er,ty, sep='</br>'))
  })
647
  
648
649
650
  
  ## No file texts --------
  output$no_file2  <- renderText({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
651
652
    req(input$file =="")
    req(is.null(input$file1))
653
654
    print("Please upload or \n choose a file")
  }) 
655
  output$no_file3  <- renderText({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
656
657
    req(input$file =="")
    req(is.null(input$file1))
658
    print("Please upload or \n choose a file")
659
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
660
  output$no_file4  <- renderText({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
661
662
    req(input$file =="")
    req(is.null(input$file1))
663
    print("Please upload or \n choose a file")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
664
  })
665
666
667
668
669
  output$no_file5  <- renderText({
    req(input$file =="")
    req(is.null(input$file1))
    print("Please upload or \n choose a file")
  })
670
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
671
  
672
  ## Clusters + selection information text in visualization page --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
673
  output$clusters_infos <- renderTable({ 
674
    req(input$fsel != "")
675
    req(input$show_clusters == "TRUE")
676
    clDATA <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]])))/length(as.factor(wrfile()@meta.data[[input$fsel]])))*100),digits=2, format ="f" ))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
677
678
    t(head( clDATA, n=999 ))}, align="c", striped = TRUE, hover = TRUE, spacing = 'xs',   width = '100%',  colnames = FALSE, rownames=TRUE
  )
679
  
680
  output$select_infos <- renderText({
681
682
    req(wrfile())
    d <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(wrfile()@meta.data[[input$fsel]]))*100),digits=2, format ="f" )  ) 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
683
    if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else d
684
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
685
  
686
  ## Clusters + selection information text in compare page --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
687
  output$clusters_infos_compare  <- renderTable ({
688
    req(input$fsel2 != "")
689
    req(input$show_clusters_compare == "TRUE")
690
    clDATA2 <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel2]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]])))/length(as.factor(wrfile()@meta.data[[input$fsel2]])))*100),digits=2, format ="f" ))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
691
692
    t(head( clDATA2, n=999 ))}, align="c",  striped = TRUE, hover = TRUE, spacing = 'xs',   width = '100%',  colnames = FALSE, rownames=TRUE
  ) 
693
  output$select_infos_compare <- renderText({
694
695
    req(wrfile())
    d <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(wrfile()@meta.data[[input$fsel2]]))*100),digits=2, format ="f" )  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
696
    if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else d
697
  })
698
  
699
700
  ## Factors choices --------
  output$fchoice <-renderUI({ # Visualize page
701
    selectizeInput("fsel", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
702
  })
703
  output$fchoice2 <-renderUI({ # Compare Page
704
    selectizeInput("fsel2", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
705
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
706
  output$fchoice3 <-renderUI({ # Heatmap Page
707
    selectizeInput("fsel3", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
708
  })
709
  output$fchoice4 <-renderUI({ # Genes Page
710
    selectizeInput("fsel4", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
711
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
712
  
713
714
  output$addf <-renderUI({ # Add factor Compare Page
    req(input$add %% 2 != 0)
715
    selectizeInput("add_factor", "Add a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "orig.ident")
716
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
717
  
718
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
719
  ## Link the choices --
720
721
  observeEvent ({
    input$fsel
722
723
  }, { updateSelectizeInput(session,"fsel2",selected = input$fsel)
    updateSelectizeInput(session,"fsel3",selected = input$fsel)
724
725
726
727
    updateSelectizeInput(session,"fsel4",selected = input$fsel) },ignoreNULL = FALSE)
  
  observeEvent ({
    input$fsel2
728