... | ... |
@@ -39,21 +39,21 @@ Imports: |
39 | 39 |
boot, |
40 | 40 |
rhdf5, |
41 | 41 |
RUVSeq, |
42 |
- DT, |
|
43 |
- NMF, |
|
44 |
- ggplot2, |
|
45 |
- plotly, |
|
46 |
- reshape2, |
|
47 |
- visNetwork, |
|
48 | 42 |
rARPACK |
49 | 43 |
Suggests: |
50 | 44 |
BiocStyle, |
45 |
+ DT, |
|
46 |
+ ggplot2, |
|
51 | 47 |
knitr, |
52 | 48 |
miniUI, |
49 |
+ NMF, |
|
50 |
+ plotly, |
|
51 |
+ reshape2, |
|
53 | 52 |
rmarkdown, |
54 | 53 |
scRNAseq, |
55 | 54 |
shiny, |
56 |
- testthat |
|
55 |
+ testthat, |
|
56 |
+ visNetwork |
|
57 | 57 |
VignetteBuilder: knitr |
58 | 58 |
LazyLoad: yes |
59 | 59 |
biocViews: |
... | ... |
@@ -42,15 +42,7 @@ import(BiocParallel) |
42 | 42 |
import(SummarizedExperiment) |
43 | 43 |
import(gplots) |
44 | 44 |
import(methods) |
45 |
-import(plotly) |
|
46 |
-import(visNetwork) |
|
47 | 45 |
importClassesFrom(SummarizedExperiment,SummarizedExperiment) |
48 |
-importFrom(DT,dataTableOutput) |
|
49 |
-importFrom(DT,dataTableProxy) |
|
50 |
-importFrom(DT,formatSignif) |
|
51 |
-importFrom(DT,renderDataTable) |
|
52 |
-importFrom(DT,selectRows) |
|
53 |
-importFrom(NMF,aheatmap) |
|
54 | 46 |
importFrom(RColorBrewer,brewer.pal) |
55 | 47 |
importFrom(RUVSeq,RUVg) |
56 | 48 |
importFrom(aroma.light,normalizeQuantileRank.matrix) |
... | ... |
@@ -62,18 +54,6 @@ importFrom(compositions,clr) |
62 | 54 |
importFrom(diptest,dip.test) |
63 | 55 |
importFrom(edgeR,calcNormFactors) |
64 | 56 |
importFrom(fpc,pamk) |
65 |
-importFrom(ggplot2,aes) |
|
66 |
-importFrom(ggplot2,coord_cartesian) |
|
67 |
-importFrom(ggplot2,element_blank) |
|
68 |
-importFrom(ggplot2,geom_bar) |
|
69 |
-importFrom(ggplot2,geom_point) |
|
70 |
-importFrom(ggplot2,geom_violin) |
|
71 |
-importFrom(ggplot2,ggplot) |
|
72 |
-importFrom(ggplot2,guides) |
|
73 |
-importFrom(ggplot2,labs) |
|
74 |
-importFrom(ggplot2,scale_fill_manual) |
|
75 |
-importFrom(ggplot2,theme) |
|
76 |
-importFrom(ggplot2,ylim) |
|
77 | 57 |
importFrom(grDevices,colorRampPalette) |
78 | 58 |
importFrom(grDevices,dev.off) |
79 | 59 |
importFrom(grDevices,pdf) |
... | ... |
@@ -95,7 +75,6 @@ importFrom(matrixStats,colMedians) |
95 | 75 |
importFrom(matrixStats,rowMedians) |
96 | 76 |
importFrom(mixtools,normalmixEM) |
97 | 77 |
importFrom(rARPACK,svds) |
98 |
-importFrom(reshape2,melt) |
|
99 | 78 |
importFrom(rhdf5,H5close) |
100 | 79 |
importFrom(rhdf5,h5createFile) |
101 | 80 |
importFrom(rhdf5,h5ls) |
... | ... |
@@ -103,32 +82,6 @@ importFrom(rhdf5,h5read) |
103 | 82 |
importFrom(rhdf5,h5write) |
104 | 83 |
importFrom(rhdf5,h5write.default) |
105 | 84 |
importFrom(scran,computeSumFactors) |
106 |
-importFrom(shiny,br) |
|
107 |
-importFrom(shiny,column) |
|
108 |
-importFrom(shiny,downloadHandler) |
|
109 |
-importFrom(shiny,downloadLink) |
|
110 |
-importFrom(shiny,fluidPage) |
|
111 |
-importFrom(shiny,fluidRow) |
|
112 |
-importFrom(shiny,h5) |
|
113 |
-importFrom(shiny,h6) |
|
114 |
-importFrom(shiny,helpText) |
|
115 |
-importFrom(shiny,mainPanel) |
|
116 |
-importFrom(shiny,observeEvent) |
|
117 |
-importFrom(shiny,p) |
|
118 |
-importFrom(shiny,plotOutput) |
|
119 |
-importFrom(shiny,reactive) |
|
120 |
-importFrom(shiny,renderPlot) |
|
121 |
-importFrom(shiny,renderTable) |
|
122 |
-importFrom(shiny,selectInput) |
|
123 |
-importFrom(shiny,shinyApp) |
|
124 |
-importFrom(shiny,sidebarLayout) |
|
125 |
-importFrom(shiny,sidebarPanel) |
|
126 |
-importFrom(shiny,sliderInput) |
|
127 |
-importFrom(shiny,tabPanel) |
|
128 |
-importFrom(shiny,tableOutput) |
|
129 |
-importFrom(shiny,tabsetPanel) |
|
130 |
-importFrom(shiny,titlePanel) |
|
131 |
-importFrom(shiny,updateSelectInput) |
|
132 | 85 |
importFrom(stats,approx) |
133 | 86 |
importFrom(stats,as.formula) |
134 | 87 |
importFrom(stats,binomial) |
... | ... |
@@ -1,8 +1,8 @@ |
1 | 1 |
#' SCONE Report Browser: Browse Evaluation of Normalization Performance |
2 |
-#' |
|
3 |
-#' This function opens a shiny application session for visualizing performance |
|
2 |
+#' |
|
3 |
+#' This function opens a shiny application session for visualizing performance |
|
4 | 4 |
#' of a variety of normalization schemes. |
5 |
-#' |
|
5 |
+#' |
|
6 | 6 |
#' @param x a \code{SconeExperiment} object |
7 | 7 |
#' @param methods character specifying the normalizations to report. |
8 | 8 |
#' @param qc matrix. QC metrics to be used for QC evaluation report. Required. |
... | ... |
@@ -10,43 +10,31 @@ |
10 | 10 |
#' Default NULL. |
11 | 11 |
#' @param batch factor. A known batch variable (variation to be removed). |
12 | 12 |
#' Default NULL. |
13 |
-#' @param negcon character. Genes to be used as negative controls for |
|
14 |
-#' evaluation. These genes should be expected not to change according to the |
|
13 |
+#' @param negcon character. Genes to be used as negative controls for |
|
14 |
+#' evaluation. These genes should be expected not to change according to the |
|
15 | 15 |
#' biological phenomenon of interest. Default empty character. |
16 |
-#' @param poscon character. Genes to be used as positive controls for |
|
17 |
-#' evaluation. These genes should be expected to change according to the |
|
16 |
+#' @param poscon character. Genes to be used as positive controls for |
|
17 |
+#' evaluation. These genes should be expected to change according to the |
|
18 | 18 |
#' biological phenomenon of interest. Default empty character. |
19 |
-#' @param eval_proj function. Projection function for evaluation (see |
|
20 |
-#' \code{\link{score_matrix}} for details). If NULL, PCA is used for |
|
19 |
+#' @param eval_proj function. Projection function for evaluation (see |
|
20 |
+#' \code{\link{score_matrix}} for details). If NULL, PCA is used for |
|
21 | 21 |
#' projection. |
22 | 22 |
#' @param eval_proj_args list. List of args passed to projection function as |
23 | 23 |
#' eval_proj_args. |
24 |
-#' |
|
25 |
-#' @importFrom shiny fluidPage downloadLink br titlePanel tableOutput helpText |
|
26 |
-#' downloadHandler column h5 h6 updateSelectInput plotOutput tabsetPanel |
|
27 |
-#' selectInput renderTable p sidebarLayout sidebarPanel shinyApp mainPanel |
|
28 |
-#' observeEvent renderPlot reactive fluidRow sliderInput tabPanel |
|
29 |
-#' @import visNetwork |
|
30 |
-#' @importFrom DT dataTableProxy dataTableOutput renderDataTable selectRows |
|
31 |
-#' formatSignif |
|
32 |
-#' @import plotly |
|
24 |
+#' |
|
33 | 25 |
#' @importFrom RColorBrewer brewer.pal |
34 |
-#' @importFrom reshape2 melt |
|
35 |
-#' @importFrom NMF aheatmap |
|
36 |
-#' @importFrom ggplot2 labs theme geom_point ylim ggplot geom_violin |
|
37 |
-#' element_blank aes geom_bar coord_cartesian scale_fill_manual guides |
|
38 | 26 |
#' @importFrom rARPACK svds |
39 | 27 |
#' @export |
40 |
-#' |
|
28 |
+#' |
|
41 | 29 |
#' @return An object that represents the SCONE report app. |
42 |
-#' |
|
30 |
+#' |
|
43 | 31 |
#' @examples |
44 | 32 |
#' set.seed(101) |
45 | 33 |
#' mat <- matrix(rpois(1000, lambda = 5), ncol=10) |
46 | 34 |
#' colnames(mat) <- paste("X", 1:ncol(mat), sep="") |
47 | 35 |
#' obj <- SconeExperiment(mat) |
48 | 36 |
#' res <- scone(obj, scaling=list(none=identity, uq=UQ_FN, deseq=DESEQ_FN), |
49 |
-#' evaluate=TRUE, k_ruv=0, k_qc=0, eval_kclust=2, |
|
37 |
+#' evaluate=TRUE, k_ruv=0, k_qc=0, eval_kclust=2, |
|
50 | 38 |
#' bpparam = BiocParallel::SerialParam()) |
51 | 39 |
#' qc = as.matrix(cbind(colSums(mat),colSums(mat > 0))) |
52 | 40 |
#' rownames(qc) = colnames(mat) |
... | ... |
@@ -54,47 +42,74 @@ |
54 | 42 |
#' \dontrun{ |
55 | 43 |
#' sconeReport(res,rownames(get_params(res)), qc = qc) |
56 | 44 |
#' } |
57 |
-#' |
|
45 |
+#' |
|
58 | 46 |
sconeReport = function(x, methods, |
59 |
- qc, |
|
47 |
+ qc, |
|
60 | 48 |
bio = NULL, batch = NULL, |
61 | 49 |
poscon = character(), negcon = character(), |
62 | 50 |
eval_proj = NULL, |
63 | 51 |
eval_proj_args = NULL){ |
64 |
- |
|
65 |
- |
|
52 |
+ |
|
53 |
+ if (!requireNamespace("shiny", quietly = TRUE)) { |
|
54 |
+ stop("shiny package needed for sconeReport()") |
|
55 |
+ } |
|
56 |
+ |
|
57 |
+ if (!requireNamespace("DT", quietly = TRUE)) { |
|
58 |
+ stop("DT package needed for sconeReport()") |
|
59 |
+ } |
|
60 |
+ |
|
61 |
+ if (!requireNamespace("NMF", quietly = TRUE)) { |
|
62 |
+ stop("NMF package needed for sconeReport()") |
|
63 |
+ } |
|
64 |
+ |
|
65 |
+ if (!requireNamespace("reshape2", quietly = TRUE)) { |
|
66 |
+ stop("reshape2 package needed for sconeReport()") |
|
67 |
+ } |
|
68 |
+ |
|
69 |
+ if (!require("plotly", quietly = TRUE)) { |
|
70 |
+ stop("plotly package needed for sconeReport()") |
|
71 |
+ } |
|
72 |
+ |
|
73 |
+ if (!require("visNetwork", quietly = TRUE)) { |
|
74 |
+ stop("visNetwork package needed for sconeReport()") |
|
75 |
+ } |
|
76 |
+ |
|
77 |
+ if (!require("ggplot2", quietly = TRUE)) { |
|
78 |
+ stop("ggplot2 package needed for sconeReport()") |
|
79 |
+ } |
|
80 |
+ |
|
66 | 81 |
scone_res = list() |
67 |
- |
|
82 |
+ |
|
68 | 83 |
# List of normalized matrices |
69 |
- scone_res$normalized_data = lapply(as.list(methods), |
|
84 |
+ scone_res$normalized_data = lapply(as.list(methods), |
|
70 | 85 |
FUN = function(z){ |
71 | 86 |
get_normalized(x,method = z,log=TRUE) |
72 | 87 |
}) |
73 | 88 |
names(scone_res$normalized_data) = methods |
74 |
- |
|
89 |
+ |
|
75 | 90 |
# Parameter matrix |
76 | 91 |
scone_res$params = get_params(x)[methods,] |
77 |
- |
|
92 |
+ |
|
78 | 93 |
# Merged score matrix |
79 | 94 |
scone_res$scores = cbind(get_scores(x),get_score_ranks(x))[methods,] |
80 | 95 |
colnames(scone_res$scores)[ncol(scone_res$scores)] = "mean_score_rank" |
81 |
- |
|
82 |
- |
|
96 |
+ |
|
97 |
+ |
|
83 | 98 |
## ----- If NULL classifications, Replace with NA ------ |
84 |
- |
|
99 |
+ |
|
85 | 100 |
if(is.null(bio)){ |
86 | 101 |
bio = factor(rep("NA",ncol(scone_res$normalized_data[[1]]))) |
87 | 102 |
} |
88 |
- |
|
103 |
+ |
|
89 | 104 |
if(is.null(batch)){ |
90 | 105 |
batch = factor(rep("NA",ncol(scone_res$normalized_data[[1]]))) |
91 | 106 |
} |
92 |
- |
|
107 |
+ |
|
93 | 108 |
## ----- Network Data for Visualization ----- |
94 |
- |
|
109 |
+ |
|
95 | 110 |
# Matrix nodes in scone_res |
96 |
- leaves = rownames(scone_res$params) |
|
97 |
- |
|
111 |
+ leaves = rownames(scone_res$params) |
|
112 |
+ |
|
98 | 113 |
# Parents |
99 | 114 |
lay1 = unique(gsub(",[^,]*$","",leaves)) |
100 | 115 |
lay2 = unique(gsub(",[^,]*$","",lay1)) |
... | ... |
@@ -102,37 +117,37 @@ sconeReport = function(x, methods, |
102 | 117 |
lay4 = unique(gsub(",[^,]*$","",lay3)) |
103 | 118 |
all_nodes = c(leaves,lay1,lay2,lay3,lay4) |
104 | 119 |
rm(list = c("lay1","lay2","lay3","lay4")) |
105 |
- |
|
120 |
+ |
|
106 | 121 |
# Collapse no-op names for all node names |
107 | 122 |
all_nodes = unique(gsub("^,*|,*$","", |
108 | 123 |
gsub("\\,+",",", |
109 | 124 |
gsub("none|no_uv|no_bio|no_batch","", |
110 | 125 |
all_nodes)))) |
111 |
- |
|
126 |
+ |
|
112 | 127 |
# Order by decreasing number of operations (root at the end) |
113 | 128 |
all_nodes = all_nodes[order(paste0(gsub(".+",",",all_nodes), |
114 | 129 |
gsub("[^,]*","",all_nodes)), |
115 | 130 |
decreasing = TRUE)] |
116 |
- |
|
131 |
+ |
|
117 | 132 |
# Collapse no-op names for all leaves |
118 | 133 |
leaves = gsub("^,*|,*$","", |
119 | 134 |
gsub("\\,+",",", |
120 | 135 |
gsub("none|no_uv|no_bio|no_batch","", |
121 | 136 |
leaves))) |
122 |
- |
|
137 |
+ |
|
123 | 138 |
# Re-title nodes in scone_res and root (instead of collapsed names) |
124 | 139 |
titles = all_nodes |
125 | 140 |
names(titles) = paste0("_",all_nodes) |
126 | 141 |
titles[paste0("_",leaves)] = rownames(scone_res$params) |
127 | 142 |
titles[titles == ""] = "none" |
128 |
- |
|
143 |
+ |
|
129 | 144 |
# Create Nodes |
130 | 145 |
nodes <- data.frame(id = 1:length(all_nodes), |
131 | 146 |
title = titles, |
132 | 147 |
group = c("NoData", |
133 |
- "Loaded")[1 + |
|
148 |
+ "Loaded")[1 + |
|
134 | 149 |
(all_nodes %in% leaves)]) |
135 |
- |
|
150 |
+ |
|
136 | 151 |
# Create Edges |
137 | 152 |
edges = data.frame() |
138 | 153 |
for(i in 1:length(all_nodes)){ |
... | ... |
@@ -146,7 +161,7 @@ sconeReport = function(x, methods, |
146 | 161 |
} |
147 | 162 |
} |
148 | 163 |
colnames(edges)= c("from","to") |
149 |
- |
|
164 |
+ |
|
150 | 165 |
# Re-map indices according to performance |
151 | 166 |
new_title_list = rownames(scone_res$params) # Ordered by perfomance |
152 | 167 |
new_title_list = c(new_title_list, |
... | ... |
@@ -166,90 +181,90 @@ sconeReport = function(x, methods, |
166 | 181 |
edges[old_edges == old_ids[i]] = i |
167 | 182 |
} |
168 | 183 |
nodes = nodes[order(nodes$id),] |
169 |
- |
|
184 |
+ |
|
170 | 185 |
## ----- Color Variable ----- |
171 | 186 |
cc <- c(brewer.pal(9, "Set1"), brewer.pal(8, "Set2"),brewer.pal(12,"Set3"), |
172 | 187 |
brewer.pal(8, "Accent")) |
173 |
- |
|
188 |
+ |
|
174 | 189 |
## ----- UI Definition ----- |
175 |
- ui <- fluidPage( |
|
176 |
- titlePanel("SCONE Report Browser"), |
|
177 |
- |
|
178 |
- sidebarLayout( |
|
179 |
- sidebarPanel( |
|
180 |
- selectInput("norm_code", label = "Normalization", |
|
190 |
+ ui <- shiny::fluidPage( |
|
191 |
+ shiny::titlePanel("SCONE Report Browser"), |
|
192 |
+ |
|
193 |
+ shiny::sidebarLayout( |
|
194 |
+ shiny::sidebarPanel( |
|
195 |
+ shiny::selectInput("norm_code", label = "Normalization", |
|
181 | 196 |
choices = structure(as.list(rownames(scone_res$params)), |
182 | 197 |
names = rownames(scone_res$params)), |
183 | 198 |
selected = rownames(scone_res$params)[1]), |
184 |
- selectInput("color_code", label = "Stratify Plots by", |
|
199 |
+ shiny::selectInput("color_code", label = "Stratify Plots by", |
|
185 | 200 |
choices = list("Batch"="batch", |
186 |
- "Biological Condition"="bio", |
|
201 |
+ "Biological Condition"="bio", |
|
187 | 202 |
"PAM Cluster"="clust"), |
188 | 203 |
selected = "batch"), |
189 |
- sliderInput("dim", label = "Reduced Dimension (PCA)", |
|
204 |
+ shiny::sliderInput("dim", label = "Reduced Dimension (PCA)", |
|
190 | 205 |
min=2, max=min(length(batch)-1,10), |
191 | 206 |
value = 3), |
192 |
- sliderInput("k", label = "Number of Clusters (PAM)", |
|
207 |
+ shiny::sliderInput("k", label = "Number of Clusters (PAM)", |
|
193 | 208 |
min=2, max=10, |
194 | 209 |
value = 2), |
195 |
- helpText(paste0("Please note that with many cells (>500),", |
|
210 |
+ shiny::helpText(paste0("Please note that with many cells (>500),", |
|
196 | 211 |
" some plots may take several seconds ", |
197 | 212 |
"(sometimes minutes) to appear.")), |
198 |
- downloadLink('downloadData', 'Download') |
|
213 |
+ shiny::downloadLink('downloadData', 'Download') |
|
199 | 214 |
), |
200 |
- |
|
201 |
- mainPanel(tabsetPanel(type = "tabs", |
|
202 |
- tabPanel("Overview", |
|
203 |
- br(), |
|
215 |
+ |
|
216 |
+ shiny::mainPanel(shiny::tabsetPanel(type = "tabs", |
|
217 |
+ shiny::tabPanel("Overview", |
|
218 |
+ shiny::br(), |
|
204 | 219 |
visNetworkOutput("norm_net", |
205 | 220 |
width = "650px"), |
206 |
- br(), |
|
221 |
+ shiny::br(), |
|
207 | 222 |
DT::dataTableOutput('tbl_score') |
208 | 223 |
), |
209 |
- tabPanel("PCA", |
|
210 |
- br(), |
|
211 |
- p(paste0("This panel shows principal ", |
|
224 |
+ shiny::tabPanel("PCA", |
|
225 |
+ shiny::br(), |
|
226 |
+ shiny::p(paste0("This panel shows principal ", |
|
212 | 227 |
"component analysis ", |
213 | 228 |
"(PCA) results", |
214 | 229 |
" on different subsets ", |
215 | 230 |
"of genes.")), |
216 |
- br(), |
|
217 |
- h6("Variance Explained (All Genes)"), |
|
218 |
- p(paste0("Use this plot", |
|
231 |
+ shiny::br(), |
|
232 |
+ shiny::h6("Variance Explained (All Genes)"), |
|
233 |
+ shiny::p(paste0("Use this plot", |
|
219 | 234 |
" to decide on the ", |
220 | 235 |
"dimensionality of the reduced", |
221 | 236 |
" spaced used for evaluation.")), |
222 |
- plotOutput("plot_scree",width = "650px", |
|
237 |
+ shiny::plotOutput("plot_scree",width = "650px", |
|
223 | 238 |
height = "400px"), |
224 |
- br(), |
|
225 |
- h6("2D (All Genes)"), |
|
226 |
- plotOutput("plot_base", |
|
239 |
+ shiny::br(), |
|
240 |
+ shiny::h6("2D (All Genes)"), |
|
241 |
+ shiny::plotOutput("plot_base", |
|
227 | 242 |
width = "650px", |
228 | 243 |
height = "450px"), |
229 |
- br(), |
|
230 |
- h6("3D Interactive (All Genes)"), |
|
244 |
+ shiny::br(), |
|
245 |
+ shiny::h6("3D Interactive (All Genes)"), |
|
231 | 246 |
plotlyOutput("plot3d_base", |
232 | 247 |
width = "650px", |
233 | 248 |
height = "650px"), |
234 |
- br(), |
|
235 |
- selectInput("gene_set", |
|
249 |
+ shiny::br(), |
|
250 |
+ shiny::selectInput("gene_set", |
|
236 | 251 |
label = "Gene selection", |
237 |
- choices = |
|
252 |
+ choices = |
|
238 | 253 |
list("Negative Controls"= |
239 | 254 |
"neg", |
240 | 255 |
"Positive Controls"= |
241 | 256 |
"pos"), |
242 | 257 |
selected = "neg"), |
243 |
- h6("2D (Select Genes)"), |
|
244 |
- p(paste0("Visualize cells by PCs", |
|
258 |
+ shiny::h6("2D (Select Genes)"), |
|
259 |
+ shiny::p(paste0("Visualize cells by PCs", |
|
245 | 260 |
" of control gene sets.")), |
246 |
- plotOutput("plot_select", |
|
261 |
+ shiny::plotOutput("plot_select", |
|
247 | 262 |
width = "650px", |
248 | 263 |
height = "450px") |
249 | 264 |
), |
250 |
- tabPanel("QC", |
|
251 |
- br(), |
|
252 |
- p(paste0("This panel shows the absolute", |
|
265 |
+ shiny::tabPanel("QC", |
|
266 |
+ shiny::br(), |
|
267 |
+ shiny::p(paste0("This panel shows the absolute", |
|
253 | 268 |
" correlations between", |
254 | 269 |
" Principal", |
255 | 270 |
" Components (PCs) of", |
... | ... |
@@ -264,30 +279,30 @@ sconeReport = function(x, methods, |
264 | 279 |
" could have a low value of ", |
265 | 280 |
"PC1 and 'bad' cells a", |
266 | 281 |
" high value).")), |
267 |
- br(), |
|
282 |
+ shiny::br(), |
|
268 | 283 |
plotlyOutput('qccorPlot', |
269 | 284 |
width = "650px", |
270 | 285 |
height = "450px"), |
271 |
- h5("PCA of QC metrics"), |
|
272 |
- h6("2D"), |
|
273 |
- plotOutput("plot_qc", |
|
286 |
+ shiny::h5("PCA of QC metrics"), |
|
287 |
+ shiny::h6("2D"), |
|
288 |
+ shiny::plotOutput("plot_qc", |
|
274 | 289 |
width = "650px", |
275 | 290 |
height = "450px"), |
276 |
- h6("3D Interactive"), |
|
291 |
+ shiny::h6("3D Interactive"), |
|
277 | 292 |
plotlyOutput("plot3d_qc", |
278 | 293 |
width = "650px", |
279 | 294 |
height = "650px") |
280 | 295 |
), |
281 |
- tabPanel("Silhouette", |
|
282 |
- br(), |
|
283 |
- p(paste0("Silhouette Width per", |
|
296 |
+ shiny::tabPanel("Silhouette", |
|
297 |
+ shiny::br(), |
|
298 |
+ shiny::p(paste0("Silhouette Width per", |
|
284 | 299 |
" Sample and Contingency", |
285 | 300 |
" Tables")), |
286 |
- br(), |
|
287 |
- plotOutput("plotsil", |
|
301 |
+ shiny::br(), |
|
302 |
+ shiny::plotOutput("plotsil", |
|
288 | 303 |
width = "650px", |
289 | 304 |
height = "450px"), |
290 |
- selectInput("cat1", |
|
305 |
+ shiny::selectInput("cat1", |
|
291 | 306 |
label = |
292 | 307 |
"Row Class", |
293 | 308 |
choices = |
... | ... |
@@ -297,7 +312,7 @@ sconeReport = function(x, methods, |
297 | 312 |
"bio", "PAM Cluster"= |
298 | 313 |
"clust"), |
299 | 314 |
selected = "batch"), |
300 |
- selectInput("cat2", |
|
315 |
+ shiny::selectInput("cat2", |
|
301 | 316 |
label = "Column Class", |
302 | 317 |
choices = |
303 | 318 |
list("Batch"= |
... | ... |
@@ -307,33 +322,33 @@ sconeReport = function(x, methods, |
307 | 322 |
"PAM Cluster"= |
308 | 323 |
"clust"), |
309 | 324 |
selected = "bio"), |
310 |
- tableOutput("cat_tab") |
|
325 |
+ shiny::tableOutput("cat_tab") |
|
311 | 326 |
), |
312 |
- tabPanel("Control Genes", |
|
313 |
- br(), |
|
314 |
- p(paste0("Heatmap of control genes, ", |
|
327 |
+ shiny::tabPanel("Control Genes", |
|
328 |
+ shiny::br(), |
|
329 |
+ shiny::p(paste0("Heatmap of control genes, ", |
|
315 | 330 |
"colored by all", |
316 | 331 |
" three categories.")), |
317 |
- br(), |
|
318 |
- p("Positive controls:"), |
|
319 |
- plotOutput("hmposcon", |
|
332 |
+ shiny::br(), |
|
333 |
+ shiny::p("Positive controls:"), |
|
334 |
+ shiny::plotOutput("hmposcon", |
|
320 | 335 |
width = "650px", |
321 | 336 |
height = "450px"), |
322 |
- p("Negative controls:"), |
|
323 |
- plotOutput("hmnegcon", |
|
337 |
+ shiny::p("Negative controls:"), |
|
338 |
+ shiny::plotOutput("hmnegcon", |
|
324 | 339 |
width = "650px", |
325 | 340 |
height = "450px") |
326 | 341 |
), |
327 |
- |
|
328 |
- tabPanel("Stratified PCA", |
|
329 |
- br(), |
|
330 |
- p(paste0("Violin plots showing", |
|
342 |
+ |
|
343 |
+ shiny::tabPanel("Stratified PCA", |
|
344 |
+ shiny::br(), |
|
345 |
+ shiny::p(paste0("Violin plots showing", |
|
331 | 346 |
" conditional ", |
332 | 347 |
"distributions of", |
333 | 348 |
" selected Principal", |
334 | 349 |
" Component.")), |
335 |
- br(), |
|
336 |
- sliderInput("pcsel", |
|
350 |
+ shiny::br(), |
|
351 |
+ shiny::sliderInput("pcsel", |
|
337 | 352 |
label = |
338 | 353 |
paste0("Selected", |
339 | 354 |
" Principal ", |
... | ... |
@@ -341,11 +356,11 @@ sconeReport = function(x, methods, |
341 | 356 |
min=1, max= |
342 | 357 |
min(length(batch)-1,10), |
343 | 358 |
value = 1), |
344 |
- h6("All Genes:"), |
|
345 |
- plotOutput("violin_base", |
|
359 |
+ shiny::h6("All Genes:"), |
|
360 |
+ shiny::plotOutput("violin_base", |
|
346 | 361 |
width = "650px", |
347 | 362 |
height = "450px"), |
348 |
- selectInput("gene_set2", |
|
363 |
+ shiny::selectInput("gene_set2", |
|
349 | 364 |
label = "Gene selection", |
350 | 365 |
choices = |
351 | 366 |
list("Negative Controls"= |
... | ... |
@@ -353,74 +368,74 @@ sconeReport = function(x, methods, |
353 | 368 |
"Positive Controls"= |
354 | 369 |
"pos"), |
355 | 370 |
selected = "neg"), |
356 |
- h6("Select Genes:"), |
|
357 |
- plotOutput("violin_select", |
|
371 |
+ shiny::h6("Select Genes:"), |
|
372 |
+ shiny::plotOutput("violin_select", |
|
358 | 373 |
width = "650px", |
359 | 374 |
height = "450px") |
360 | 375 |
), |
361 |
- |
|
362 |
- tabPanel("Relative Log-Expression", |
|
363 |
- br(), |
|
364 |
- p(paste0("Relative ", |
|
376 |
+ |
|
377 |
+ shiny::tabPanel("Relative Log-Expression", |
|
378 |
+ shiny::br(), |
|
379 |
+ shiny::p(paste0("Relative ", |
|
365 | 380 |
"Log-Expression Plot ", |
366 | 381 |
"for top 100 Most ", |
367 | 382 |
"Variable Genes.")), |
368 |
- plotOutput("rle", |
|
383 |
+ shiny::plotOutput("rle", |
|
369 | 384 |
width = "850px", |
370 | 385 |
height = "450px") |
371 | 386 |
) |
372 | 387 |
)))) |
373 |
- |
|
388 |
+ |
|
374 | 389 |
server <- function(input, output, session) { |
375 |
- |
|
390 |
+ |
|
376 | 391 |
## ------ Overview Tab ------ |
377 |
- |
|
392 |
+ |
|
378 | 393 |
# Render Network |
379 | 394 |
output$norm_net <- renderVisNetwork({ |
380 |
- |
|
395 |
+ |
|
381 | 396 |
# Awk: Check if any non-loaded methods are included |
382 | 397 |
if(any(!all_nodes %in% leaves)){ |
383 |
- visNetwork(nodes, edges,width = "100%",main = "Tree of Methods") %>% |
|
384 |
- visHierarchicalLayout(sortMethod = "directed" ) %>% |
|
385 |
- visGroups(groupname = "NoData", shape = "dot", |
|
398 |
+ visNetwork(nodes, edges,width = "100%",main = "Tree of Methods") %>% |
|
399 |
+ visHierarchicalLayout(sortMethod = "directed" ) %>% |
|
400 |
+ visGroups(groupname = "NoData", shape = "dot", |
|
386 | 401 |
size = 10, color = list(background = "lightgrey", |
387 | 402 |
border = "darkblue", |
388 |
- highlight = |
|
403 |
+ highlight = |
|
389 | 404 |
list(background = |
390 | 405 |
"black", |
391 |
- border = "red")), |
|
392 |
- shadow = list(enabled = TRUE)) %>% |
|
393 |
- visGroups(groupname = "Loaded", shape = "dot", |
|
406 |
+ border = "red")), |
|
407 |
+ shadow = list(enabled = TRUE)) %>% |
|
408 |
+ visGroups(groupname = "Loaded", shape = "dot", |
|
394 | 409 |
size = 20, color = list(background = "lightblue", |
395 |
- border = "darkblue", |
|
396 |
- highlight = |
|
410 |
+ border = "darkblue", |
|
411 |
+ highlight = |
|
397 | 412 |
list(background = "cyan", |
398 | 413 |
border = "red")), |
399 | 414 |
shadow = list(enabled = TRUE)) %>% |
400 | 415 |
visEdges(shadow = TRUE, arrows = list(to = list(enabled = TRUE)), |
401 | 416 |
color = list(color = "darkblue", highlight = "red")) %>% |
402 | 417 |
visOptions(nodesIdSelection = |
403 |
- list(enabled = TRUE, |
|
418 |
+ list(enabled = TRUE, |
|
404 | 419 |
values = nodes$id[nodes$group == "Loaded"], |
405 | 420 |
selected = |
406 | 421 |
nodes$id[nodes$title == |
407 | 422 |
rownames(scone_res$params)[1]])) %>% |
408 | 423 |
visLegend(width = 0.1, position = "right", main = "Status") |
409 | 424 |
}else{ |
410 |
- visNetwork(nodes, edges,width = "100%",main = "Tree of Methods") %>% |
|
411 |
- visHierarchicalLayout(sortMethod = "directed" ) %>% |
|
425 |
+ visNetwork(nodes, edges,width = "100%",main = "Tree of Methods") %>% |
|
426 |
+ visHierarchicalLayout(sortMethod = "directed" ) %>% |
|
412 | 427 |
visEdges(shadow = TRUE, arrows = list(to = list(enabled = TRUE)), |
413 | 428 |
color = list(color = "darkblue", highlight = "red")) %>% |
414 | 429 |
visOptions(nodesIdSelection = |
415 |
- list(enabled = TRUE, |
|
430 |
+ list(enabled = TRUE, |
|
416 | 431 |
values = nodes$id[nodes$group == "Loaded"], |
417 |
- selected = |
|
432 |
+ selected = |
|
418 | 433 |
nodes$id[nodes$title == |
419 | 434 |
rownames(scone_res$params)[1]])) |
420 | 435 |
} |
421 |
- |
|
436 |
+ |
|
422 | 437 |
}) |
423 |
- |
|
438 |
+ |
|
424 | 439 |
# Render Table |
425 | 440 |
output$tbl_score <- DT::renderDataTable({ |
426 | 441 |
DT::datatable(scone_res$scores, |
... | ... |
@@ -432,21 +447,21 @@ sconeReport = function(x, methods, |
432 | 447 |
list(columnDefs = |
433 | 448 |
list(list(visible=FALSE, |
434 | 449 |
targets=1:(ncol(scone_res$scores)-1))), |
435 |
- dom = 'Bfrtip', |
|
450 |
+ dom = 'Bfrtip', |
|
436 | 451 |
buttons = list( |
437 | 452 |
list(extend = 'colvis', |
438 | 453 |
columns = c(1:(ncol(scone_res$scores)-1)))) |
439 | 454 |
)) %>% |
440 | 455 |
DT::formatSignif(columns=c(1:(ncol(scone_res$scores))), digits=3) |
441 | 456 |
}) |
442 |
- |
|
457 |
+ |
|
443 | 458 |
# Update Menu Upon Network Selection of (Loaded) Normalization |
444 |
- observeEvent(input$norm_net_selected,{ |
|
445 |
- if(is.character(input$norm_net_selected)){ # probably unnecessary |
|
459 |
+ shiny::observeEvent(input$norm_net_selected,{ |
|
460 |
+ if(is.character(input$norm_net_selected)){ # probably unnecessary |
|
446 | 461 |
if(!input$norm_net_selected == ""){ # probably unnecessary |
447 | 462 |
if(as.integer(input$norm_net_selected) %in% |
448 | 463 |
nodes$id[nodes$group == "Loaded"]){ |
449 |
- updateSelectInput( |
|
464 |
+ shiny::updateSelectInput( |
|
450 | 465 |
session, |
451 | 466 |
"norm_code", |
452 | 467 |
selected = as.character( |
... | ... |
@@ -457,12 +472,12 @@ sconeReport = function(x, methods, |
457 | 472 |
} |
458 | 473 |
} |
459 | 474 |
}) |
460 |
- |
|
475 |
+ |
|
461 | 476 |
# Update Menu Upon Table Selection |
462 |
- observeEvent(input$tbl_score_rows_selected,{ |
|
463 |
- if(length(input$tbl_score_rows_selected) > 0 ){ # probably unnecessary |
|
464 |
- updateSelectInput(session, |
|
465 |
- "norm_code", |
|
477 |
+ shiny::observeEvent(input$tbl_score_rows_selected,{ |
|
478 |
+ if(length(input$tbl_score_rows_selected) > 0 ){ # probably unnecessary |
|
479 |
+ shiny::updateSelectInput(session, |
|
480 |
+ "norm_code", |
|
466 | 481 |
selected = as.character( |
467 | 482 |
nodes$title[nodes$id == |
468 | 483 |
as.integer( |
... | ... |
@@ -472,22 +487,22 @@ sconeReport = function(x, methods, |
472 | 487 |
) |
473 | 488 |
} |
474 | 489 |
}) |
475 |
- |
|
490 |
+ |
|
476 | 491 |
# Upon Menu Selection of Normalization |
477 |
- observeEvent(input$norm_code,{ |
|
478 |
- |
|
479 |
- # Update Network |
|
492 |
+ shiny::observeEvent(input$norm_code,{ |
|
493 |
+ |
|
494 |
+ # Update Network |
|
480 | 495 |
if(is.character(input$norm_net_selected)){ |
481 |
- |
|
496 |
+ |
|
482 | 497 |
# If selection is empty, then no valid node is selected. |
483 | 498 |
if(input$norm_net_selected == ""){ |
484 | 499 |
visNetworkProxy("norm_net") %>% |
485 | 500 |
visSelectNodes(id = |
486 | 501 |
array(nodes$id[nodes$title == input$norm_code])) |
487 | 502 |
}else{ |
488 |
- |
|
503 |
+ |
|
489 | 504 |
# If selection is different from menu, then network must be updated. |
490 |
- if(as.character(nodes$title[nodes$id == |
|
505 |
+ if(as.character(nodes$title[nodes$id == |
|
491 | 506 |
as.integer( |
492 | 507 |
input$norm_net_selected |
493 | 508 |
)]) != input$norm_code){ |
... | ... |
@@ -497,120 +512,120 @@ sconeReport = function(x, methods, |
497 | 512 |
} |
498 | 513 |
} |
499 | 514 |
} |
500 |
- |
|
515 |
+ |
|
501 | 516 |
# Update Table |
502 |
- |
|
517 |
+ |
|
503 | 518 |
# If selection is empty, then no row is selected. |
504 | 519 |
if(length(input$tbl_score_rows_selected) == 0){ |
505 |
- dataTableProxy("tbl_score") %>% |
|
506 |
- selectRows(nodes$id[nodes$title == input$norm_code]) |
|
520 |
+ DT::dataTableProxy("tbl_score") %>% |
|
521 |
+ DT::selectRows(nodes$id[nodes$title == input$norm_code]) |
|
507 | 522 |
}else{ |
508 |
- |
|
523 |
+ |
|
509 | 524 |
# If selection is different from menu, then row must be updated. |
510 | 525 |
if(input$tbl_score_rows_selected != |
511 | 526 |
nodes$id[nodes$title == input$norm_code]){ |
512 |
- dataTableProxy("tbl_score") %>% |
|
513 |
- selectRows(nodes$id[nodes$title == input$norm_code]) |
|
527 |
+ DT::dataTableProxy("tbl_score") %>% |
|
528 |
+ DT::selectRows(nodes$id[nodes$title == input$norm_code]) |
|
514 | 529 |
} |
515 | 530 |
} |
516 |
- |
|
531 |
+ |
|
517 | 532 |
}) |
518 |
- |
|
533 |
+ |
|
519 | 534 |
## ------ PCA Tab ------ |
520 |
- |
|
521 |
- normle <- reactive({ |
|
535 |
+ |
|
536 |
+ normle <- shiny::reactive({ |
|
522 | 537 |
as.matrix(scone_res$normalized_data[[input$norm_code]]) |
523 | 538 |
}) |
524 |
- |
|
525 |
- strat_col <- reactive({ |
|
539 |
+ |
|
540 |
+ strat_col <- shiny::reactive({ |
|
526 | 541 |
switch(input$color_code, |
527 | 542 |
bio = bio, |
528 | 543 |
batch = batch, |
529 | 544 |
clust = pam_obj()$clust) |
530 | 545 |
}) |
531 |
- |
|
532 |
- pc_col <- reactive({ |
|
546 |
+ |
|
547 |
+ pc_col <- shiny::reactive({ |
|
533 | 548 |
cc[strat_col()] |
534 | 549 |
}) |
535 |
- |
|
536 |
- pc_gene <- reactive({ |
|
550 |
+ |
|
551 |
+ pc_gene <- shiny::reactive({ |
|
537 | 552 |
switch(input$gene_set, |
538 | 553 |
pos = intersect(poscon,rownames(normle())), |
539 | 554 |
neg = intersect(negcon,rownames(normle()))) |
540 | 555 |
}) |
541 |
- |
|
542 |
- pc_obj_base <- reactive({ |
|
543 |
- |
|
556 |
+ |
|
557 |
+ pc_obj_base <- shiny::reactive({ |
|
558 |
+ |
|
544 | 559 |
# If user has not provided evaluation projection |
545 | 560 |
if(is.null(eval_proj)){ |
546 |
- |
|
561 |
+ |
|
547 | 562 |
prcomp(t(normle()), |
548 | 563 |
center = TRUE, scale = TRUE) |
549 |
- |
|
564 |
+ |
|
550 | 565 |
} else { |
551 |
- |
|
566 |
+ |
|
552 | 567 |
proj = eval_proj(normle(), |
553 | 568 |
eval_proj_args = eval_proj_args) |
554 | 569 |
colnames(proj) = paste0("PC",1:ncol(proj)) |
555 |
- |
|
570 |
+ |
|
556 | 571 |
pc_out = list(x = proj, sdev = apply(proj,2,sd)) |
557 |
- |
|
572 |
+ |
|
558 | 573 |
pc_out |
559 |
- |
|
574 |
+ |
|
560 | 575 |
} |
561 |
- |
|
576 |
+ |
|
562 | 577 |
}) |
563 |
- |
|
564 |
- pc_obj_select <- reactive({ |
|
578 |
+ |
|
579 |
+ pc_obj_select <- shiny::reactive({ |
|
565 | 580 |
if(length(pc_gene()) > 0){ |
566 |
- |
|
581 |
+ |
|
567 | 582 |
# If user has not provided evaluation projection |
568 | 583 |
if(is.null(eval_proj)){ |
569 |
- |
|
584 |
+ |
|
570 | 585 |
prcomp(t(normle()[pc_gene(),]), |
571 | 586 |
center = TRUE, scale = TRUE) |
572 |
- |
|
587 |
+ |
|
573 | 588 |
} else { |
574 |
- |
|
589 |
+ |
|
575 | 590 |
proj = eval_proj(normle()[pc_gene(),], |
576 | 591 |
eval_proj_args = eval_proj_args) |
577 | 592 |
colnames(proj) = paste0("PC",1:ncol(proj)) |
578 |
- |
|
593 |
+ |
|
579 | 594 |
pc_out = list(x = proj, sdev = apply(proj,2,sd)) |
580 |
- |
|
595 |
+ |
|
581 | 596 |
pc_out |
582 |
- |
|
597 |
+ |
|
583 | 598 |
} |
584 |
- |
|
599 |
+ |
|
585 | 600 |
}else{ |
586 | 601 |
list() |
587 | 602 |
} |
588 | 603 |
}) |
589 |
- |
|
590 |
- pam_obj <- reactive({ |
|
604 |
+ |
|
605 |
+ pam_obj <- shiny::reactive({ |
|
591 | 606 |
cluster::pam(x = pc_obj_base()$x[,1:input$dim],k = input$k) |
592 | 607 |
}) |
593 |
- |
|
594 |
- output$plot_scree <- renderPlot({ |
|
608 |
+ |
|
609 |
+ output$plot_scree <- shiny::renderPlot({ |
|
595 | 610 |
plot(pc_obj_base()$sdev[1:min(input$dim*2, |
596 | 611 |
length(batch)-1)]^2/ |
597 |
- sum(pc_obj_base()$sdev^2), |
|
612 |
+ sum(pc_obj_base()$sdev^2), |
|
598 | 613 |
typ = "l", |
599 |
- ylab = "Proportion of Variance", |
|
614 |
+ ylab = "Proportion of Variance", |
|
600 | 615 |
xlab = "PC Index", |
601 | 616 |
log = "y") |
602 | 617 |
abline(v = input$dim, col = "red",lty = 2) |
603 | 618 |
}) |
604 |
- |
|
605 |
- output$plot_base <- renderPlot({ |
|
619 |
+ |
|
620 |
+ output$plot_base <- shiny::renderPlot({ |
|
606 | 621 |
par(mar=c(5.1, 4.1, 4.1, 10.1), xpd=TRUE) |
607 | 622 |
plot(pc_obj_base()$x[,1:2],col = pc_col(), pch = 16) |
608 |
- legend("topright", inset=c(-0.3,0), |
|
609 |
- legend=levels(factor(strat_col())), |
|
623 |
+ legend("topright", inset=c(-0.3,0), |
|
624 |
+ legend=levels(factor(strat_col())), |
|
610 | 625 |
fill = cc[sort(unique(factor(strat_col())))]) |
611 | 626 |
}) |
612 |
- |
|
613 |
- output$plot3d_base <- renderPlotly({ |
|
627 |
+ |
|
628 |
+ output$plot3d_base <- shiny::renderPlotly({ |
|
614 | 629 |
PC1 <- PC2 <- PC3 <- NULL |
615 | 630 |
df <- setNames(data.frame(pc_obj_base()$x[,1:3]), |
616 | 631 |
c("PC1", "PC2", "PC3")) |
... | ... |
@@ -618,96 +633,96 @@ sconeReport = function(x, methods, |
618 | 633 |
type = "scatter3d", mode = "markers", |
619 | 634 |
marker = list(color=pc_col() )) |
620 | 635 |
}) |
621 |
- |
|
622 |
- output$plot_select <- renderPlot({ |
|
623 |
- |
|
636 |
+ |
|
637 |
+ output$plot_select <- shiny::renderPlot({ |
|
638 |
+ |
|
624 | 639 |
par(mar=c(5.1, 4.1, 4.1, 10.1), xpd=TRUE) |
625 |
- |
|
640 |
+ |
|
626 | 641 |
if(length(pc_gene()) > 0){ |
627 |
- |
|
642 |
+ |
|
628 | 643 |
plot(pc_obj_select()$x[,1:2], |
629 | 644 |
col = pc_col(), pch = 16) |
630 |
- legend("topright", inset=c(-0.3,0), |
|
645 |
+ legend("topright", inset=c(-0.3,0), |
|
631 | 646 |
legend=levels(factor(strat_col())), |
632 | 647 |
fill = cc[sort(unique(factor(strat_col())))]) |
633 |
- |
|
648 |
+ |
|
634 | 649 |
}else{ |
635 |
- |
|
650 |
+ |
|
636 | 651 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
637 | 652 |
text(0,labels = "Control gene set is empty.") |
638 |
- |
|
653 |
+ |
|
639 | 654 |
} |
640 |
- |
|
655 |
+ |
|
641 | 656 |
}) |
642 |
- |
|
643 |
- pam_obj <- reactive({ |
|
657 |
+ |
|
658 |
+ pam_obj <- shiny::reactive({ |
|
644 | 659 |
cluster::pam(x = pc_obj_base()$x[,1:input$dim],k = input$k) |
645 | 660 |
}) |
646 |
- |
|
661 |
+ |
|
647 | 662 |
## ------ QC Tab ------ |
648 |
- |
|
649 |
- cor_qc <- reactive({ |
|
663 |
+ |
|
664 |
+ cor_qc <- shiny::reactive({ |
|
650 | 665 |
abs(cor(qc,pc_obj_base()$x)) |
651 | 666 |
}) |
652 |
- |
|
653 |
- output$qccorPlot <- renderPlotly({ |
|
667 |
+ |
|
668 |
+ output$qccorPlot <- shiny::renderPlotly({ |
|
654 | 669 |
metric <- value <- PC <- NULL |
655 |
- |
|
656 |
- df = melt(cor_qc()[,1:input$dim]) |
|
670 |
+ |
|
671 |
+ df = reshape2::melt(cor_qc()[,1:input$dim]) |
|
657 | 672 |
colnames(df) = c("metric","PC","value") |
658 | 673 |
df$metric = factor(df$metric,levels = colnames(qc)) |
659 | 674 |
df$PC = factor(df$PC, |
660 | 675 |
levels = paste0("PC",1:input$dim)) |
661 |
- p <- ggplot(data = df, aes(x = PC, |
|
662 |
- fill = metric, |
|
676 |
+ p <- ggplot(data = df, aes(x = PC, |
|
677 |
+ fill = metric, |
|
663 | 678 |
weight=value)) + |
664 |
- geom_bar(position = "dodge") + |
|
665 |
- ylim(0, 1) + |
|
679 |
+ geom_bar(position = "dodge") + |
|
680 |
+ ylim(0, 1) + |
|
666 | 681 |
labs(x="PC of Expression", |
667 |
- y="Absolute Correlation") + |
|
682 |
+ y="Absolute Correlation") + |
|
668 | 683 |
theme(legend.title=element_blank()) |
669 | 684 |
ggplotly(p) |
670 | 685 |
}) |
671 |
- |
|
672 |
- pc_obj_qc <- reactive({ |
|
686 |
+ |
|
687 |
+ pc_obj_qc <- shiny::reactive({ |
|
673 | 688 |
prcomp(as.matrix(qc),center = TRUE, scale = TRUE) |
674 | 689 |
}) |
675 |
- |
|
676 |
- output$plot_qc <- renderPlot({ |
|
690 |
+ |
|
691 |
+ output$plot_qc <- shiny::renderPlot({ |
|
677 | 692 |
par(mar=c(5.1, 4.1, 4.1, 10.1), xpd=TRUE) |
678 | 693 |
plot(pc_obj_qc()$x[,1:2],col = pc_col(), pch = 16) |
679 | 694 |
legend("topright", inset=c(-0.3,0), |
680 | 695 |
legend=levels(factor(strat_col())), |
681 | 696 |
fill = cc[sort(unique(factor(strat_col())))]) |
682 | 697 |
}) |
683 |
- |
|
684 |
- output$plot3d_qc <- renderPlotly({ |
|
698 |
+ |
|
699 |
+ output$plot3d_qc <- shiny::renderPlotly({ |
|
685 | 700 |
if(ncol(pc_obj_qc()$x) >= 3){ |
686 | 701 |
PC1 <- PC2 <- PC3 <- NULL |
687 | 702 |
df <- setNames(data.frame(pc_obj_qc()$x[,1:3]), |
688 | 703 |
c("PC1", "PC2", "PC3")) |
689 |
- plot_ly(df, x = ~PC1, y = ~PC2, z = ~PC3, |
|
690 |
- type = "scatter3d", |
|
704 |
+ plot_ly(df, x = ~PC1, y = ~PC2, z = ~PC3, |
|
705 |
+ type = "scatter3d", |
|
691 | 706 |
mode = "markers", |
692 | 707 |
marker = list(color=pc_col() )) |
693 | 708 |
}else{ |
694 | 709 |
plot_ly(data.frame(), type = "scatter3d", mode = "markers") |
695 | 710 |
} |
696 | 711 |
}) |
697 |
- |
|
712 |
+ |
|
698 | 713 |
## ------ Silhouette Tab ------ |
699 |
- |
|
700 |
- sil_obj <- reactive({ |
|
714 |
+ |
|
715 |
+ sil_obj <- shiny::reactive({ |
|
701 | 716 |
cluster::silhouette(x = as.numeric(strat_col()), |
702 | 717 |
dist = dist(pc_obj_base()$x[,1:input$dim])) |
703 | 718 |
}) |
704 |
- |
|
705 |
- output$plotsil <- renderPlot({ |
|
706 |
- |
|
719 |
+ |
|
720 |
+ output$plotsil <- shiny::renderPlot({ |
|
721 |
+ |
|
707 | 722 |
par(mar=c(5.1, 4.1, 4.1, 10.1), xpd=TRUE) |
708 |
- |
|
723 |
+ |
|
709 | 724 |
if(length(unique(strat_col())) > 1){ |
710 |
- |
|
725 |
+ |
|
711 | 726 |
sil = sil_obj() |
712 | 727 |
o1 = order(sil[,3]) |
713 | 728 |
o = o1[order(-sil[,1][o1])] |
... | ... |
@@ -717,205 +732,205 @@ sconeReport = function(x, methods, |
717 | 732 |
xlim = 1.5*range(c(sil[,3],-sil[,3])), |
718 | 733 |
col = pc_col()[o], |
719 | 734 |
border = pc_col()[o]) |
720 |
- legend("topright", inset=c(-0.3,0), |
|
721 |
- legend=levels(factor(strat_col())), |
|
735 |
+ legend("topright", inset=c(-0.3,0), |
|
736 |
+ legend=levels(factor(strat_col())), |
|
722 | 737 |
fill = cc[sort(unique(factor(strat_col())))]) |
723 |
- |
|
738 |
+ |
|
724 | 739 |
}else{ |
725 |
- |
|
740 |
+ |
|
726 | 741 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
727 | 742 |
text(0,labels = "Stratify plots by a multi-level classification.") |
728 |
- |
|
743 |
+ |
|
729 | 744 |
} |
730 |
- |
|
745 |
+ |
|
731 | 746 |
}) |
732 |
- |
|
733 |
- cat1 <- reactive({ |
|
747 |
+ |
|
748 |
+ cat1 <- shiny::reactive({ |
|
734 | 749 |
switch(input$cat1, |
735 | 750 |
bio = bio, |
736 | 751 |
batch = batch, |
737 | 752 |
clust = pam_obj()$clust) |
738 | 753 |
}) |
739 |
- |
|
740 |
- cat2 <- reactive({ |
|
754 |
+ |
|
755 |
+ cat2 <- shiny::reactive({ |
|
741 | 756 |
switch(input$cat2, |
742 | 757 |
bio = bio, |
743 | 758 |
batch = batch, |
744 | 759 |
clust = pam_obj()$clust) |
745 | 760 |
}) |
746 |
- |
|
747 |
- output$cat_tab <- renderTable({ |
|
748 |
- table(cat1(), cat2()) |
|
761 |
+ |
|
762 |
+ output$cat_tab <- shiny::renderTable({ |
|
763 |
+ table(cat1(), cat2()) |
|
749 | 764 |
}) |
750 |
- |
|
751 |
- |
|
765 |
+ |
|
766 |
+ |
|
752 | 767 |
## ------ Control Genes Tab ------ |
753 |
- |
|
754 |
- silo <- reactive({ |
|
768 |
+ |
|
769 |
+ silo <- shiny::reactive({ |
|
755 | 770 |
sil = sil_obj() |
756 | 771 |
o1 = order(sil[,3]) |
757 |
- o1[order(-sil[,1][o1])] |
|
772 |
+ o1[order(-sil[,1][o1])] |
|
758 | 773 |
}) |
759 |
- |
|
760 |
- output$hmnegcon <- renderPlot({ |
|
761 |
- |
|
774 |
+ |
|
775 |
+ output$hmnegcon <- shiny::renderPlot({ |
|
776 |
+ |
|
762 | 777 |
if(length(negcon) > 0){ |
763 |
- |
|
778 |
+ |
|
764 | 779 |
if(length(unique(strat_col())) > 1){ |
765 |
- |
|
766 |
- aheatmap(normle()[negcon,], Colv = silo(), |
|
780 |
+ |
|
781 |
+ NMF::aheatmap(normle()[negcon,], Colv = silo(), |
|
767 | 782 |
annCol = list(batch = batch, bio = bio, |
768 | 783 |
pam = as.factor(pam_obj()$clust)), |
769 | 784 |
annColors = list(batch = cc, bio = cc, pam = cc)) |
770 |
- |
|
785 |
+ |
|
771 | 786 |
}else{ |
772 |
- |
|
787 |
+ |
|
773 | 788 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
774 | 789 |
text(0,labels = "Stratify plots by a multi-level classification.") |
775 |
- |
|
790 |
+ |
|
776 | 791 |
} |
777 |
- |
|
792 |
+ |
|
778 | 793 |
}else{ |
779 |
- |
|
794 |
+ |
|
780 | 795 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
781 | 796 |
text(0,labels = "Control gene set is empty.") |
782 |
- |
|
797 |
+ |
|
783 | 798 |
} |
784 |
- |
|
799 |
+ |
|
785 | 800 |
}) |
786 |
- |
|
787 |
- output$hmposcon <- renderPlot({ |
|
788 |
- |
|
801 |
+ |
|
802 |
+ output$hmposcon <- shiny::renderPlot({ |
|
803 |
+ |
|
789 | 804 |
if(length(poscon) > 0){ |
790 |
- |
|
805 |
+ |
|
791 | 806 |
if(length(unique(strat_col())) > 1){ |
792 |
- |
|
793 |
- aheatmap(normle()[poscon,], Colv = silo(), |
|
794 |
- annCol = list(batch = batch, |
|
795 |
- bio = bio, |
|
807 |
+ |
|
808 |
+ NMF::aheatmap(normle()[poscon,], Colv = silo(), |
|
809 |
+ annCol = list(batch = batch, |
|
810 |
+ bio = bio, |
|
796 | 811 |
pam = as.factor(pam_obj()$clust)), |
797 | 812 |
annColors = list(batch = cc, bio = cc, pam = cc)) |
798 |
- |
|
813 |
+ |
|
799 | 814 |
}else{ |
800 |
- |
|
815 |
+ |
|
801 | 816 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
802 | 817 |
text(0,labels = "Stratify plots by a multi-level classification.") |
803 |
- |
|
818 |
+ |
|
804 | 819 |
} |
805 |
- |
|
820 |
+ |
|
806 | 821 |
}else{ |
807 |
- |
|
822 |
+ |
|
808 | 823 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
809 | 824 |
text(0,labels = "Control gene set is empty.") |
810 |
- |
|
825 |
+ |
|
811 | 826 |
} |
812 |
- |
|
827 |
+ |
|
813 | 828 |
}) |
814 |
- |
|
829 |
+ |
|
815 | 830 |
## ------ Stratified PCA Tab ------ |
816 |
- |
|
817 |
- output$violin_base <- renderPlot({ |
|
818 |
- |
|
831 |
+ |
|
832 |
+ output$violin_base <- shiny::renderPlot({ |
|
833 |
+ |
|
819 | 834 |
Class = factor(strat_col()) |
820 |
- Val = pc_obj_base()$x[,input$pcsel] |
|
821 |
- |
|
822 |
- ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) + |
|
823 |
- geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+ |
|
835 |
+ Val = pc_obj_base()$x[,input$pcsel] |
|
836 |
+ |
|
837 |
+ ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) + |
|
838 |
+ geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+ |
|
824 | 839 |
labs(x = "Plot Stratification", y = "PC") + |
825 | 840 |
coord_cartesian(ylim = max(abs(range(Val)))*c(-1.5,1.5)) + |
826 | 841 |
scale_fill_manual(values=cc[sort(unique(factor(strat_col())))]) + |
827 | 842 |
geom_point(colour = "black") + guides(fill=FALSE) |
828 |
- |
|
843 |
+ |
|
829 | 844 |
}) |
830 |
- |
|
831 |
- pc_gene2 <- reactive({ |
|
845 |
+ |
|
846 |
+ pc_gene2 <- shiny::reactive({ |
|
832 | 847 |
switch(input$gene_set2, |
833 | 848 |
pos = intersect(poscon,rownames(normle())), |
834 | 849 |
neg = intersect(negcon,rownames(normle()))) |
835 | 850 |
}) |
836 |
- |
|
837 |
- pc_obj_select2 <- reactive({ |
|
838 |
- |
|
851 |
+ |
|
852 |
+ pc_obj_select2 <- shiny::reactive({ |
|
853 |
+ |
|
839 | 854 |
# If selected genes exist |
840 | 855 |
if(length(pc_gene2()) > 0){ |
841 |
- |
|
856 |
+ |
|
842 | 857 |
# If user has not provided evaluation projection |
843 | 858 |
if(is.null(eval_proj)){ |
844 |
- |
|
859 |
+ |
|
845 | 860 |
prcomp(t(normle()[pc_gene2(),]), |
846 | 861 |
center = TRUE, scale = TRUE) |
847 |
- |
|
862 |
+ |
|
848 | 863 |
} else { |
849 |
- |
|
864 |
+ |
|
850 | 865 |
proj = eval_proj(normle()[pc_gene2(),], |
851 | 866 |
eval_proj_args = eval_proj_args) |
852 | 867 |
colnames(proj) = paste0("PC",1:ncol(proj)) |
853 |
- |
|
868 |
+ |
|
854 | 869 |
pc_out = list(x = proj, sdev = apply(proj,2,sd)) |
855 |
- |
|
870 |
+ |
|
856 | 871 |
pc_out |
857 |
- |
|
872 |
+ |
|
858 | 873 |
} |
859 |
- |
|
874 |
+ |
|
860 | 875 |
}else{ |
861 | 876 |
list() |
862 | 877 |
} |
863 |
- |
|
878 |
+ |
|
864 | 879 |
}) |
865 |
- |
|
866 |
- output$violin_select <- renderPlot({ |
|
867 |
- |
|
880 |
+ |
|
881 |
+ output$violin_select <- shiny::renderPlot({ |
|
882 |
+ |
|
868 | 883 |
if(length(pc_gene2()) > 0){ |
869 |
- |
|
884 |
+ |
|
870 | 885 |
Class = factor(strat_col()) |
871 |
- Val = pc_obj_select2()$x[,input$pcsel] |
|
872 |
- |
|
873 |
- ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) + |
|
874 |
- geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+ |
|
886 |
+ Val = pc_obj_select2()$x[,input$pcsel] |
|
887 |
+ |
|
888 |
+ ggplot(data.frame(Class,Val ),aes(x = Class,y = Val)) + |
|
889 |
+ geom_violin(scale = "width", trim = TRUE, aes(fill = Class))+ |
|
875 | 890 |
labs(x = "Plot Stratification", y = "PC") + |
876 | 891 |
coord_cartesian(ylim = max(abs(range(Val)))*c(-1.5,1.5)) + |
877 | 892 |
scale_fill_manual(values=cc[sort(unique(factor(strat_col())))]) + |
878 | 893 |
geom_point(colour = "black") + guides(fill=FALSE) |
879 |
- |
|
894 |
+ |
|
880 | 895 |
}else{ |
881 |
- |
|
896 |
+ |
|
882 | 897 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
883 | 898 |
text(0,labels = "Control gene set is empty.") |
884 |
- |
|
899 |
+ |
|
885 | 900 |
} |
886 | 901 |
}) |
887 |
- |
|
902 |
+ |
|
888 | 903 |
## ------ Relative Log-Expression ------ |
889 |
- |
|
890 |
- output$rle <- renderPlot({ |
|
891 |
- |
|
904 |
+ |
|
905 |
+ output$rle <- shiny::renderPlot({ |
|
906 |
+ |
|
892 | 907 |
par(mar=c(5.1, 4.1, 4.1, 10.1), xpd=TRUE) |
893 |
- |
|
908 |
+ |
|
894 | 909 |
if(length(unique(strat_col())) > 1){ |
895 |
- |
|
910 |
+ |
|
896 | 911 |
vars = apply(exp(normle()),1,var) |
897 | 912 |
is_var = rank(-vars) <= 100 |
898 | 913 |
median <- apply(normle()[is_var,], 1, median) |
899 | 914 |
rle <- apply(normle()[is_var,], 2, function(x) x - median) |
900 |
- boxplot(rle[,rev(silo())],col = pc_col()[rev(silo())], |
|
915 |
+ boxplot(rle[,rev(silo())],col = pc_col()[rev(silo())], |
|
901 | 916 |
outline = FALSE, names = rep("",ncol(rle))) |
902 | 917 |
abline(h=0, lty=2) |
903 | 918 |
legend("topright", inset=c(-0.2,0), |
904 |
- legend=levels(factor(strat_col())), |
|
919 |
+ legend=levels(factor(strat_col())), |
|
905 | 920 |
fill = cc[sort(unique(factor(strat_col())))]) |
906 |
- |
|
921 |
+ |
|
907 | 922 |
}else{ |
908 |
- |
|
923 |
+ |
|
909 | 924 |
plot(0, type = 'n',xlab = "",ylab = "",xaxt = 'n',yaxt = 'n') |
910 | 925 |
text(0,labels = "Stratify plots by a multi-level classification.") |
911 |
- |
|
926 |
+ |
|
912 | 927 |
} |
913 |
- |
|
928 |
+ |
|
914 | 929 |
}) |
915 |
- |
|
930 |
+ |
|
916 | 931 |
## ----- Download Button ----- |
917 |
- |
|
918 |
- output$downloadData <- downloadHandler( |
|
932 |
+ |
|
933 |
+ output$downloadData <- shiny::downloadHandler( |
|
919 | 934 |
filename = function() { |
920 | 935 |
paste('scone_out-', Sys.Date(), '.csv', sep='') |
921 | 936 |
}, |
... | ... |
@@ -929,10 +944,10 @@ sconeReport = function(x, methods, |
929 | 944 |
write.csv(datt, con) |
930 | 945 |
} |
931 | 946 |
) |
932 |
- |
|
947 |
+ |
|
933 | 948 |
} |
934 |
- |
|
949 |
+ |
|
935 | 950 |
# Shiny App |
936 |
- shinyApp(ui = ui, server = server) |
|
937 |
- |
|
951 |
+ shiny::shinyApp(ui = ui, server = server) |
|
952 |
+ |
|
938 | 953 |
} |
... | ... |
@@ -21,16 +21,16 @@ Default NULL.} |
21 | 21 |
\item{batch}{factor. A known batch variable (variation to be removed). |
22 | 22 |
Default NULL.} |
23 | 23 |
|
24 |
-\item{poscon}{character. Genes to be used as positive controls for |
|
25 |
-evaluation. These genes should be expected to change according to the |
|
24 |
+\item{poscon}{character. Genes to be used as positive controls for |
|
25 |
+evaluation. These genes should be expected to change according to the |
|
26 | 26 |
biological phenomenon of interest. Default empty character.} |
27 | 27 |
|
28 |
-\item{negcon}{character. Genes to be used as negative controls for |
|
29 |
-evaluation. These genes should be expected not to change according to the |
|
28 |
+\item{negcon}{character. Genes to be used as negative controls for |
|
29 |
+evaluation. These genes should be expected not to change according to the |
|
30 | 30 |
biological phenomenon of interest. Default empty character.} |
31 | 31 |
|
32 |
-\item{eval_proj}{function. Projection function for evaluation (see |
|
33 |
-\code{\link{score_matrix}} for details). If NULL, PCA is used for |
|
32 |
+\item{eval_proj}{function. Projection function for evaluation (see |
|
33 |
+\code{\link{score_matrix}} for details). If NULL, PCA is used for |
|
34 | 34 |
projection.} |
35 | 35 |
|
36 | 36 |
\item{eval_proj_args}{list. List of args passed to projection function as |
... | ... |
@@ -40,7 +40,7 @@ eval_proj_args.} |
40 | 40 |
An object that represents the SCONE report app. |
41 | 41 |
} |
42 | 42 |
\description{ |
43 |
-This function opens a shiny application session for visualizing performance |
|
43 |
+This function opens a shiny application session for visualizing performance |
|
44 | 44 |
of a variety of normalization schemes. |
45 | 45 |
} |
46 | 46 |
\examples{ |
... | ... |
@@ -49,7 +49,7 @@ mat <- matrix(rpois(1000, lambda = 5), ncol=10) |
49 | 49 |
colnames(mat) <- paste("X", 1:ncol(mat), sep="") |
50 | 50 |
obj <- SconeExperiment(mat) |
51 | 51 |
res <- scone(obj, scaling=list(none=identity, uq=UQ_FN, deseq=DESEQ_FN), |
52 |
- evaluate=TRUE, k_ruv=0, k_qc=0, eval_kclust=2, |
|
52 |
+ evaluate=TRUE, k_ruv=0, k_qc=0, eval_kclust=2, |
|
53 | 53 |
bpparam = BiocParallel::SerialParam()) |
54 | 54 |
qc = as.matrix(cbind(colSums(mat),colSums(mat > 0))) |
55 | 55 |
rownames(qc) = colnames(mat) |