-
Notifications
You must be signed in to change notification settings - Fork 0
/
app.R
2280 lines (2120 loc) · 124 KB
/
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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
292
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
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
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
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
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
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# BiocManager::repositories(site_repository = character(), version = BiocManager::version())
# getOption("repos")
library(rmarkdown)
library(shiny)
library(rsconnect)
library(iasva)
library(sva)
library(zinbwave)
library(SummarizedExperiment)
library(SingleCellExperiment)
library(DelayedArray)
library(irlba)
library(Rtsne)
library(stats)
library(RColorBrewer)
library(pheatmap)
library(corrplot)
library(org.Hs.eg.db)
library(org.Mm.eg.db)
library(org.Rn.eg.db)
library(clusterProfiler)
library(udunits2)
library(DOSE)
library(edgeR)
library(scran)
library(preprocessCore)
library(corrplot)
library(ggplot2)
library(plotly)
library(DT)
library(shinythemes)
library(rintrojs)
library(htmlwidgets)
################################################################################################################
# Define UI
################################################################################################################
ui <- shinyUI(fluidPage(theme = shinytheme("cerulean"),
# code to track app usage
tags$head(includeScript("google-analytics.js")),
# Application title
titlePanel(div("V-SVA: A Shiny app for Visual Surrogate Variable Analysis",
img(height = 88, width = 217,
src = "jax.logo.gif",
class = "pull-right"))),
# side bar where user first interacts
sidebarPanel(
# call function to use package rintrojs
introjsUI(),
# add first button for guided tutorial
div(style="display: inline-block;vertical-align:top; width: 200px;",
introBox(
actionButton("help", "Guided Tutorial!", icon = icon("list-ol")),
data.step = 1,
data.intro = "This is the start of the tutorial. Click 'Next Step' to continue."
)
),
# Or provide download button for manual
div(style="display: inline-block;vertical-align:top; width: 200px;",
introBox(
downloadButton("Download_Manual", "Download Tutorial"),
data.step = 2,
data.intro = "Click this button to download an in-depth tutorial/manual for this app."
)
),
# download test datasets
div(style="display: inline-block;vertical-align:top; width: 200px;",
introBox(
downloadButton("Download_Test_Exp", "Download Test Expression"),
data.step = 3,
data.intro = "Click this button to download an example gene expression file. This file may be used to test out the app."
)
),
div(style="display: inline-block;vertical-align:top; width: 200px;",
introBox(
downloadButton("Download_Test_Meta", "Download Test Metadata"),
data.step = 4,
data.intro = "Click this button to download an example sample metadata file. This file may be used to test out the app."
)
),
# Load user data
introBox(
h4("1. Load Data"),
fileInput(
inputId = "input_exprs",
"(Required) Choose gene/ADT file to upload",
accept = c(
".Rds",
".csv",
".txt"
)
),
# conditional panel if they have metadata
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "have_meta", label = "Do You Have Sample Metadata?",
choices = c("Yes", "No"),
selected = "No")
),
conditionalPanel(
condition = "input.have_meta == 'Yes'",
fileInput(
inputId = "input_meta",
"(Optional) Choose sample metadata file to upload",
accept = c(
".Rds",
".csv",
".txt"
)
)
),
data.step = 5, data.intro = "Click the Browse buttons to provide your gene/ADT expression data.
Gene expression data should be in the format of: gene symbol names in rows, sample names in columns.
Providing sample metadata is optional. If you do choose to provide metadata, the file should be formatted such that
sample names are in the rows and meta data variables are in columns. Step 1: The following input file formats are accepted: .Rds, tab-delimited text, .csv."),
# optional step to remove poor quality cells
introBox(
h5("2a. Cell/Sample Filtering (Optional)"),
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "cellfilt", label = "Filter Cells/Samples?",
choices = c("Yes", "No"),
selected = "No")
),
conditionalPanel(
condition = "input.cellfilt == 'Yes'",
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "cellfilt_num", label = "Minimum Genes Detected in each Cell",
min = 0, value = 500)),
br(),
shiny::actionButton("Run_cellfilt", "Run Cell Filtering", icon = icon("paper-plane"))
),
data.step = 6, data.intro = "Remove low-quality cells based on the number of genes detected (at least one read count) in each cell.
Please select yes or no from the drop down menu to indicate if you would like to filter cells.
If you choose yes, specify a minimum number of genes detected in each cell."
),
# optional step to down-sample cells
introBox(
h5("2b. Down-sample Cells (Optional)"),
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "downsample", label = "Down-sample?",
choices = c("Yes", "No"),
selected = "No")
),
conditionalPanel(
condition = "input.downsample == 'Yes'",
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "downsample_num", label = "Minimum number of cells",
min = 0, value = 100)),
br(),
shiny::actionButton("Run_downsample", "Run Cell Down-sampling", icon = icon("paper-plane"))
),
data.step = 7, data.intro = "For large datasets, users may choose to randomly down-sample to a specified number of samples to decrease
computational time for downstream analyses. Note down-sampling may reduce power of analyses. Please select yes or no from the drop down menu to indicate if you would like to down-sample your data.
If you choose yes, specify a minimum number of samples to randomly down-sample to."
),
# choose gene filtering and normalization methods
introBox(
h5("2c. Gene Filtering and Normalization (Optional)"),
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "gene_filter", label = "Filter Genes?",
choices = c("Yes", "No"),
selected = "No")
),
conditionalPanel(
condition = "input.gene_filter == 'Yes'",
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "Count_num", label = "# of Feature Counts in each Cell",
min = 0, value = 5)),
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "Cell_num", label = "Feature Detected in # of Cells",
min = 0, value = 5)),
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "norm_method", label = "Normalization Method",
choices = c("CPM", "Quantile", "scran", "None"), selected = "CPM")),
br(),
shiny::actionButton("Run_gene_filter", "Run Gene Filtering", icon = icon("paper-plane"))
),
data.step = 8, data.intro = "Users have the option to remove lowly expressed genes from their data. If 'yes' is chosen, please specify the criteria to filter genes. E.g., genes with 3 or more counts in at least 5 cells. Next, from the drop-down menu, select your desired normalization method. If no is chosen, move on to the next step.
CPM = Counts per million from edgeR package, Quantile = quantile normalization from preprcessCore R package,
scran = method to deconvolute size factors from cell pools from scran R package."
),
introBox(
# after the user loads the data, update the select input options to reflect metadata table column names
h4("3. Specify Known Factors to Adjust For"),
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "known_factors", label = "Known Factors",
choices = c(""), selected = NULL, multiple = TRUE)),
data.step = 9, data.intro = "Click in the box to select the known factor(s) from your metadata file you would like to adjust for. You may choose a single or multiple factors.
If no metadata file was provided, two factors Genes_Detected (number of genes detected in each sample) and Log_Total_Counts (log transformed total read counts in each sample) will be calculated for you.
Please note, at least one known factor must be selected prior to SVA analysis."
),
introBox(
# section for sva analysis
h4("4. SVA Analysis"),
# first choose your SVA method
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "sva_method", label = "SVA Method",
choices = c("IA-SVA", "SVA", "ZINB-WaVE"),
selected = "IA-SVA")),
# conditional panels for IA-SVA:
conditionalPanel(
condition = "input.sva_method == 'IA-SVA'",
# display the choices for pct cutoff or num.sv
# either choose pct cutoff or num.sv parameter
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "iasva_param", label = "Parameter Choice",
choices = c("Percentage Threshold", "Number of SVs"),
selected = "Percentage Threshold")),
# conditional panel to choose parameter for IA-SVA analysis (percent threshold)
conditionalPanel(
condition = "input.iasva_param == 'Percentage Threshold'",
# options to customize parameters
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "pct_cutt", label = "% Threshold for SV retention", value = 1,
min = 1, max = 99))
),
# conditional panel to choose parameter for IA-SVA analysis (number of sv's)
conditionalPanel(
condition = "input.iasva_param == 'Number of SVs'",
# options to customize parameters
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "num_of_svs", label = "Number of SVs to Estimate", value = 5,
min = 1, max = 99))
)
),
# conditional panel for SVA method:
conditionalPanel(
condition = "input.sva_method == 'SVA'",
# options to customize parameters
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "sva_num", label = "Number of SVs to Estimate", value = 5,
min = 1, max = 99))
),
# conditional panel for zinb-wave method:
conditionalPanel(
condition = "input.sva_method == 'ZINB-WaVE'",
# options to customize parameters
div(style="display: inline-block;vertical-align:top; width: 200px;",
numericInput(inputId = "zinb_num", label = "Number of Latent Factors to Estimate", value = 5,
min = 1, max = 99))
),
br(),
# button to run sva analysis
shiny::actionButton("do", "Run Analysis", icon = icon("paper-plane"), class = "btn-primary"),
data.step = 10, data.intro = "Click this button to run SVA and identify unknown sources (surrogate variables) of variation within your data.
Step 4: For IA-SVA method: 'Percentage threshold for SV retention': IA-SVA computes the percentage of unmodeled variance explained by the putative hidden factor and compare it with the user-defined threshold. If the percentage is greater than the threshold, SV is retained.
Alternatively, 'Number of SVs' forces IA-SVA to estimate a specified number of SVs."
),
br(),
h4("Author/Contact: "),
introBox(
tags$div(class = "header", checked = NA,
tags$i("Nathan Lawlor")
),
h4("Questions/Issues?: "),
tags$div(class = "header", checked = NA,
tags$i(""),
tags$p(""),
tags$a(href = "https://github.com/nlawlor/iasva_shiny",
"Visit the App Github Page Here!", target = "_blank")),
h4("Other Resources: "),
tags$div(class = "header", checked = NA,
tags$i(""),
tags$p(""),
tags$a(href = "https://www.jax.org/research-and-faculty/research-labs/the-ucar-lab",
"Visit the Ucar Lab Here!", target = "_blank")),
data.step = 11, data.intro = "Please visit the Github page with any questions about the app. Also, checkout the resources below!")
),
# main panel with multiple tabs: detect SVs, find marker genes, annotate genes, visualize data with tsne
introBox(
mainPanel(
tabsetPanel(
tabPanel("Data/QC",
verbatimTextOutput("exp_load"),
br(),
# add two plots below this text output with qc stats
downloadButton("Download_QC", "Download Histogram"),
plotOutput("Detect", height = 600, width = 600),
br(),
verbatimTextOutput("meta_load"),
verbatimTextOutput("cell_filtering_summ"),
verbatimTextOutput("cell_downsampling_summ"),
verbatimTextOutput("gene_filtering_summ"),
verbatimTextOutput("load_data")
),
tabPanel("Surrogate Variables",
fluidRow(
tags$div(
tags$h5("Graphing Options")),
# specify how to color points in all sv plot
div(style="display: inline-block;vertical-align:left; width: 200px;",
selectInput(inputId = "All_SV_Color", label = "Color Points",
choices = c(""), selected = NULL, multiple = FALSE)),
div(style="display: inline-block;vertical-align:left; width: 200px;",
selectInput(inputId = "All_SV_Num", label = "SV's to Plot",
choices = c(""), selected = NULL, multiple = TRUE)),
br(),
shiny::actionButton("updateAllSV", "Update Plots", icon = icon("refresh")),
align="left"),
div(style="display: inline-block;vertical-align:left; width: 800px;",
h4("Correlation Plot"),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("Download_Correlation", "Download Correlation Plot")
),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("Download_Correlation_Table", "Download Correlation Table")
),
plotOutput("corrplot", width = 800, height = 800)
),
div(style="display: inline-block;vertical-align:right; width: 800px;",
h4("Surrogate Variables Plot"),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("Download_SVs", "Download SV Plot")
),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("Download_SVs_Table", "Download SV Table")
),
plotOutput("SVplot", width = 800, height = 800)
)),
tabPanel("Pairwise Surrogate Variable",
downloadButton("Download_Pairwise", "Download Pairwise Plot"),
fluidRow(
column(width = 3,
tags$div(
tags$h5("")),
# specify how to color points in pairwise plot, which svs to visualize
div(style="display: inline-block;vertical-align:top; width: 200px;",
selectInput(inputId = "Pair_SV_Color", label = "Color Points",
choices = c(""), selected = NULL, multiple = FALSE)),
div(style="display: inline-block;vertical-align:top; width: 100px;",
selectInput(inputId = "sv_x", label = "SV X-axis",
choices = c(""), selected = NULL, multiple = FALSE)),
div(style="display: inline-block;vertical-align:top; width: 100px;",
selectInput(inputId = "sv_y", label = "SV Y-axis",
choices = c(""), selected = NULL, multiple = FALSE)),
shiny::actionButton("updatePairSV", "Update Pairwise SV Plot", icon = icon("refresh"), class = "btn-primary"),
align="left"),
column(width = 9, plotlyOutput("PairSV", height = 600, width = 600)))),
tabPanel("Identify Marker Genes",
br(),
# Select svs to choose for marker gene identification
selectInput(inputId = "SV_marks", label = "Choose SVs",
choices = "", multiple = TRUE, selected = NULL),
# specify mult testing correction
selectInput(inputId = "mark_sig", label = "P-Value Adjustment",
choices = c("BH", "bonferroni", "none"),
selected = "BH"),
# specify how to color points in all sv plot
div(style="display: inline-block;vertical-align:left; width: 200px;",
# specify sig cutof
numericInput(inputId = "mark_cutoff", label = "Adjusted P-value cutoff",
min = 0, max = 1, value = 0.05, step = 0.05)
),
div(style="display: inline-block;vertical-align:left; width: 200px;",
# specify r2 cutoff
numericInput(inputId = "rsqcutoff", label = "R-squared cutoff",
min = 0, max = 1, value = 0.3, step = 0.1)
),
br(),
# identify known factors to include in heatmap
selectInput(inputId = "heatmap_known_factors", label = "Known Factors to Include in Heatmap",
choices = c(""), selected = NULL, multiple = TRUE),
br(),
shiny::actionButton("FindGenes", "Identify Marker Genes", icon = icon("search"), class = "btn-primary"),
downloadButton("Download_Heatmap", "Download Heatmap"),
plotOutput("MarkerHeatmap", height = 800, width = 800),
# add marker genes after heatmap
br(),
h4("Marker Genes Table: "),
downloadButton("Download_Markers", "Download Marker Genes Table"), DT::dataTableOutput("genes_table")
),
# dimension reduction and clustering
tabPanel("Visualization with Marker Genes",
# choose dimension reduction method
selectInput(inputId = "Dim_Type", label = "Dimension Reduction",
choices = c("PCA", "t-SNE", "Classical Metric MDS"), multiple = FALSE,
selected = "PCA"),
# choose variable to color points
selectInput(inputId = "Dim_Color", label = "Color Points",
choices = "", multiple = FALSE,
selected = NULL),
# this button compute the pca/tsne
shiny::actionButton("Dim_Analysis", "Run Dimension Reduction Analysis", icon = icon("paper-plane"), class = "btn-primary"),
# this button can be used to just change plot coloring (after computing tsne/pca)
shiny::actionButton("Update_Dim", "Update Plot Point Colors", icon = icon("refresh")),
br(),
br(),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("download_dim_all", "Download All Genes Plot")
),
div(style="display: inline-block;vertical-align:left; width: 200px;",
downloadButton("download_all_coordinates", "Download All Genes Coordinates")
),
br(),
# plot with all genes
div(style="display: inline-block;vertical-align:left; width: 1000px;",
plotlyOutput("Dim_Plot_Orig", height = 800, width = 1000)),
br(),
# plot with sva marker genes
div(style="display: inline-block;vertical-align:left; width: 250px;",
downloadButton("download_dim_marker", "Download Marker Genes Plot")
),
div(style="display: inline-block;vertical-align:left; width: 250px;",
downloadButton("download_marker_coordinates", "Download Marker Genes Coordinates")
),
div(style="display: inline-block;vertical-align:left; width: 1000px;",
plotlyOutput("Dim_Plot_Markers", height = 800, width = 1000))
),
# gene enrichment analysis figure and table
tabPanel("Gene Enrichment Analysis",
# indicate species type first
selectInput(inputId = "Species_Type", label = "Species",
choices = c("Homo sapiens", "Mus musculus",
"Rattus norvegicus"), multiple = FALSE,
selected = "Homo sapiens"),
# add conditional panel for available pathways for each species type
conditionalPanel(
condition = "input.Species_Type == 'Homo sapiens'",
# all pathway types should be available
selectInput(inputId = "Path_Type", label = "Enrichment Analysis Type",
choices = c("Gene Ontology Biological Process",
"Gene Ontology Cellular Component",
"Gene Ontology Molecular Function",
"KEGG", "Homo sapiens Immune Modules",
"Homo sapiens PBMC Cell Specific Modules",
"Homo sapiens Cell Cycle Genes",
"Custom"),
multiple = FALSE,
selected = "Gene Ontology Biological Process")
),
# condition for mice
conditionalPanel(
condition = "input.Species_Type == 'Mus musculus'",
# only some pathways types should be available
selectInput(inputId = "Path_Type", label = "Enrichment Analysis Type",
choices = c("Gene Ontology Biological Process",
"Gene Ontology Cellular Component",
"Gene Ontology Molecular Function",
"KEGG", "Mus musculus Cell Cycle Genes",
"Custom"),
multiple = FALSE,
selected = "Gene Ontology Biological Process")
),
# condition for rats
conditionalPanel(
condition = "input.Species_Type == 'Rattus norvegicus'",
# only some pathways types should be available
selectInput(inputId = "Path_Type", label = "Enrichment Analysis Type",
choices = c("Gene Ontology Biological Process",
"Gene Ontology Cellular Component",
"Gene Ontology Molecular Function",
"KEGG", "Rattus norvegicus Cell Cycle Genes",
"Custom"),
multiple = FALSE,
selected = "Gene Ontology Biological Process")
),
# add conditional panel for custom gene lists
conditionalPanel(
condition = "input.Path_Type == 'Custom'",
fileInput(
inputId = "input_gene_mod",
"Upload custom gene and module file",
accept = ".txt"
)
),
conditionalPanel(
condition = "input.Path_Type == 'Custom'",
fileInput(
inputId = "input_mod_names",
"Upload custom module identifier file",
accept = ".txt"
)
),
# specify p-value threshold
div(style="display: inline-block;vertical-align:left; width: 200px;",
numericInput(inputId = "pvalue_cutoff", label = "P-value cutoff",
min = 0, max = 1, value = 0.05, step = 0.05)
),
# specify p-value adjustment method
div(style="display: inline-block;vertical-align:left; width: 200px;",
selectInput(inputId = "pvalue_correct", label = "P-value Adjustment",
choices = c("BH", "bonferroni", "none"),
selected = "BH")
),
# specify sig cutof
div(style="display: inline-block;vertical-align:left; width: 200px;",
numericInput(inputId = "path_cutoff", label = "Adjusted P-value cutoff",
min = 0, max = 1, value = 0.05, step = 0.05)
),
br(),
# indicate max num of results to display
div(style="display: inline-block;vertical-align:left; width: 200px;",
numericInput(inputId = "path_viz_num", label = "Max # of Results to Visualize",
min = 0, value = 10, step = 1)
),
br(),
shiny::actionButton("Path_Analysis", "Run Enrichment Analysis", icon = icon("paper-plane"), class = "btn-primary"),
downloadButton("Download_path_plot", "Download Enrichment Analysis Plot"),
plotOutput("Enrich_Plot", height = 800, width = 800),
# tabPanel("Gene Enrichment Analysis Table",
# include table of pathway results
br(),
h4("Gene Enrichment Analysis Table"),
downloadButton("Download_path_table", "Download Enrichment Analysis Results Table"),
DT::dataTableOutput("enrich_table")
# end of pathway panel
),
tabPanel("Download a Report of Code Used",
# download a report of code
downloadButton("report", "Generate report")
)
)
)
)
)
)
################################################################################################################
# Define server logic required to plot data
################################################################################################################
server <- shinyServer(function(input, output, session) {
set.seed(1)
# file upload size limit (set to 2000 MB)
options(shiny.maxRequestSize=2000*1024^2)
# color function
color.vec <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99", "#e31a1c",
"#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a", "#ffff99", "#b15928", "black")
# reactive values to store data
dataTables <- reactiveValues(
meta_df = NULL,
cell_filter_choice = FALSE,
cell_downsample_choice = FALSE,
gene_filter_choice = FALSE,
cellfilt_number = NULL,
cell_downsample_number = NULL,
gene_filter_method = NULL,
gene_count_num = NULL,
gene_cell_num = NULL,
detect_num = NULL,
exp_norm = NULL,
sva_method_use = NULL,
iasva.res = NULL,
known_factors_use = NULL,
summ_exp = NULL,
markers = NULL,
iasva_vars = NULL,
markers_formatted = NULL,
chosen_svs = NULL,
gene.df = NULL,
species = NULL,
species_kegg = NULL,
univ_gene = NULL,
enrich_res = NULL,
category_number = NULL,
pathway_name = NULL,
dim_method = NULL,
pre_dim_mark = NULL,
pre_dim_orig = NULL,
dim_mark = NULL,
dim_orig = NULL
)
# load in expression data, check file extension
observeEvent(input$input_exprs, {
if (grepl(x = input$input_exprs$datapath, pattern = ".csv")) {
withProgress(expr = dataTables$exp_norm <- read.csv(file = input$input_exprs$datapath,
header = T, check.names = F, stringsAsFactors = F, row.names = 1),
message = "Loading expression file, please wait")
} else if (grepl(x = input$input_exprs$datapath, pattern = ".txt")) {
withProgress(expr = dataTables$exp_norm <- read.delim(file = input$input_exprs$datapath,
header = T, check.names = F, stringsAsFactors = F, row.names = 1),
message = "Loading expression file, please wait")
} else if (grepl(x = input$input_exprs$datapath, pattern = ".Rds")) {
withProgress(expr = dataTables$exp_norm <- readRDS(file = input$input_exprs$datapath),
message = "Loading expression file, please wait")
}
# change file to matrix
dataTables$exp_norm <- as.matrix(dataTables$exp_norm)
# message to display
output$exp_load <- renderText({
print(paste("Expression file loaded! \n",
"Gene number: ", isolate(nrow(dataTables$exp_norm)), " \n",
"Cell number: ", isolate(ncol(dataTables$exp_norm)), " \n",
sep = ""))
})
# display a histogram of genes detected to help with filtering of cells
output$Detect <- renderPlot({
# validate
shiny::validate(
need(isolate(input$input_exprs$datapath != ""), "Error: No gene/ADT file loaded")
)
isolate({
withProgress(message = "Plotting the number of detected genes in each sample, please wait", {
# binarize data
bin_data <- dataTables$exp_norm
bin_data[bin_data < 1] <- 0
bin_data[bin_data >= 1] <- 1
num.exp <- apply(bin_data,2,sum)
dataTables$detect_num <- num.exp
summ <- summary(num.exp)
hist(num.exp, col = "dodgerblue", main="",
ylab = "Samples (n)", xlab = "Number of genes detected in each sample")
legend("topright", legend = paste(names(summ), round(summ, digits = 2), sep = " "), title = "Summary of genes detected")
# create a meta data object by default
dataTables$meta_df <- data.frame(Genes_Detected = num.exp, Log_Total_Counts = log(colSums(dataTables$exp_norm)+1))
# change all variables to factors
for (fac in 1:ncol(dataTables$meta_df)) {
dataTables$meta_df[, fac] <- as.factor(dataTables$meta_df[, fac])
}
# identify variables in meta data
updateSelectInput(session = session, inputId = "known_factors", label = "Known Factors",
choices = colnames(dataTables$meta_df))
updateSelectInput(session = session, inputId = "heatmap_known_factors", label = "Known Factors to Include in Heatmap",
choices = c(colnames(dataTables$meta_df), "None"))
# make progress bar seen
for (i in 1:5) {
incProgress(1/5)
Sys.sleep(0.25)
}
})
})
})
})
observeEvent(input$input_meta, {
# load in metadata
if (grepl(x = input$input_meta$datapath, pattern = ".csv")) {
withProgress(expr = dataTables$meta_df <- read.csv(file = input$input_meta$datapath,
header = T, check.names = F, stringsAsFactors = F, row.names = 1),
message = "Loading metadata file, please wait")
} else if (grepl(x = input$input_meta$datapath, pattern = ".txt")) {
withProgress(expr = dataTables$meta_df <- read.delim(file = input$input_meta$datapath,
header = T, check.names = F, stringsAsFactors = F, row.names = 1),
message = "Loading metadata file, please wait")
} else if (grepl(x = input$input_meta$datapath, pattern = ".Rds")) {
withProgress(expr = dataTables$meta_df <- readRDS(file = input$input_meta$datapath),
message = "Loading metadata file, please wait")
}
dataTables$meta_df <- as.data.frame(dataTables$meta_df)
# change all variables to factors
for (fac in 1:ncol(dataTables$meta_df)) {
dataTables$meta_df[, fac] <- as.factor(dataTables$meta_df[, fac])
}
# identify variables in meta data
updateSelectInput(session = session, inputId = "known_factors", label = "Known Factors",
choices = colnames(dataTables$meta_df))
updateSelectInput(session = session, inputId = "heatmap_known_factors", label = "Known Factors to Include in Heatmap",
choices = c(colnames(dataTables$meta_df), "None"))
# render summary of metadata file
output$meta_load <- renderText({
# if metadata and exp files are different
# the expression and metadata tables need to have same number of rows and columns
shiny::validate(
need(isolate(ncol(dataTables$exp_norm)) == isolate(nrow(dataTables$meta_df)), "Error: Sample metadata file row number is not equal to Expression file column number!")
)
print(paste("Metadata file loaded! \n",
"Cell number: ", isolate(nrow(dataTables$meta_df)), " \n",
"# of metadata variables: ", isolate(ncol(dataTables$meta_df)), " \n",
sep = ""))
})
})
# shiny app error validation for loading data, and plots, tables
# validate functions must go inside the plot/table rendering functions
# option could be to have a data loading panel in which we provide qc and make sure the data is loaded properly
# this first panel would also conduct all iasva analyses
valid_load <- function() {
shiny::validate(
# adding an isolate() will make the error messages only appear/disappear when click run analysis button
# before can run ia-sva need to have loaded data
need(isolate(dataTables$exp_norm != ""), "Error: Please load a gene/ADT file before running SVA"),
need(isolate(dataTables$meta_df != ""), "Error: Please load a metadata file before running SVA"),
# make sure specify known variables
need(isolate(input$known_factors != ""), "Error: Please specify known factor(s) to adjust for before running SVA"),
# maybe have option to specify no variables?
need(isolate(input$pct_cutt >= 1), "Error: Percent threshold must be greater than or equal to 1"),
need(isolate(input$num_of_svs >= 1), "Error: Number of SVs to estimate must be greater than or equal to 1"),
need(isolate(input$pct_cutt < 100), "Error: Percent threshold must be less than 100"),
# cell filtering
need(isolate(input$Cell_num >= 0), "Error: Number of cells must be greather than or equal to 0"),
need(isolate(input$Count_num >= 0), "Error: Number of gene/ADT counts must be greather than or equal to 0"),
# check for numeric inputs
need(isolate(is.numeric(input$pct_cutt)), "Error: Percent threshold must be numeric"),
need(isolate(is.numeric(input$num_of_svs)), "Error: Number of SVs to estimate must be a numeric value"),
need(isolate(is.numeric(input$Cell_num)), "Error: Number of cells must be numeric"),
need(isolate(is.numeric(input$Count_num)), "Error: Number of gene/ADT counts must be numeric"),
# the expression and metadata tables need to have same number of rows and columns
need(ncol(dataTables$exp_norm) == nrow(dataTables$meta_df), "Error: Sample metadata file row number is not equal to Expression file column number!")
)
}
valid_downsample <- function() {
shiny::validate(
# if user chooses a downsampling number, make sure the number is greater than the input expression size
need(isolate(dataTables$exp_norm != ""), "Error: Please load a gene/ADT file before running SVA"),
need(isolate(dataTables$meta_df != ""), "Error: Please load a metadata file before running SVA"),
need(ncol(dataTables$exp_norm) == nrow(dataTables$meta_df), "Error: Sample metadata file row number is not equal to Expression file column number!"),
need(isolate(is.numeric(input$downsample_num)), "Error: Down-sampling value must be numeric"),
need(isolate(ncol(dataTables$exp_norm) >= input$downsample_num), "Error: Down-sampling value too large, must be less than input sample size")
)
}
valid_iasva <- function() {
shiny::validate(
need(isolate(!is.null(dataTables$iasva.res)), "Error: No surrogate variables obtained... Please adjust input parameters")
)
}
# validation for surrogate variable pair plots
valid_pair_plot <- function() {
shiny::validate(
need(isolate(length(as.numeric(input$All_SV_Num)) >= 2), "Error: Please select 2 or more SVs in order to visualize this plot")
)
}
# validation for marker genes
valid_markers <- function() {
shiny::validate(
need(isolate(length(as.numeric(input$SV_marks)) >= 1), "Error: Please select 1 or more SVs to identify markers for"),
need(isolate(input$heatmap_known_factors != ""), "Error: Please specify known factor(s) to include in heatmap visualization"),
need(isolate(input$mark_cutoff > 0), "Error: Adjusted p-value cutoff must be greater than 0"),
need(isolate(input$mark_cutoff <= 1), "Error: Adjusted p-value cutoff must be less than or equal to 1"),
need(isolate(input$rsqcutoff > 0), "Error: R-squared cutoff must be greater than 0"),
need(isolate(input$rsqcutoff <= 1), "Error: R-squared cutoff must be less than or equal to 1")
)
}
# validation for enrichment analysis
valid_enrich <- function() {
shiny::validate(
need(isolate(length(as.numeric(input$SV_marks)) >= 1), "Error: Please select 1 or more SVs to identify markers for"),
need(isolate(!is.null(dataTables$markers)), "Error: No marker genes were identified... Please adjust r-squared and significance cutoffs and re-calculate before proceeding with enrichment analysis"),
need(isolate(input$pvalue_cutoff > 0), "Error: Enrichment analysis p-value cutoff must be greater than 0"),
need(isolate(input$pvalue_cutoff <= 1), "Error: Enrichment analysis p-value cutoff must be less than or equal to 1"),
need(isolate(input$path_cutoff > 0), "Error: Enrichment analysis adjusted p-value cutoff must be greater than 0"),
need(isolate(input$path_cutoff <= 1), "Error: Enrichment analysis adjusted p-value cutoff must be less than or equal to 1")
)
}
# shiny app error validation for dim plots
valid_dim <- function() {
shiny::validate(
need(isolate(!is.null(dataTables$markers)), "Error: No marker genes were identified... Please adjust r-squared and significance cutoffs and re-calculate before proceeding with dimension reduction analysis")
)
}
# observe for filtering of cells
observeEvent(input$Run_cellfilt, {
# filter cells based on numbers of genes detected (at least one count)
withProgress(message = paste("Removing cells that have less than ", isolate(input$cellfilt_num),
" genes detected, please wait", sep = ""), {
# use reactive value
num.sel <- dataTables$detect_num[dataTables$detect_num >= isolate(input$cellfilt_num)]
# make progress bar seen
for (i in 1:5) {
incProgress(1/5)
Sys.sleep(0.25)
}
# subset data
dataTables$exp_norm <- dataTables$exp_norm[, names(num.sel)]
dataTables$meta_df <- dataTables$meta_df[names(num.sel), ]
# change reactive value
dataTables$cell_filter_choice <- TRUE
dataTables$cellfilt_number <- input$cellfilt_num
})
})
# observe for down-sampling of data
observeEvent(input$Run_downsample, {
# ensure down-sample value is correct
valid_downsample()
set.seed(1)
dw_samp <- base::sample(x = isolate(1:ncol(dataTables$exp_norm)), size = isolate(input$downsample_num))
# subset data
withProgress(message = paste("Down-sampling data to ", isolate(input$downsample_num), " samples, please wait", sep = ""), {
dataTables$exp_norm <- dataTables$exp_norm[, dw_samp]
# make progress bar seen
for (i in 1:5) {
incProgress(1/5)
Sys.sleep(0.25)
}
})
dataTables$meta_df <- dataTables$meta_df[dw_samp, ]
# change reactive value
dataTables$cell_downsample_choice <- TRUE
dataTables$cell_downsample_number <- input$downsample_num
})
# filtering of genes
observeEvent(input$Run_gene_filter, {
# by filter genes with low counts
withProgress(expr = filter <- apply(dataTables$exp_norm, 1, function(x) length(x[x>isolate(input$Count_num)])>=isolate(input$Cell_num)),
message = "Filtering genes, please wait")
dataTables$exp_norm <- dataTables$exp_norm[filter,]
# normalize the data
if (isolate(input$norm_method) == "CPM") {
dataTables$exp_norm <- edgeR::cpm(dataTables$exp_norm)
} else if (isolate(input$norm_method) == "Quantile") {
dataTables$exp_norm <- normalize.quantiles(dataTables$exp_norm)
} else if (isolate(input$norm_method) == "scran") {
sce <- SingleCellExperiment(list(counts=dataTables$exp_norm))
sce <- computeSumFactors(sce)
sce <- normalize(sce)
dataTables$exp_norm <- exprs(sce)
} else if (isolate(input$norm_method) == "None") {
dataTables$exp_norm <- dataTables$exp_norm
}
# ensure that the gene and sample matrices are ordered the same
if (all(table(colnames(dataTables$exp_norm) == rownames(dataTables$meta_df))) == FALSE) {
id_samp <- NULL
withProgress(expr =
id_s <- match(colnames(dataTables$exp_norm), table = rownames(dataTables$meta_df))
# for (s_num in 1:nrow(dataTables$meta_df)) {
# id_s <- which(colnames(dataTables$exp_norm) == rownames(dataTables$meta_df)[s_num])
# id_samp <- c(id_samp, id_s)
# }
, message = "Gene/ADT and sample matrices have different name orders, re-ordering gene/ADT matrix now...")
dataTables$exp_norm <- dataTables$exp_norm[, id_s]
#dataTables$exp_norm <- dataTables$exp_norm[, id_samp]
} else {}
# update reactive value
dataTables$gene_filter_choice <- TRUE
dataTables$gene_filter_method <- input$norm_method
dataTables$gene_count_num <- input$Count_num
dataTables$gene_cell_num <- input$Cell_num
})
# output QC messages
output$cell_filtering_summ <- renderText({
if (dataTables$cell_filter_choice) {
print(paste("Cell filtering finished! \n",
"Current cell number: ", isolate(ncol(dataTables$exp_norm)), " \n",
sep = ""))
}
})
output$cell_downsampling_summ <- renderText({
if (dataTables$cell_downsample_choice) {
valid_downsample()
print(paste("Down-sampling finished! \n",
"Current cell number: ", isolate(ncol(dataTables$exp_norm)), " \n",
sep = ""))
}
})
output$gene_filtering_summ <- renderText({
if (dataTables$gene_filter_choice) {
print(paste("Gene filtering and normalization finished! \n",
"Current gene number: ", isolate(nrow(dataTables$exp_norm)), " \n",
sep = ""))
}
})
# extract known factors to adjust for, create model matrix
observeEvent(input$do, {
output$load_data <- renderText({
# error handling
valid_load()
# extract known factors
id_mod <- which(colnames(dataTables$meta_df) %in% isolate(input$known_factors))
if (length(id_mod) > 1) {
formdf1 <- as.formula(paste("~", colnames(dataTables$meta_df)[id_mod][1], "+", paste(colnames(dataTables$meta_df)[id_mod[2:length(id_mod)]],collapse="+"), sep = ""))
mod <- model.matrix(formdf1, data = dataTables$meta_df)
} else {
varf1 <- as.factor(dataTables$meta_df[, id_mod])
mod <- model.matrix(~varf1, data = dataTables$meta_df)
}
# create summarized experiment for expression matrix to later use for marker gene identification
summ_exp <- SummarizedExperiment(assays = as.matrix(dataTables$exp_norm))
dataTables$summ_exp <- summ_exp
# SVA analyses here
# if user chose IA-SVA, then perform following
if (isolate(input$sva_method == "IA-SVA")) {
# depending on which ia-sva parameters were chosen, evaluate
if (isolate(input$iasva_param == "Percentage Threshold")) {
dataTables$iasva.res <- withProgress(expr = fast_iasva(summ_exp, mod[,-1, drop = F], verbose=FALSE,
pct.cutoff = isolate(input$pct_cutt), num.sv = NULL),
message = "IA-SVA analysis in progress, please wait")
} else if (isolate(input$iasva_param == "Number of SVs")) {
dataTables$iasva.res <- withProgress(expr = fast_iasva(summ_exp, mod[,-1, drop = F], verbose=FALSE,
pct.cutoff = isolate(input$pct_cutt), num.sv = isolate(input$num_of_svs)),
message = "IA-SVA analysis in progress, please wait")
}
# else if choose SVA method
} else if (isolate(input$sva_method == "SVA")) {
# check parameters are correct
shiny::validate(
need(isolate(input$sva_num >= 1), "Error: Number of SVs to estimate must be greater than or equal to 1"),
need(isolate(is.numeric(input$sva_num)), "Error: Number of SVs to estimate must be a numeric value")
)
# perform sva analysis with specified svs
sva.res <- withProgress(expr = svaseq(dataTables$exp_norm, mod = mod, mod0 = mod[,1], n.sv = isolate(input$sva_num)),
message = "SVA analysis in progress, please wait")
colnames(sva.res$sv) <- paste("SV", 1:ncol(sva.res$sv), sep = "")
dataTables$iasva.res <- sva.res
# else if choose zinb-wave method
} else if (isolate(input$sva_method == "ZINB-WaVE")) {
# check that paramters are correct
# check parameters are correct
shiny::validate(
need(isolate(input$zinb_num >= 1), "Error: Number of latent factors to estimate must be greater than or equal to 1"),
need(isolate(is.numeric(input$zinb_num)), "Error: Number of latent factors to estimate must be a numeric value")
)
# perform analysis with specified latent factors
zinb.matrix <- dataTables$exp_norm
# coerce to integer
mode(zinb.matrix) <- "integer"
zinb.res <- withProgress(expr = zinbFit(Y = zinb.matrix, X = mod[,-1, drop = F], K = isolate(input$zinb_num)),
message = "ZINB-WaVE analysis in progress, please wait")
# extract factors
zinb.fac <- getW(zinb.res)
colnames(zinb.fac) <- paste("SV", 1:ncol(zinb.fac), sep = "")
dataTables$iasva.res <- list(sv = zinb.fac)
}
# if no SV's are calculated inform user
valid_iasva()
# display SV's
iasva.sv <- as.data.frame(dataTables$iasva.res$sv)
rownames(iasva.sv) <- colnames(dataTables$exp_norm)
# update coloring scheme for total plot
updateSelectInput(session = session, inputId = "All_SV_Color", label = "Color Points",
choices = c(colnames(dataTables$meta_df), "No Color"), selected = "No Color")
# update number of svs to visualize
updateSelectInput(session = session, inputId = "All_SV_Num", label = "SV Number",
choices = 1:ncol(iasva.sv), selected = 1:ncol(iasva.sv))
# update coloring scheme for pairwise
updateSelectInput(session = session, inputId = "Pair_SV_Color", label = "Color Points",
choices = c(colnames(dataTables$meta_df), "No Color"), selected = "No Color")
# update coloring scheme for dimension reduction plots
updateSelectInput(session = session, inputId = "Dim_Color", label = "Color Points",
choices = c(colnames(dataTables$meta_df), "No Color"), selected = "No Color")
# update sv x/y selections
updateSelectInput(session = session, inputId = "sv_x", label = "SV X-axis",
choices = colnames(iasva.sv), selected = "SV1")
updateSelectInput(session = session, inputId = "sv_y", label = "SV Y-axis",
choices = colnames(iasva.sv), selected = "SV2")
# update sv selections in marker panel
updateSelectInput(session = session, inputId = "SV_marks", label = "Choose SVs",
choices = colnames(iasva.sv), selected = "SV1")
# output messages
print(paste(isolate(input$sva_method), " analysis finished! \n",
"Number of SV's/Factors identified: ", isolate(ncol(dataTables$iasva.res$sv)), sep = ""))
})