app.R 78.5 KB
Newer Older
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1
2
3
4
5
6
#-----------------------#
#     Shiny SChnurR     #
#-----------------------#


# Load packages and files --------
7
8
library(shiny)
library(shinythemes)
9
10
library(Seurat)
library(dplyr)
11
12
library(ggplot2)
library(viridis)
13
14
library(stringr)
library(plotly)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
15
library(BiocManager)
16
library(shinydashboard)
17
library(shinyjs)
18
library(DT)              
19
library(RColorBrewer) 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
20
library(MAST)     
21
library(data.table)
22
library(clusterProfiler)
23
library(org.Hs.eg.db) 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
24
library(tools)
25
library(PANTHER.db)
Bagueneau Mathias's avatar
update    
Bagueneau Mathias committed
26
library(topGO)
27
28
library(ggpubr)
library(colourpicker)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
29
library(shinyjqui)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
30
31
source("utils.R")
source("config.R")
32

33

Bagueneau Mathias's avatar
Bagueneau Mathias committed
34
### ----------------------------- User interface --------------------------------------------------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
## HEADER --------
useShinyjs()
header <- dashboardHeader(tags$li(class="dropdown", # Text for every tabs
                                  conditionalPanel(condition="input.tabs == 'visu_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","Visualization")), 
                                  conditionalPanel(condition="input.tabs == 'heatmap_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","Heatmap")),
                                  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")),
                                  conditionalPanel(condition="input.tabs == 'grid_item'",
                                                   tags$p(style="color:white;font-size:25px;margin-right:20px","Grid")),
                                  tags$head(HTML("<link rel='icon' href='min.png'>")
                                  )
))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
53
54
55
user_date <- Sys.Date()
user_date <- str_split_fixed(user_date, "-", 3)
user_month <- user_date[2] 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
56
if (user_month == "12") { # XMas Special
Bagueneau Mathias's avatar
Bagueneau Mathias committed
57
58
59
60
61
62
63
64
65
66
67
68
  app_logo <- "logoxmas.png"
  app_title <- "XMas SChnurR"
} else if  (user_month == "10") { # Halloween Special
  app_logo <- "logohallo.png"
  app_title <- "Spooky SChnurR"
} else if  (user_month == "04") { # Easter Special
  app_logo <- "logoeaster.png"
  app_title <- "Easter SChnurR"
} else if  ((user_month == "07") || (user_month == "08")) { # Summer Special
  app_logo <- "logosummer.png"
  app_title <- "Sunny SChnurR"
} else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
69
  app_logo <- "logo.png" # Normal Style
Bagueneau Mathias's avatar
Bagueneau Mathias committed
70
71
72
73
  app_title <- "Shiny SChnurR"
}

anchor <- tags$a(tags$img(src=app_logo, height='30', width='20'),app_title, style="color: white") # Logo & Title
Bagueneau Mathias's avatar
Bagueneau Mathias committed
74
75
76
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"

Bagueneau Mathias's avatar
Bagueneau Mathias committed
77
78


Bagueneau Mathias's avatar
Bagueneau Mathias committed
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
## SIDEBAR --------
sidebar <- dashboardSidebar(
  tags$style(type="text/css",
             ".shiny-output-error { visibility: hidden; }",
             ".shiny-output-error:before { visibility: hidden; }"),
  br(),
  # Menu -------
  sidebarMenu(id="tabs", # The tabs are define here (icon + title)
              menuItem("Visualization", tabName="visu_item", icon=icon("area-chart"), selected = TRUE),
              menuItem("Heatmap", tabName = "heatmap_item", icon=icon("fas fa-align-justify")),
              menuItem("Genes", tabName = "genes_item", icon=icon("dna")),
              menuItem("Compare", tabName="compare_item", icon = icon("table")),
              menuItem("Grid", tabName="grid_item", icon = icon("fas fa-th")),
              menuItem("Pipeline", tabName="pipeline_item", icon = icon("fas fa-bezier-curve")),
              menuItem("About", tabName = "about_item", icon = icon("far fa-id-card"))
  ),
  br(),
  
  # Visu Panel --------
  conditionalPanel(condition="input.tabs=='visu_item'",
                   fluidRow(
                     column(1),
                     column(10,
                            h4(align="center", "Control Panel"), 
                            div(actionLink("help_visu", "",
                                           icon = icon("far fa-question-circle")), align="center"),
                            fileInput(inputId="file", 
                                      label="Upload your *.rds file :",
                                      accept = ".rds", placeholder=""),
                            uiOutput("selectfile"),
                            conditionalPanel(condition= "output.fileUploaded", align="center",
                                             radioButtons(inputId="graph_visu",
                                                          label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"),
                                                          selected = "umap"),
                                             div(actionLink("add_parameters_visu", "",
                                                            icon = icon("far fa-plus-square")), align="center"),
                                             conditionalPanel(condition= "input.add_parameters_visu % 2 != 0", align="center", # If the (+) is clicked, and mask if another click on it
                                                              sliderInput(inputId="ptsize_visu",
                                                                          label="Point size :",
                                                                          min=0.1, max=2,
                                                                          step=0.1, value = 0.6,
                                                                          ticks = FALSE),
                                                              sliderInput(inputId="title_size_visu",
                                                                          label="Plot title size :",
                                                                          min=8, max=35,
                                                                          step=1, value = 18,
                                                                          ticks = FALSE)
                                                             )

                             )))
  ),
  
  # Heatmap Panel --------
  conditionalPanel(condition="input.tabs=='heatmap_item'", align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help_heatmap", "",
                                           icon = icon("far fa-question-circle")), align="center"),
                            htmlOutput(outputId = "no_file_heatmap"),
                            conditionalPanel(condition= "output.fileUploaded", align="center",
                                             uiOutput("class_choice_heatmap"), br(),
                                             uiOutput("genes_number_heatmap"), br(),
                                             textOutput("status_heatmap"),
                                             actionButton("go_heatmap", 
                                                          icon = icon("far fa-arrow-alt-circle-right"),
                                                          label="Compute Heatmap"),
                                             br(),
                                             div(actionLink("add_parameters_heatmap", "",
                                                            icon = icon("far fa-plus-square")), align="center"),
                                             conditionalPanel(condition= "input.add_parameters_heatmap % 2 != 0", align="center", # If the (+) is clicked, and mask if another click on it
                                                              sliderInput(inputId="title_size_heatmap",
                                                                          label="Heatmap title size :",
                                                                          min=8, max=35,
                                                                          step=1, value = 18,
                                                                          ticks = FALSE)
                                                              ))))
  ),
  
  # Genes Panel --------
  conditionalPanel(condition="input.tabs=='genes_item'",align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help_genes", "", 
                                           icon = icon("far fa-question-circle")), align="center"),
                            htmlOutput(outputId = "no_file_genes"), 
                            conditionalPanel(condition= "output.fileUploaded",align="center",
                                             uiOutput("class_choice_genes"), br(),
                                             uiOutput("group_genes"), br(),
                                             radioButtons("gograph_genes",
                                                          label="Choose a graph type :", 
                                                          choices=c("Dotplot"="dplot", "Barplot"="bplot", "Emapplot" = "eplot")),
                                             br(),
                                             radioButtons("ontology_genes",
                                                          label="Choose an ontology :",
                                                          choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")), 
                                             br(),
                                             textOutput("status_genes"),
                                             actionButton("go_go",
                                                          icon = icon("far fa-arrow-alt-circle-right"), label="Ontology"),
                                             br(),
                                             div(actionLink("add_parameters_genes", "",
                                                           icon = icon("far fa-plus-square")), align="center"),
                                             conditionalPanel(condition= "input.add_parameters_genes % 2 != 0", align="center", # If the (+) is clicked, and mask if another click on it
                                                             sliderInput(inputId="title_size_genes",
                                                                         label="Graph title size :",
                                                                         min=8, max=35,
                                                                         step=1, value = 18,
                                                                         ticks = FALSE)
                                             ))))
  ),
  
  # Compare Panel --------
  conditionalPanel(condition="input.tabs=='compare_item'", align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help_compare", "", 
                                           icon = icon("far fa-question-circle")), align="center"),
                            htmlOutput(outputId = "no_file_compare"),
                            conditionalPanel(condition= "output.fileUploaded",align="center",
                                             radioButtons(inputId="choice_compare",
                                                          label= "Compare :", c("Class" = "class_compare", "Features" = "features_compare"),
                                                          selected = "class_compare"),
                                             conditionalPanel(condition = "input.choice_compare == 'features_compare'",
                                                              uiOutput("feature_choice_compare"),
                                                              conditionalPanel(condition ="input.feature_selector_compare == 'g2'",
                                                                               selectizeInput(inputId="genes_list_compare",
                                                                                              label="Choose a gene :",
                                                                                              choices ="")),
                                                              conditionalPanel(condition ="input.feature_selector_compare == 'd2'",
                                                                               uiOutput("qvariable_choice_compare")),
                                                              FeatureColorPalettes("feature_color_palettes_compare"),  # Go into config.R to custom the available color palette !
                                                              conditionalPanel(condition ="input.feature_color_palettes_compare == 'Color Picker'", 
                                                                               colourInput("color_picker_compare",  # Color picker
                                                                                           label = "Choose a color :",
                                                                                           value = "blue",
                                                                                           showColour = "both",
                                                                                           allowTransparent = TRUE,
                                                                                           returnName = FALSE))),
                                             conditionalPanel(condition = "input.choice_compare == 'class_compare'",
                                                              ClassColorPalettes("color_palettes_compare")), # Go into config.R to custom the available color palette !
                                             radioButtons(inputId="graph_compare",
                                                          label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"),
                                                          selected = "umap"),
                                             radioButtons("ontology_compare",
                                                          label="Choose an ontology :",
                                                          choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")),
                                             br(),
                                             div(actionLink("add_parameters_compare", "",
                                                            icon = icon("far fa-plus-square")), align="center"),
                                             conditionalPanel(condition= "input.add_parameters_compare % 2 != 0", align="center", # If the (+) is clicked, and mask if another click on it
                                                              sliderInput(inputId="ptsize_compare",
                                                                          label="Point size :", 
                                                                          min=0.1, max=2,
                                                                          step=0.1, value = 0.6, 
                                                                          ticks = FALSE),
                                                              sliderInput(inputId="title_size_compare",
                                                                          label="Plots title size :",
                                                                          min=8, max=35,
                                                                          step=1, value = 18,
                                                                          ticks = FALSE)
                                             ))))
  ),
  
  # Grid Panel --------
  conditionalPanel(condition="input.tabs=='grid_item'", align="center",
                   fluidRow(
                     column(1),
                     column(10, h4(align="center", "Control Panel"),
                            div(actionLink("help_grid", "",
                                           icon = icon("far fa-question-circle")), align="center"),
                            htmlOutput(outputId = "no_file_grid"),
                            conditionalPanel(condition= "output.fileUploaded",align="center",
                                             radioButtons(inputId="graph_grid",
                                                          label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"),
                                                          selected = "umap"),
                                             sliderInput(inputId="ptsize_grid",
                                                         label="Point size :",
                                                         min=0.1, max=2,
                                                         step=0.1, value = 0.6,
                                                         ticks = FALSE),
                                             uiOutput("ncol_grid"), 
                                             br(),
                                             PresetsGrid(), # Go into config.R to custom the presets !
                                             selectizeInput(inputId="genes_list_grid", 
                                                            label="and/or choose some genes :", 
                                                            choices ="",
                                                            multiple = TRUE),
                                             br(),
                                             textOutput("status_grid"), 
                                             actionButton("gridgraphs", 
                                                          icon = icon("far fa-arrow-alt-circle-right"), 
                                                          label="Compute Plots"), 
                                             br(),
                                             tags$style(type="text/css", "#dlminiplots_grid {color: black}"),
                                             uiOutput("dl_grid"),
                                             br(),
                                             div(actionLink("add_parameters_grid", "",
                                                            icon = icon("far fa-plus-square")), align="center"),
                                             conditionalPanel(condition= "input.add_parameters_grid % 2 != 0", align="center", # If the (+) is clicked, and mask if another click on it
                                                              sliderInput(inputId="title_size_grid",
                                                                          label="Plot title size :",
                                                                          min=8, max=35,
                                                                          step=1, value = 18,
                                                                          ticks = FALSE)
                                                              ))))
  ),
  
  # About Panel --------
  conditionalPanel(condition="input.tabs=='about_item'",
                   fluidRow(
Bagueneau Mathias's avatar
Bagueneau Mathias committed
292
                     column(1), column(10, tags$img(src=app_logo, height='300', width='175'))))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

)

## BODY --------
body <- dashboardBody(
  tabItems(
    
    # Visualize Item --------
    tabItem(tabName="visu_item", align="center", 
            conditionalPanel(condition="output.fileUploaded", 
                             br(),
                             htmlOutput(outputId = "file_infos_visu"),
                             br(),
                             checkboxInput(inputId = "show_clusters_visu",
                                           label = "Clusters information", 
                                           value = FALSE),
                             uiOutput(outputId = "clusters_infos_visu"),
                             verbatimTextOutput(outputId = "select_infos_visu"),  
                             br(),
                             fluidRow(column(align="center",
                                             width = 6,
                                             jqui_resizable(plotlyOutput("classplot_visu",  # Remove jqui_resizable for possible better perfs
                                                                         width = '500px',
                                                                         height = '500px')),
                                             ClassColorPalettes("color_palettes_visu"), # Go into config.R to custom the available color palette !
                                             uiOutput("class_choice_visu"),
                                             downloadButton("dlclassplot_visu",
                                                            label="Export Plot")),
                                      column(align="center", 
                                             width = 6,
                                             jqui_resizable(plotlyOutput("featureplot_visu",
                                                                         width='500px', 
                                                                         height='500px')),
                                             FeatureColorPalettes("feature_color_palettes_visu"), # Go into config.R to custom the available color palette !
                                             conditionalPanel(condition ="input.feature_color_palettes_visu == 'Color Picker'", 
                                                              colourInput("color_picker_visu",  # Color picker
                                                                          label = "Choose a color :",
                                                                          value = "blue",
                                                                          showColour = "both",
                                                                          allowTransparent = TRUE,
                                                                          returnName = FALSE)),
                                             uiOutput("feature_choice_visu"), 
                                             uiOutput("qvariable_choice_visu"), 
                                             conditionalPanel(condition ="input.feature_selector_visu == 'g'", 
                                                              selectizeInput(inputId="genes_list_visu", 
                                                                             label="Choose a gene :", 
                                                                             choices ="")),
                                             downloadButton("dlfeatureplot_visu", 
                                                            label="Export Plot"))), 
                             hr(),
                             br(),
                             dataTableOutput("markers_table_visu"),
                             uiOutput(align="left","dlmarkbutton_visu"))         
Bagueneau Mathias's avatar
Bagueneau Mathias committed
346
    ),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
347
348
349
350
351
352
353
354
    
    # Heatmap Item --------
    tabItem(tabName="heatmap_item", align="center",
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
                             plotOutput("heatmap", height = 850),
                             br(), 
                             uiOutput(align="left","dlbutton_heatmap"))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
355
    ),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
356
    
Bagueneau Mathias's avatar
Bagueneau Mathias committed
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
    # Genes Item --------
    tabItem(tabName="genes_item", align="left",
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
                             fluidRow(column(align="center", 
                                             width = 6, 
                                             plotOutput("goplot_genes", 
                                                        height = 600),
                                             uiOutput(align="left","dlgoplotbutton_genes")),
                                      column(align="center", 
                                             width = 6, 
                                             dataTableOutput("dt_genes"),
                                             uiOutput(align="left","dlgenedtbutton_genes"))),
                             br(), hr(), br(),
                             dataTableOutput("dt_onto_genes"),
                             uiOutput(align="left","dlontodtbutton_genes"))
373
    ),
374
    
Bagueneau Mathias's avatar
Bagueneau Mathias committed
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
    # Compare Item --------
    tabItem(tabName="compare_item", align="center", 
            br(),
            verbatimTextOutput(outputId = "select_infos_compare"),  
            checkboxInput(inputId="show_clusters_compare",
                          label="Clusters information",
                          value=FALSE),
            uiOutput(outputId = "clusters_infos_compare"),
            br(),
            conditionalPanel(condition="output.fileUploaded",
                             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("class_choice_compare"), 
                                             div(actionLink("add", "",
                                                            icon = icon("far fa-plus-square")), align="center"),
                                             uiOutput("add_class_compare"), 
                                             br(), 
                                             actionButton("go_plots_compare", 
                                                          icon = icon("far fa-arrow-alt-circle-right"), 
                                                          label="Compute Plots"), align="left",
                                             textOutput("status_plots_compare")),
                                      column(align="center", 
                                             width = 5, 
                                             plotlyOutput("plot1_compare",
                                                          width="490px",
                                                          height="490px"), 
                                             br(),
                                             uiOutput("group_plot1_compare"), 
                                             br(), 
                                             uiOutput("addgroup_plot1_compare"), 
                                             br(), 
                                             downloadButton("dlplot1_compare", 
                                                            label="Export Plot"),
                                             downloadButton("dlbarcodes1_compare",
                                                            label="Export Barcodes"), 
                                             br(),
                                             downloadButton("dlrds1_compare", 
                                                            label="Export as Seurat object"),
                                             downloadButton("dlcsv1_compare",
                                                            label="Export Metadata")),
                                      column(align="center", 
                                             width = 5, 
                                             plotlyOutput("plot2_compare",
                                                          width="490px", 
                                                          height="490px"), 
                                             br(), 
                                             uiOutput("group_plot2_compare"),
                                             br(),
                                             uiOutput("addgroup_plot2_compare"),
                                             br(),
                                             downloadButton("dlplot2_compare",
                                                            label="Export Plot"),
                                             downloadButton("dlbarcodes2_compare", 
                                                            label="Export Barcodes"),
                                             br(), 
                                             downloadButton("dlrds2_compare", 
                                                            label="Export as Seurat object"),
                                             downloadButton("dlcsv2_compare", 
                                                            label="Export Metadata"))),
                             hr(),
                             br(), 
                             uiOutput(align="left","findmarkersbutton_compare"), align="left", 
                             textOutput("status_markers_compare"), 
                             br(), 
                             uiOutput(align="left","dlmarkbutton_compare"), 
                             br(), 
                             dataTableOutput("markers_table_compare"),
                             hr(),
                             br(),
                             uiOutput(align="left","ontologybutton_compare"), 
                             textOutput("status_markers_onto"), 
                             br(),
                             fluidRow(column(align="center",
                                             width=6, 
                                             column(align="center", 
                                                    width=2, 
                                                    uiOutput("topgenes1_compare"),
                                                    br(), 
                                                    uiOutput(align="center","dlontobutton1_compare")), 
                                             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_compare"),
                                                    br(), 
                                                    uiOutput(align="align","dlontobutton2_compare")))))
477
    ),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
478
    
Bagueneau Mathias's avatar
Bagueneau Mathias committed
479
480
481
482
483
484
485
    # Grid Item --------
    tabItem(tabName="grid_item", align="left",
            conditionalPanel(condition= "output.fileUploaded",
                             br(), br(),
                             plotOutput(outputId="minigenesplot_grid",
                                        width="1400px",
                                        height="1400px"))
486
487
    ),
    
Bagueneau Mathias's avatar
Bagueneau Mathias committed
488
489
490
491
492
493
494
495
    # Pipeline Item --------
    tabItem(tabName="pipeline_item", align="center", 
            br(),
            helpText("Here you can find the pipeline used."),
            br(), br(), br(),
            img(src = "pipe.png", 
                height = 250, 
                width = 1000 )
496
    ),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
    
    # About Item --------
    tabItem(tabName="about_item", align="center", h3(strong("Shiny SChnurR")), 
            br(), br(), br(),
            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(),
            fluidPage(
              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"))),
            br(), hr(), br(),  
            p(em("Development Team : Mathias BAGUENEAU, Jean-Baptiste ALBERGE, Jonathan CRUARD,"), 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
528
              br(),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
529
530
531
532
              em("Beta-test : Benjamin DELAUNE")),
            br(),
            p(strong("GitLab repository :"),
              a(href="https://gitlab.univ-nantes.fr/MathBgn/myelome", "Shiny SChnurR"), 
Bagueneau Mathias's avatar
Bagueneau Mathias committed
533
534
              br(),
              em("A complete tutorial is available at this adress."))))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
535
536
537
538
539
540
541
542
543
)            

## PAGE --------
ui <- dashboardPage(
  header,
  sidebar,
  body)


544
### ----------------------------- Server logic -----------------------------------------------------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
545

546
server <- function(input, output, session) {
547
  options(shiny.maxRequestSize = 2500*1024^2)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
548
  # options(shiny.trace=TRUE) # <--- Use this for debugging time !
Bagueneau Mathias's avatar
Bagueneau Mathias committed
549
  
550
  ## Upload and gestion of files --------
551
552
  filedata <- reactiveValues()
  observe ({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
553
554
    if (!is.null(input$file)) {
      infile <- input$file
555
      if (is.null(infile)) {return (NULL)}
Bagueneau Mathias's avatar
Bagueneau Mathias committed
556
557
558
559
560
561
562
      filedata$data <- withProgress(readRDS(infile$datapath), message = "Loading File...", value=1)
      filedata$name <- input$file$name
    } else {
      req(input$file_list)
      filedata$data <- withProgress(readRDS(paste0("./data/",input$file_list)), message = "Uploading File...", value=1)
      filedata$name <- input$file_list
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
563
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
564
    genesList <- rownames(filedata$data) # Genes lists updates
565
566
567
    UpdateGeneslist(filedata$data, session, genesList, "genes_list_visu")
    UpdateGeneslist(filedata$data, session, genesList, "genes_list_compare")
    UpdateGeneslist(filedata$data, session, genesList, "genes_list_grid", selected_choice = "")
568
    return(filedata$data)
569
    return(filedata$name)
570
  })
571
  output$fileUploaded <- reactive({
572
    return(!is.null(filedata$data))
573
574
575
  })
  outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
576
  ## Select File Input --
577
  output$selectfile <- renderUI ({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
578
579
580
581
    req(is.null(input$file))
    selectInput(inputId="file_list", 
                label="Or choose a file :",
                choices = c("",list.files(path = "./data",full.names = FALSE,recursive = FALSE)))
582
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
583
  
584
  
Bagueneau Mathias's avatar
Bagueneau Mathias committed
585
586
587
  ## Visualization Page --------
  output$file_infos_visu  <- renderUI({ # Information text
    req(filedata$data)
588
    FileInformation(filedata$name, filedata$data) })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
589
590

  all_class_colors_visu <- reactive ({ # List group <-> color for every class
591
    AllClassColors(filedata$data, input$color_palettes_visu) })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
592

Bagueneau Mathias's avatar
Bagueneau Mathias committed
593
  output$feature_choice_visu <- renderUI ({ # Choice : Genes or Quantitative Variable
594
    GenesOrQv("feature_selector_visu", "g", "d") })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
595

Bagueneau Mathias's avatar
Bagueneau Mathias committed
596
597
  output$qvariable_choice_visu <- renderUI({ # Qv select
    req(input$feature_selector_visu=="d")
598
    QvChoices("qv_selector_visu", filedata$data) })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
599

Bagueneau Mathias's avatar
Bagueneau Mathias committed
600
601
602
  output$clusters_infos_visu <- renderTable({  # Clusters information text
    req(input$class_selector_visu != "")
    req(input$show_clusters_visu == "TRUE")
603
    ClustersInformation(filedata$data, input$class_selector_visu)},
Bagueneau Mathias's avatar
Bagueneau Mathias committed
604
605
    align="c", striped = TRUE,
    hover = TRUE, spacing = 'xs',
Bagueneau Mathias's avatar
Bagueneau Mathias committed
606
607
    width = '100%', colnames = FALSE, rownames=TRUE
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
608

Bagueneau Mathias's avatar
Bagueneau Mathias committed
609
610
  output$select_infos_visu <- renderText({ # Selection information text
    req(filedata$data)
611
    SelectionInformation(filedata$data, input$class_selector_visu)
612
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
613

Bagueneau Mathias's avatar
Bagueneau Mathias committed
614
615
  markers_visu_Data <- reactive ({ # Markers table
    mD <- filedata$data@misc$markers[[input$class_selector_visu]]
616
    return(mD)
617
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
618
619
620
  output$markers_table_visu <- renderDataTable ({
    req(filedata$data)
    req(markers_visu_Data() != "")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
621
622
    datatable(markers_visu_Data()[c(7,6,3,4,2,1,5)],
              rownames = FALSE,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
623
624
              filter="top",
              caption = paste("Table : All significant markers for the class :", input$class_selector_visu ,"| Test used : MAST" )) %>% formatRound(columns=c(3,4,5), digits=3) %>% formatSignif(columns=c(7,6), digits=3)
625
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
626

Bagueneau Mathias's avatar
Bagueneau Mathias committed
627
  classplot_visu_Data <- reactive ({ # Left Plot (class)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
628
629
630
    withProgress(DimPlot(object = filedata$data,
                         label=FALSE,
                         pt.size = input$ptsize_visu,
631
                         reduction = input$graph_visu,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
632
                         group.by = input$class_selector_visu,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
633
                         cols = as.character(eval(parse(text=paste0("all_class_colors_visu()$",input$class_selector_visu,"$color"))))), message = "Plot Generation", value=1) +
Bagueneau Mathias's avatar
Bagueneau Mathias committed
634
635
636
637
638
639
      NoLegend() +
      theme_bw() +
      theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_visu),panel.grid.minor=element_blank(),plot.background=element_blank()) +
      NoAxes() +
      ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_visu)) +
      theme(aspect.ratio = 1)
640
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
641
642
643
644
  output$classplot_visu <-renderPlotly ({
    req(filedata$data)
    ggplotly(classplot_visu_Data(),
             tooltip = c("colour","text"))  %>% config(displaylogo = F,  modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
645
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
646

Bagueneau Mathias's avatar
Bagueneau Mathias committed
647
648
  featureplot_visu_Data <- reactive ({ # Right Plot (features)
    if (input$feature_selector_visu =="d") {
649
      featurevar <- input$qv_selector_visu
Bagueneau Mathias's avatar
Bagueneau Mathias committed
650
    } else if (input$feature_selector_visu =="g") {
651
      featurevar <- input$genes_list_visu
Bagueneau Mathias's avatar
Bagueneau Mathias committed
652
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
653
654
655
    withProgress(FeaturePlot(object = filedata$data,
                             cols=c("lightgrey", AssignFeatureColors(input$feature_color_palettes_visu, input$color_picker_visu)),
                             pt.size = input$ptsize_visu,
656
                             features = featurevar,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
657
658
659
660
661
662
663
                             reduction = input$graph_visu), message = "Plot Generation", value=1) +
      theme_bw() +
      theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_visu),panel.grid.minor=element_blank(),plot.background=element_blank()) +
      NoAxes() +
      ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
      theme(aspect.ratio = 1) +
      theme(legend.text = element_blank())
664
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
665

Bagueneau Mathias's avatar
Bagueneau Mathias committed
666
667
668
669
  output$featureplot_visu <-renderPlotly ({
    req(filedata$data)
    ggplotly(featureplot_visu_Data(),tooltip = "none") %>% config(displaylogo = F,  modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
670

Bagueneau Mathias's avatar
Bagueneau Mathias committed
671
672
673
674
  ## Downloads --
  output$dlmarkbutton_visu <- renderUI ({ # Dl the Markers Table
    req(markers_visu_Data() != "")
    downloadButton("dl_markers_visu", label="Export Table")
675
  })
676

Bagueneau Mathias's avatar
Bagueneau Mathias committed
677
  output$dl_markers_visu <- downloadHandler(
678
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
679
      paste0(file_path_sans_ext(filedata$name),"_allmarkers_",input$class_choice_visu,".csv")
680
681
    },
    content = function(file) {
682
      write.csv(markers_visu_Data(), file, row.names = FALSE)
683
684
    }
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
685

Bagueneau Mathias's avatar
Bagueneau Mathias committed
686
  output$dlclassplot_visu <- downloadHandler( # Dl the Class Plot
687
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
688
      paste0(file_path_sans_ext(filedata$name),"_plot_",input$class_selector_visu,"_",input$graph_visu,".svg")
689
690
691
    },
    content = function(file) {
      svg(file)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
692
      print(classplot_visu_Data())
693
694
695
      dev.off()
    }
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
696

Bagueneau Mathias's avatar
Bagueneau Mathias committed
697
  output$dlfeatureplot_visu <- downloadHandler( # Dl the Feature Plot
698
    filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
699
      if (input$feature_selector_visu =="g") {
700
        featurevar <- input$genes_list_visu
701
      } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
702
        featurevar <- input$qv_selector_visu
703
      }
704
      paste0(file_path_sans_ext(filedata$name),"_",featurevar,"_plot_",input$graph_visu,".svg")
705
706
707
    },
    content = function(file) {
      svg(file)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
708
      print(featureplot_visu_Data())
709
710
711
      dev.off()
    }
  )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
712
713


714
  ## Heatmap Page --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
715
716
  output$genes_number_heatmap <- renderUI ({
    sliderInput("top_genes_number_heatmap", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
717
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
718
  observeEvent({list(input$class_selector_heatmap,input$top_genes_number_heatmap, input$title_size_heatmap)}, # Changing on of these inputs will update the text and announce that recalculation is needed.
Bagueneau Mathias's avatar
Bagueneau Mathias committed
719
720
               {req(input$go_heatmap)
                 output$status_heatmap <- renderText({"Needs recalculation"})})
Bagueneau Mathias's avatar
Bagueneau Mathias committed
721
722

  observeEvent(input$go_heatmap, {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
723
724
    output$status_heatmap <- renderText({""})
    if (is.null(filedata$data@misc$markers[[input$class_selector_heatmap]])) { # Case where the markers are not pre-calculated for the selected class
725
      showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
726
727
728
      tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
      Idents(tempdata) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_heatmap)))))
      tempmarkers <- withProgress(FindAllMarkers(tempdata,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
729
                                                 assay = DefaultAssay(filedata$data),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
730
                                                 test.use = "MAST",
Bagueneau Mathias's avatar
Bagueneau Mathias committed
731
732
                                                 only.pos = TRUE,
                                                 min.pct = 0.25,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
733
734
                                                 logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
      topgenes <- tempmarkers %>% group_by(cluster) %>% top_n(n = input$top_genes_number_heatmap, wt = avg_logFC)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
735
      datascale <- withProgress(ScaleData(object = tempdata,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
736
                                          features = topgenes$gene), message = "Scaling data...", value=1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
737
738
      tempmarkers <- NULL
      tempdata <- NULL
Bagueneau Mathias's avatar
Bagueneau Mathias committed
739
740
    } else { # Normal case
      topgenes <- filedata$data@misc$markers[[input$class_selector_heatmap]] %>% group_by(cluster) %>% top_n(n = input$top_genes_number_heatmap, wt = avg_logFC)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
741
      datascale <- withProgress(ScaleData(object = filedata$data,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
742
                                          features = topgenes$gene), message = "Scaling data...", value=1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
743
    }  # Heatmap generation
Bagueneau Mathias's avatar
Bagueneau Mathias committed
744
    heatmap_Data <- withProgress(DoHeatmap(object = datascale,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
745
                                           features = topgenes$gene,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
746
747
748
749
750
                                           group.by=input$class_selector_heatmap), message = "Heatmap Generation", value=1) +
      NoLegend() +
      ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$class_selector_heatmap,"- top",input$top_genes_number_heatmap,"genes")) +
      theme(plot.title = element_text(size=input$title_size_heatmap))

751
    output$heatmap <-renderPlot ({
Bagueneau Mathias's avatar
Bagueneau Mathias committed
752
753
      req(filedata$data)
      heatmap_Data
754
    })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
755

Bagueneau Mathias's avatar
Bagueneau Mathias committed
756
    output$dlbutton_heatmap <- renderUI ({ # Download
757
758
759
760
      downloadButton("dl_heatmap", label="Export Heatmap")
    })
    output$dl_heatmap <- downloadHandler(
      filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
761
        paste0(file_path_sans_ext(filedata$name),"_heatmap_",input$class_selector_heatmap,"_top",input$top_genes_number_heatmap,"genes",".png")
762
763
764
      },
      content = function(file) {
        png(file, width = 800, height = 600)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
765
        print(heatmap_Data)
766
767
768
        dev.off()
      }
    )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
769

770
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
771

772
  ## Genes Page --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
773
  observeEvent({list(input$class_selector_genes,input$group_selector_genes,input$gograph_genes,input$ontology_genes,input$title_size_genes)}, # Changing on of these inputs will update the text and announce that recalculation is needed.
Bagueneau Mathias's avatar
Bagueneau Mathias committed
774
775
               {req(input$go_go)
                 output$status_genes <- renderText({"Needs recalculation"})})
Bagueneau Mathias's avatar
Bagueneau Mathias committed
776

Bagueneau Mathias's avatar
Bagueneau Mathias committed
777
778
  observeEvent(input$go_go, {
    if (is.null(input$group_selector_genes)) {
779
      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
780
    } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
781
782
      output$status_genes <- renderText({""})
      if (is.null(filedata$data@misc$markers[[input$class_selector_genes]])) { # Case where the markers are not pre-calculated for the selected class
Bagueneau Mathias's avatar
Bagueneau Mathias committed
783
        showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
784
785
        tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
        Idents(tempdata) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_genes)))))
Bagueneau Mathias's avatar
Bagueneau Mathias committed
786
787
788
789
790
        tempmarkers <- withProgress(FindAllMarkers(tempdata,
                                                   assay = DefaultAssay(filedata$data),
                                                   test.use = "MAST",
                                                   only.pos = TRUE,
                                                   min.pct = 0.25,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
791
792
                                                   logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
        genes <- tempmarkers$cluster == input$group_selector_genes
793
        genes <- tempmarkers$gene[genes]
Bagueneau Mathias's avatar
Bagueneau Mathias committed
794
795
        tempmarkers <- NULL
        tempdata <- NULL
Bagueneau Mathias's avatar
Bagueneau Mathias committed
796
797
798
      } else { # Normal case
        genes <- filedata$data@misc$markers[[input$class_selector_genes]]$cluster == input$group_selector_genes
        genes <- filedata$data@misc$markers[[input$class_selector_genes]]$gene[genes]
799
      }
800
      genes <- bitr(genes, fromType = "SYMBOL",toType = "ENTREZID",OrgDb = org.Hs.eg.db,drop = TRUE)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
801
      go_Data <- withProgress(enrichGO(gene = genes$ENTREZID,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
802
                                       OrgDb = "org.Hs.eg.db",
Bagueneau Mathias's avatar
Bagueneau Mathias committed
803
804
                                       keyType= "ENTREZID",
                                       ont = input$ontology_genes,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
805
                                       readable = TRUE), value = 1, message = "Ontology in progress...")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
806

Bagueneau Mathias's avatar
Bagueneau Mathias committed
807
808
      isolate ({ # Graph data
        if (input$gograph_genes == "dplot") {
809
          goplot_Data <- dotplot(go_Data)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
810
        } else if (input$gograph_genes == "bplot") {
811
          goplot_Data <- barplot(go_Data, drop=TRUE)
812
        } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
813
          goplot_Data <- emapplot(go_Data)
814
        }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
815
        goplot_Data <- goplot_Data +
Bagueneau Mathias's avatar
Bagueneau Mathias committed
816
817
          ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology_genes,"-",input$class_selector_genes)) +
          theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_genes),panel.grid.minor=element_blank(),plot.background=element_blank())
818
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
819
820
821
      output$goplot_genes <-renderPlot ({
        req(filedata$data)
        goplot_Data
822
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
823

Bagueneau Mathias's avatar
Bagueneau Mathias committed
824
825
826
      dtgo_Data <- data.table(genes[1]) # Genes Table
      setDT(dtgo_Data)[]
      names(dtgo_Data)[1] <- "Gene"
Bagueneau Mathias's avatar
Bagueneau Mathias committed
827

Bagueneau Mathias's avatar
Bagueneau Mathias committed
828
829
      output$dt_genes <-renderDataTable ({
        datatable(dtgo_Data, filter="top", caption = paste("Table : Markers for the selected group(s) and class"))
830
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
831

Bagueneau Mathias's avatar
Bagueneau Mathias committed
832
833
      dtonto_Data <- data.table(go_Data$Description, go_Data$GeneRatio, go_Data$pvalue, go_Data$p.adjust, go_Data$geneID)[which(go_Data$Count > 3)] # Ontology Table
      colnames(dtonto_Data) <- c("Description","Gene Ratio","P-value","FDR","GeneID")
Bagueneau Mathias's avatar
Bagueneau Mathias committed
834

Bagueneau Mathias's avatar
Bagueneau Mathias committed
835
836
      output$dt_onto_genes <-renderDataTable ({
        datatable(dtonto_Data, 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)
837
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
838
839


Bagueneau Mathias's avatar
Bagueneau Mathias committed
840
841
842
      ## Downloads --
      output$dlgoplotbutton_genes <- renderUI ({ # Graph Download
        downloadButton("dlgoplot_genes", label="Export Graph")
843
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
844
      output$dlgoplot_genes <- downloadHandler(
845
        filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
846
          if (input$gograph_genes == "dplot") {
847
            goplot_type <- "_dotplot_"
Bagueneau Mathias's avatar
Bagueneau Mathias committed
848
          } else if (input$gograph_genes == "bplot") {
849
            goplot_type <- "_barplot_"
850
          } else {
851
            goplot_type <- "_emapplot_"
852
          }
853
          paste0(file_path_sans_ext(filedata$name),"_",input$ontology_genes,goplot_type,input$class_selector_genes,".png")
854
855
856
        },
        content = function(file) {
          png(file, width = 800, height = 600)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
857
          print(goplot_Data)
858
859
860
          dev.off()
        }
      )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
861

Bagueneau Mathias's avatar
Bagueneau Mathias committed
862
863
      output$dlgenedtbutton_genes <- renderUI ({ # Genes table Download
        downloadButton("dldt_genes", label="Export Table")
864
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
865
      output$dldt_genes <- downloadHandler(
866
        filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
867
          paste0(file_path_sans_ext(filedata$name),"_genes_datatable_",input$class_selector_genes,".csv")
868
869
        },
        content = function(file) {
870
          write.csv(dtgo_Data, file, row.names = FALSE)
871
872
        }
      )
Bagueneau Mathias's avatar
Bagueneau Mathias committed
873

Bagueneau Mathias's avatar
Bagueneau Mathias committed
874
875
      output$dlontodtbutton_genes <- renderUI ({ # Results of GO table Download
        downloadButton("dlontodt_genes", label="Export Table")
876
      })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
877
      output$dlontodt_genes <- downloadHandler(
878
        filename = function() {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
879
          paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology_genes,"_datatable_",input$class_selector_genes,".csv")
880
881
        },
        content = function(file) {
882
          write.csv(dtonto_Data, file, row.names = FALSE)
883
884
        }
      )
885
    }
886
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
887

888
  ## Compare Page 1 - Graphs generations, outputs and downloads --------
Bagueneau Mathias's avatar
Bagueneau Mathias committed
889
  observeEvent({list(input$group_selector1_compare,input$group_selector2_compare,input$addgroup_selector1_compare,input$addgroup_selector2_compare,
890
                     input$class_selector_compare,input$add_class_selector_compare,input$graph_compare,input$ptsize_compare, input$color_palettes_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
891
                     input$choice_compare,input$feature_selector_compare,input$qv_selector_compare,input$genes_list_compare, input$title_size_compare)}, # Changing on of these inputs will update the text and announce that recalculation is needed.
Bagueneau Mathias's avatar
Bagueneau Mathias committed
892
893
               {req(input$go_plots_compare)
                 output$status_plots_compare <- renderText({"Needs recalculation"})})
Bagueneau Mathias's avatar
Bagueneau Mathias committed
894
895

  all_class_colors_compare <- reactive ({ # List group <-> color for every class
896
    AllClassColors(filedata$data, input$color_palettes_compare) })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
897

Bagueneau Mathias's avatar
Bagueneau Mathias committed
898
  output$feature_choice_compare <- renderUI ({ # Choice : Genes or Quantitative Variable
899
    GenesOrQv("feature_selector_compare", "g2", "d2") })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
900

Bagueneau Mathias's avatar
Bagueneau Mathias committed
901
902
  output$qvariable_choice_compare <- renderUI({ # Qv select
    req(input$feature_selector_compare=="d2")
903
    QvChoices("qv_selector_compare", filedata$data) })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
904

Bagueneau Mathias's avatar
Bagueneau Mathias committed
905
906
907
  output$clusters_infos_compare  <- renderTable ({  # Clusters information text
    req(input$class_selector_compare != "")
    req(input$show_clusters_compare == "TRUE")
908
    ClustersInformation(filedata$data, input$class_selector_compare)},
Bagueneau Mathias's avatar
Bagueneau Mathias committed
909
910
911
    align="c", striped = TRUE,
    hover = TRUE, spacing = 'xs',
    width = '100%', colnames = FALSE, rownames=TRUE
Bagueneau Mathias's avatar
Bagueneau Mathias committed
912
913
  )

Bagueneau Mathias's avatar
Bagueneau Mathias committed
914
915
  output$select_infos_compare <- renderText({ # Selection information text
    req(filedata$data)
916
917
    SelectionInformation(filedata$data, input$class_selector_compare)
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
918

919
920
921
922
923
924
925
  miniplot_compareData <- reactive ({ # Mini Plot 1 Compare page
    withProgress(DimPlot(object = filedata$data,
                         label=TRUE,
                         pt.size = input$ptsize_compare,
                         legend="none",
                         reduction=input$graph_compare,
                         group.by = input$class_selector_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
926
927
928
929
930
931
                         cols = as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color"))) )), message = "Plot Generation", value=1)  +
      theme_bw() +
      theme(panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank()) +
      NoAxes() +
      NoLegend() +
      theme(aspect.ratio = 1)
932
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
933

934
935
936
937
938
939
940
  miniplot_compare2Data <- reactive ({ # Mini Plot 2 Compare page
    if (input$choice_compare == "features_compare") {
      if (input$feature_selector_compare =="d2") {
        featurevar <- input$qv_selector_compare
      } else if (input$feature_selector_compare =="g2") {
        featurevar <- input$genes_list_compare
      }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
941
942
943
944
      withProgress(FeaturePlot(object = filedata$data,
                               cols=c("lightgrey", AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)),
                               pt.size = input$ptsize_compare,
                               features = featurevar,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
945
                               reduction = input$graph_compare), message = "Plot Generation", value=1) +
Bagueneau Mathias's avatar
Bagueneau Mathias committed
946
947
948
949
950
951
        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) +
        theme(legend.text = element_blank())
952
953
    }
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
954

955
956
957
958
  output$miniplot_compare <- renderPlot({ # Output MiniPlot 1
    req(filedata$data)
    plot(miniplot_compareData())
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
959

960
961
962
  output$miniplot_compare2 <- renderPlot({ # Output MiniPlot 2
    req(filedata$data)
    plot(miniplot_compare2Data())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
963
  })
Bagueneau Mathias's avatar
Bagueneau Mathias committed
964
965


966
  observeEvent (input$go_plots_compare,  { # When click on button "Compute Plots"
Bagueneau Mathias's avatar
Bagueneau Mathias committed
967

Bagueneau Mathias's avatar
Bagueneau Mathias committed
968
    output$status_plots_compare <- renderText({""})
Bagueneau Mathias's avatar
Bagueneau Mathias committed
969

970
971
972
    # Data for Compare Left Plot
    cells_to_plot1_compare <- CellsToPlot(filedata$data, input$class_selector_compare, input$group_selector1_compare, input$add, input$add_class_selector_compare, input$addgroup_selector1_compare)
    metadata1_compare <- MetaData(cells_to_plot1_compare, filedata$data)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
973

974
975
976
    # Data for Compare Right Plot
    cells_to_plot2_compare <- CellsToPlot(filedata$data, input$class_selector_compare, input$group_selector2_compare, input$add, input$add_class_selector_compare, input$addgroup_selector2_compare)
    metadata2_compare <- MetaData(cells_to_plot2_compare, filedata$data)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
977
978


979
    # Left Plot Compare page
Bagueneau Mathias's avatar
Bagueneau Mathias committed
980
    if (input$choice_compare == "class_compare") {
981
982
983
984
985
      plot1_compareData <- withProgress(DimPlot(object = filedata$data,
                                                cells=rownames(cells_to_plot1_compare@meta.data),
                                                label=FALSE,
                                                pt.size = input$ptsize_compare,
                                                reduction=input$graph_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
986
                                                group.by = input$class_selector_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
987
988
989
990
991
992
993
994
995
                                                cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector1_compare)]), "#000000")), message = "Plot Generation", value=1) +
        NoLegend() +
        theme_bw() +
        NoAxes() +
        ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$class_selector_compare)) +
        Scalex(filedata$data, input$graph_compare) +
        Scaley(filedata$data, input$graph_compare) +
        theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_compare),panel.grid.minor=element_blank(),plot.background=element_blank()) +
        theme(aspect.ratio = 1)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
996
    } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
997
      if (input$feature_selector_compare =="d2") {
998
        featurevar <- input$qv_selector_compare
Bagueneau Mathias's avatar
Bagueneau Mathias committed
999
      } else if (input$feature_selector_compare =="g2") {
1000
        featurevar <- input$genes_list_compare
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1001
      }
1002
      feature_palette <- AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)
1003
1004
      plot1_compareData <- withProgress(FeaturePlot(object = filedata$data,
                                                    cells = rownames(cells_to_plot1_compare@meta.data),
1005
                                                    cols = ScaleColors(filedata$data, featurevar, cells_to_plot1_compare, feature_palette),
1006
1007
                                                    pt.size = input$ptsize_compare,
                                                    features = featurevar,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1008
1009
1010
1011
1012
1013
1014
1015
1016
                                                    reduction = input$graph_compare), message = "Plot Generation", value=1) +
        theme_bw() +
        NoAxes() +
        ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
        theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_compare),panel.grid.minor=element_blank(),plot.background=element_blank()) +
        Scalex(filedata$data, input$graph_compare) +
        Scaley(filedata$data, input$graph_compare) +
        theme(aspect.ratio = 1) +
        theme(legend.text = element_blank())
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1017
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1018

1019
    # Right Plot Compare page
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1020
    if (input$choice_compare == "class_compare") {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1021
      plot2_compareData <- withProgress(DimPlot(object = filedata$data,
1022
                                                cells = rownames(cells_to_plot2_compare@meta.data),
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1023
                                                pt.size = input$ptsize_compare,
1024
                                                reduction = input$graph_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1025
                                                group.by = input$class_selector_compare,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1026
                                                cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector2_compare)]), "#000000")), message = "Plot Generation", value=1) +
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1027
1028
1029
1030
1031
1032
1033
1034
        NoLegend() +
        theme_bw() +
        NoAxes() +
        ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_compare)) +
        theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_compare),panel.grid.minor=element_blank(),plot.background=element_blank()) +
        Scalex(filedata$data, input$graph_compare) +
        Scaley(filedata$data, input$graph_compare) +
        theme(aspect.ratio = 1)
1035
    } else {
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1036
      if (input$feature_selector_compare =="d2") {
1037
        featurevar <- input$qv_selector_compare
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1038
      } else if (input$feature_selector_compare =="g2") {
1039
        featurevar <- input$genes_list_compare
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1040
      }
1041
      feature_palette <- AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1042
1043
1044
      plot2_compareData <- withProgress(FeaturePlot(object = filedata$data,
                                                    cells = rownames(cells_to_plot2_compare@meta.data),
                                                    cols = ScaleColors(filedata$data, featurevar, cells_to_plot2_compare, feature_palette),
1045
1046
                                                    pt.size = input$ptsize_compare,
                                                    features = featurevar,
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1047
1048
1049
1050
1051
1052
1053
1054
1055
                                                    reduction = input$graph_compare), message = "Plot Generation", value=1) +
        theme_bw() +
        NoAxes() +
        ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
        theme(panel.grid.major=element_blank(),plot.title = element_text(size=input$title_size_compare),panel.grid.minor=element_blank(),plot.background=element_blank()) +
        Scalex(filedata$data, input$graph_compare) +
        Scaley(filedata$data, input$graph_compare) +
        theme(aspect.ratio = 1) +
        theme(legend.text = element_blank())
1056
    }
Bagueneau Mathias's avatar
Bagueneau Mathias committed
1057

1058
    output$plot1_compare <- renderPlotly ({ # Output Plot 1