Browse code

one full round of styler on the codebase, also re-rendering manpages

Federico Marini authored on 27/05/2021 11:22:48
Showing 92 changed files

... ...
@@ -30,7 +30,7 @@ NULL
30 30
 #'
31 31
 #' Details on how this object has been created are included in the `create_gt_data.R`
32 32
 #' script, included in the `scripts` folder of the `GeneTonic` package.
33
-#' 
33
+#'
34 34
 #' @family pathway-analysis-results
35 35
 #'
36 36
 #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene
... ...
@@ -54,7 +54,7 @@ NULL
54 54
 #'
55 55
 #' Details on how this object has been created are included in the `create_gt_data.R`
56 56
 #' script, included in the `scripts` folder of the `GeneTonic` package.
57
-#' 
57
+#'
58 58
 #' @family pathway-analysis-results
59 59
 #'
60 60
 #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene
... ...
@@ -79,7 +79,7 @@ NULL
79 79
 #'
80 80
 #' Details on how this object has been created are included in the `create_gt_data.R`
81 81
 #' script, included in the `scripts` folder of the `GeneTonic` package.
82
-#' 
82
+#'
83 83
 #' @family pathway-analysis-results
84 84
 #'
85 85
 #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene
... ...
@@ -111,6 +111,3 @@ NULL
111 111
 #' @name fgseaRes
112 112
 #' @docType data
113 113
 NULL
114
-
115
-
116
-
... ...
@@ -44,7 +44,7 @@
44 44
 #'
45 45
 #' # dds object
46 46
 #' data("gse", package = "macrophage")
47
-#' dds_macrophage <- DESeqDataSet(gse, design = ~line + condition)
47
+#' dds_macrophage <- DESeqDataSet(gse, design = ~ line + condition)
48 48
 #' rownames(dds_macrophage) <- substr(rownames(dds_macrophage), 1, 15)
49 49
 #' dds_macrophage <- estimateSizeFactors(dds_macrophage)
50 50
 #'
... ...
@@ -52,9 +52,10 @@
52 52
 #' anno_df <- data.frame(
53 53
 #'   gene_id = rownames(dds_macrophage),
54 54
 #'   gene_name = mapIds(org.Hs.eg.db,
55
-#'                      keys = rownames(dds_macrophage),
56
-#'                      column = "SYMBOL",
57
-#'                      keytype = "ENSEMBL"),
55
+#'     keys = rownames(dds_macrophage),
56
+#'     column = "SYMBOL",
57
+#'     keytype = "ENSEMBL"
58
+#'   ),
58 59
 #'   stringsAsFactors = FALSE,
59 60
 #'   row.names = rownames(dds_macrophage)
60 61
 #' )
... ...
@@ -77,22 +78,26 @@
77 78
 #' )
78 79
 #'
79 80
 #' # now everything is in place to launch the app
80
-#' if (interactive())
81
+#' if (interactive()) {
81 82
 #'   GeneTonic(gtl = gtl_macrophage)
83
+#' }
82 84
 GeneTonic_list <- function(dds,
83
-                      res_de,
84
-                      res_enrich,
85
-                      annotation_obj) {
86
-
87
-  checkup_GeneTonic(dds,
88
-                    res_de,
89
-                    res_enrich,
90
-                    annotation_obj)
85
+                           res_de,
86
+                           res_enrich,
87
+                           annotation_obj) {
88
+  checkup_GeneTonic(
89
+    dds,
90
+    res_de,
91
+    res_enrich,
92
+    annotation_obj
93
+  )
91 94
 
92
-  gtl <- list(dds = dds,
93
-              res_de = res_de,
94
-              res_enrich = res_enrich,
95
-              annotation_obj = annotation_obj)
95
+  gtl <- list(
96
+    dds = dds,
97
+    res_de = res_de,
98
+    res_enrich = res_enrich,
99
+    annotation_obj = annotation_obj
100
+  )
96 101
 
97 102
   describe_gtl(gtl)
98 103
 
... ...
@@ -111,7 +116,6 @@ GeneTonic_list <- function(dds,
111 116
 #' @return Invisible NULL - the information is displayed as a message in the
112 117
 #' console
113 118
 describe_gtl <- function(gtl) {
114
-
115 119
   dds <- gtl$dds
116 120
   res_de <- gtl$res_de
117 121
   res_enrich <- gtl$res_enrich
... ...
@@ -138,12 +142,15 @@ describe_gtl <- function(gtl) {
138 142
   message(
139 143
     sprintf(
140 144
       "Providing an expression object (as DESeqDataset) of %d features over %d samples",
141
-      n_features, n_samples)
145
+      n_features, n_samples
146
+    )
142 147
   )
143 148
   message("\n----- res_de object -----")
144 149
   message(
145
-    sprintf("Providing a DE result object (as DESeqResults), %d features tested, %d found as DE",
146
-            n_tested, n_DE)
150
+    sprintf(
151
+      "Providing a DE result object (as DESeqResults), %d features tested, %d found as DE",
152
+      n_tested, n_DE
153
+    )
147 154
   )
148 155
   message(sprintf("Upregulated:     %d", n_upDE))
149 156
   message(sprintf("Downregulated:   %d", n_downDE))
... ...
@@ -158,7 +165,8 @@ describe_gtl <- function(gtl) {
158 165
   message(
159 166
     sprintf(
160 167
       "Providing an annotation object of %d features with information on %d identifier types",
161
-      n_featanno, n_featids)
168
+      n_featanno, n_featids
169
+    )
162 170
   )
163 171
 
164 172
   return(invisible(NULL))
... ...
@@ -202,7 +210,8 @@ go_2_html <- function(go_id,
202 210
       lapply(Synonym(fullinfo), function(arg) {
203 211
         paste0(tags$b("Synonym: "), arg, tags$br())
204 212
       })
205
-    ), collapse = ""
213
+    ),
214
+    collapse = ""
206 215
   )
207 216
   go_secondary <- Secondary(fullinfo)
208 217
   if (!is.null(res_enrich)) {
... ...
@@ -225,9 +234,10 @@ go_2_html <- function(go_id,
225 234
     ifelse(
226 235
       !is.null(res_enrich),
227 236
       paste0(tags$b("p-value: "), go_pvalue, tags$br(),
228
-             tags$b("Z-score: "), go_zscore, tags$br(),
229
-             tags$b("Aggregated score: "), go_aggrscore, tags$br(),
230
-             collapse = ""),
237
+        tags$b("Z-score: "), go_zscore, tags$br(),
238
+        tags$b("Aggregated score: "), go_aggrscore, tags$br(),
239
+        collapse = ""
240
+      ),
231 241
       ""
232 242
     ),
233 243
     tags$b("Ontology: "), go_ontology, tags$br(), tags$br(),
... ...
@@ -236,7 +246,8 @@ go_2_html <- function(go_id,
236 246
     ifelse(
237 247
       length(go_secondary) > 0,
238 248
       paste0(tags$b("Secondary: "), go_secondary, collapse = ""),
239
-      "")
249
+      ""
250
+    )
240 251
   )
241 252
   return(HTML(mycontent))
242 253
 }
... ...
@@ -248,10 +259,12 @@ go_2_html <- function(go_id,
248 259
 #' @return HTML for an action button
249 260
 #' @noRd
250 261
 .link2amigo <- function(val) {
251
-  sprintf('<a href = "http://amigo.geneontology.org/amigo/term/%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
252
-          val,
253
-          .actionbutton_biocstyle,
254
-          val)
262
+  sprintf(
263
+    '<a href = "http://amigo.geneontology.org/amigo/term/%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
264
+    val,
265
+    .actionbutton_biocstyle,
266
+    val
267
+  )
255 268
 }
256 269
 
257 270
 #' Information on a gene
... ...
@@ -284,9 +297,11 @@ geneinfo_2_html <- function(gene_id,
284 297
   if (!is.null(res_de)) {
285 298
     gid <- match(gene_id, res_de$SYMBOL)
286 299
     if (is.na(gid)) {
287
-      message("Could not find the specified gene (`", gene_id,
288
-              "`) in the `res_de` object. \n",
289
-              "Still, the general HTML content has been generated.")
300
+      message(
301
+        "Could not find the specified gene (`", gene_id,
302
+        "`) in the `res_de` object. \n",
303
+        "Still, the general HTML content has been generated."
304
+      )
290 305
       gene_adjpvalue <- tags$em("not found")
291 306
       gene_logfc <- tags$em("not found")
292 307
     } else {
... ...
@@ -303,8 +318,9 @@ geneinfo_2_html <- function(gene_id,
303 318
     ifelse(
304 319
       !is.null(res_de),
305 320
       paste0(tags$b("DE p-value (adjusted): "), gene_adjpvalue, tags$br(),
306
-             tags$b("DE log2FoldChange: "), gene_logfc,
307
-             collapse = ""),
321
+        tags$b("DE log2FoldChange: "), gene_logfc,
322
+        collapse = ""
323
+      ),
308 324
       ""
309 325
     )
310 326
   )
... ...
@@ -318,10 +334,12 @@ geneinfo_2_html <- function(gene_id,
318 334
 #' @return HTML for an action button
319 335
 #' @noRd
320 336
 .link2ncbi <- function(val) {
321
-  sprintf('<a href = "http://www.ncbi.nlm.nih.gov/gene/?term=%s[sym]" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
322
-          val,
323
-          .actionbutton_biocstyle,
324
-          val)
337
+  sprintf(
338
+    '<a href = "http://www.ncbi.nlm.nih.gov/gene/?term=%s[sym]" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
339
+    val,
340
+    .actionbutton_biocstyle,
341
+    val
342
+  )
325 343
 }
326 344
 
327 345
 #' Link to the GeneCards database
... ...
@@ -331,10 +349,12 @@ geneinfo_2_html <- function(gene_id,
331 349
 #' @return HTML for an action button
332 350
 #' @noRd
333 351
 .link2genecards <- function(val) {
334
-  sprintf('<a href = "https://www.genecards.org/cgi-bin/carddisp.pl?gene=%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
335
-          val,
336
-          .actionbutton_biocstyle,
337
-          val)
352
+  sprintf(
353
+    '<a href = "https://www.genecards.org/cgi-bin/carddisp.pl?gene=%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
354
+    val,
355
+    .actionbutton_biocstyle,
356
+    val
357
+  )
338 358
 }
339 359
 
340 360
 #' Link to the GTEx Portal
... ...
@@ -344,10 +364,12 @@ geneinfo_2_html <- function(gene_id,
344 364
 #' @return HTML for an action button
345 365
 #' @noRd
346 366
 .link2gtex <- function(val) {
347
-  sprintf('<a href = "https://www.gtexportal.org/home/gene/%s" target = "_blank" class = "btn btn-primary" style = "%s"><i class="fa fa-dna"></i>%s</a>',
348
-          val,
349
-          .actionbutton_biocstyle,
350
-          val)
367
+  sprintf(
368
+    '<a href = "https://www.gtexportal.org/home/gene/%s" target = "_blank" class = "btn btn-primary" style = "%s"><i class="fa fa-dna"></i>%s</a>',
369
+    val,
370
+    .actionbutton_biocstyle,
371
+    val
372
+  )
351 373
 }
352 374
 
353 375
 
... ...
@@ -365,19 +387,23 @@ generate_buttons_hubgenes <- function(x) {
365 387
       '<a href = "http://www.ncbi.nlm.nih.gov/gene/?term=%s[sym]" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
366 388
       x,
367 389
       .actionbutton_biocstyle,
368
-      "NCBI"),
390
+      "NCBI"
391
+    ),
369 392
     sprintf(
370 393
       '<a href = "https://www.genecards.org/cgi-bin/carddisp.pl?gene=%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
371 394
       x,
372 395
       .actionbutton_biocstyle,
373
-      "GeneCards"),
396
+      "GeneCards"
397
+    ),
374 398
     sprintf(
375 399
       '<a href = "https://www.gtexportal.org/home/gene/%s" target = "_blank" class = "btn btn-primary" style = "%s">%s</a>',
376 400
       x,
377 401
       .actionbutton_biocstyle,
378
-      "GTEx"),
379
-    tags$br(style="display:inline-block"),
380
-    collapse = "\t")
402
+      "GTEx"
403
+    ),
404
+    tags$br(style = "display:inline-block"),
405
+    collapse = "\t"
406
+  )
381 407
   return(mybuttons)
382 408
 }
383 409
 
... ...
@@ -399,7 +425,7 @@ generate_buttons_hubgenes <- function(x) {
399 425
 #' @examples
400 426
 #' a <- seq(1, 21, 2)
401 427
 #' b <- seq(1, 11, 2)
402
-#' overlap_coefficient(a,b)
428
+#' overlap_coefficient(a, b)
403 429
 overlap_coefficient <- function(x, y) {
404 430
   length(intersect(x, y)) / min(length(x), length(y))
405 431
 }
... ...
@@ -417,7 +443,7 @@ overlap_coefficient <- function(x, y) {
417 443
 #' @examples
418 444
 #' a <- seq(1, 21, 2)
419 445
 #' b <- seq(1, 11, 2)
420
-#' overlap_jaccard_index(a,b)
446
+#' overlap_jaccard_index(a, b)
421 447
 overlap_jaccard_index <- function(x, y) {
422 448
   length(intersect(x, y)) / length(unique(c(x, y)))
423 449
   # about 2x faster than using union()
... ...
@@ -463,20 +489,22 @@ overlap_jaccard_index <- function(x, y) {
463 489
 #' res_df <- deseqresult2df(res_macrophage_IFNg_vs_naive)
464 490
 #' library("magrittr")
465 491
 #' library("DT")
466
-#' DT::datatable(res_df [1:50, ],
467
-#'               options = list(
468
-#'                 pageLength = 25,
469
-#'                 columnDefs = list(
470
-#'                   list(className = "dt-center", targets = "_all")
471
-#'                 )
472
-#'               )
492
+#' DT::datatable(res_df[1:50, ],
493
+#'   options = list(
494
+#'     pageLength = 25,
495
+#'     columnDefs = list(
496
+#'       list(className = "dt-center", targets = "_all")
497
+#'     )
498
+#'   )
473 499
 #' ) %>%
474 500
 #'   formatRound(columns = c("log2FoldChange"), digits = 3) %>%
475 501
 #'   formatStyle(
476 502
 #'     "log2FoldChange",
477
-#'     background = styleColorBar_divergent(res_df$log2FoldChange,
478
-#'                                          scales::alpha("navyblue", 0.4),
479
-#'                                          scales::alpha("darkred", 0.4)),
503
+#'     background = styleColorBar_divergent(
504
+#'       res_df$log2FoldChange,
505
+#'       scales::alpha("navyblue", 0.4),
506
+#'       scales::alpha("darkred", 0.4)
507
+#'     ),
480 508
 #'     backgroundSize = "100% 90%",
481 509
 #'     backgroundRepeat = "no-repeat",
482 510
 #'     backgroundPosition = "center"
... ...
@@ -484,17 +512,19 @@ overlap_jaccard_index <- function(x, y) {
484 512
 #'
485 513
 #'
486 514
 #' simplest_df <- data.frame(
487
-#'   a = c(rep("a",9)),
515
+#'   a = c(rep("a", 9)),
488 516
 #'   value = c(-4, -3, -2, -1, 0, 1, 2, 3, 4)
489 517
 #' )
490 518
 #'
491 519
 #' # or with a very simple data frame
492 520
 #' DT::datatable(simplest_df) %>%
493 521
 #'   formatStyle(
494
-#'     'value',
495
-#'     background = styleColorBar_divergent(simplest_df$value,
496
-#'                                          scales::alpha("forestgreen", 0.4),
497
-#'                                          scales::alpha("gold", 0.4)),
522
+#'     "value",
523
+#'     background = styleColorBar_divergent(
524
+#'       simplest_df$value,
525
+#'       scales::alpha("forestgreen", 0.4),
526
+#'       scales::alpha("gold", 0.4)
527
+#'     ),
498 528
 #'     backgroundSize = "100% 90%",
499 529
 #'     backgroundRepeat = "no-repeat",
500 530
 #'     backgroundPosition = "center"
... ...
@@ -502,12 +532,13 @@ overlap_jaccard_index <- function(x, y) {
502 532
 styleColorBar_divergent <- function(data,
503 533
                                     color_pos,
504 534
                                     color_neg) {
505
-
506 535
   max_val <- max(abs(data))
507 536
   JS(
508 537
     sprintf(
509 538
       "isNaN(parseFloat(value)) || value < 0 ? 'linear-gradient(90deg, transparent, transparent ' + (50 + value/%s * 50) + '%%, %s ' + (50 + value/%s * 50) + '%%,%s  50%%,transparent 50%%)': 'linear-gradient(90deg, transparent, transparent 50%%, %s 50%%, %s ' + (50 + value/%s * 50) + '%%, transparent ' + (50 + value/%s * 50) + '%%)'",
510
-      max_val, color_pos, max_val, color_pos, color_neg, color_neg, max_val, max_val))
539
+      max_val, color_pos, max_val, color_pos, color_neg, color_neg, max_val, max_val
540
+    )
541
+  )
511 542
 }
512 543
 
513 544
 
... ...
@@ -530,21 +561,25 @@ styleColorBar_divergent <- function(data,
530 561
 #'
531 562
 #' @examples
532 563
 #' a <- 1:9
533
-#' pal <- RColorBrewer::brewer.pal(9,"Set1")
564
+#' pal <- RColorBrewer::brewer.pal(9, "Set1")
534 565
 #' map2color(a, pal)
535 566
 #' plot(a, col = map2color(a, pal), pch = 20, cex = 4)
536 567
 #'
537 568
 #' b <- 1:50
538 569
 #' pal2 <- grDevices::colorRampPalette(
539
-#'   RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50)
570
+#'   RColorBrewer::brewer.pal(name = "RdYlBu", 11)
571
+#' )(50)
540 572
 #' plot(b, col = map2color(b, pal2), pch = 20, cex = 3)
541 573
 map2color <- function(x, pal, limits = NULL) {
542
-  if (is.null(limits))
574
+  if (is.null(limits)) {
543 575
     limits <- range(x)
576
+  }
544 577
   pal[findInterval(x, seq(limits[1],
545
-                          limits[2],
546
-                          length.out = length(pal) + 1),
547
-                   all.inside = TRUE)]
578
+    limits[2],
579
+    length.out = length(pal) + 1
580
+  ),
581
+  all.inside = TRUE
582
+  )]
548 583
 }
549 584
 
550 585
 
... ...
@@ -566,14 +601,17 @@ map2color <- function(x, pal, limits = NULL) {
566 601
 #' check_colors(mypal)
567 602
 #' mypal2 <- rev(
568 603
 #'   scales::alpha(
569
-#'     colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 0.4))
604
+#'     colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 0.4
605
+#'   )
606
+#' )
570 607
 #' check_colors(mypal2)
571 608
 #' # useful with long vectors to check at once if all cols are fine
572 609
 #' all(check_colors(mypal2))
573 610
 check_colors <- function(x) {
574 611
   vapply(x, function(col) {
575 612
     tryCatch(is.matrix(col2rgb(col)),
576
-             error = function(e) FALSE)
613
+      error = function(e) FALSE
614
+    )
577 615
   }, logical(1))
578 616
 }
579 617
 
... ...
@@ -598,15 +636,17 @@ check_colors <- function(x) {
598 636
 #' res_df <- deseqresult2df(res_macrophage_IFNg_vs_naive)
599 637
 #' head(res_df)
600 638
 deseqresult2df <- function(res_de, FDR = NULL) {
601
-  if (!is(res_de, "DESeqResults"))
639
+  if (!is(res_de, "DESeqResults")) {
602 640
     stop("Not a DESeqResults object.")
641
+  }
603 642
   res <- as.data.frame(res_de)
604 643
   res <- cbind(rownames(res), res)
605 644
   names(res)[1] <- "id"
606 645
   res$id <- as.character(res$id)
607 646
   res <- res[order(res$padj), ]
608
-  if (!is.null(FDR))
647
+  if (!is.null(FDR)) {
609 648
     res <- res[!(is.na(res$padj)) & res$padj <= FDR, ]
649
+  }
610 650
   res
611 651
 }
612 652
 
... ...
@@ -627,10 +667,9 @@ deseqresult2df <- function(res_de, FDR = NULL) {
627 667
 #' @examples
628 668
 #' library("igraph")
629 669
 #' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5)
630
-#' g <- add_edges(g, c(1,6, 1,11, 6, 11))
670
+#' g <- add_edges(g, c(1, 6, 1, 11, 6, 11))
631 671
 #' export_to_sif(g, tempfile())
632 672
 export_to_sif <- function(g, sif_file = "", edge_label = "relates_to") {
633
-
634 673
   stopifnot(is(g, "igraph"))
635 674
   stopifnot(is.character(sif_file) & length(sif_file) == 1)
636 675
   sif_file <- normalizePath(sif_file, mustWork = FALSE)
... ...
@@ -643,8 +682,10 @@ export_to_sif <- function(g, sif_file = "", edge_label = "relates_to") {
643 682
     n2 = el[, 2]
644 683
   )
645 684
   message("Saving the file to ", sif_file)
646
-  write.table(sif_df, file = sif_file, sep = "\t", quote = FALSE,
647
-              col.names = FALSE, row.names = FALSE)
685
+  write.table(sif_df,
686
+    file = sif_file, sep = "\t", quote = FALSE,
687
+    col.names = FALSE, row.names = FALSE
688
+  )
648 689
   message("Done!")
649 690
   return(invisible(sif_file))
650 691
 }
... ...
@@ -677,9 +718,9 @@ GeneTonic_footer <- fluidRow(
677 718
 
678 719
 .onLoad <- function(libname, pkgname) {
679 720
   # Create link to logo
680
-  #nocov start
721
+  # nocov start
681 722
   shiny::addResourcePath("GeneTonic", system.file("www", package = "GeneTonic"))
682
-  #nocov end
723
+  # nocov end
683 724
 }
684 725
 
685 726
 
... ...
@@ -694,13 +735,15 @@ gt_downloadButton <- function(outputId,
694 735
                               icon = "magic",
695 736
                               class = NULL,
696 737
                               ...) {
697
-  aTag <- tags$a(id = outputId,
698
-                 class = paste("btn btn-default shiny-download-link", class),
699
-                 href = "",
700
-                 target = "_blank",
701
-                 download = NA,
702
-                 icon(icon),
703
-                 label)
738
+  aTag <- tags$a(
739
+    id = outputId,
740
+    class = paste("btn btn-default shiny-download-link", class),
741
+    href = "",
742
+    target = "_blank",
743
+    download = NA,
744
+    icon(icon),
745
+    label
746
+  )
704 747
 }
705 748
 
706 749
 
... ...
@@ -2,16 +2,16 @@
2 2
 #'
3 3
 #' `GeneTonic` is a Bioconductor package that provides an interactive Shiny-based
4 4
 #' graphical user interface for streamlining the interpretation of RNA-seq data
5
-#'  
6
-#' `GeneTonic` simplifies and optimizes the integration of all components of 
7
-#' Diffeential Expression analysis, with functional enrichment analyis and the 
5
+#'
6
+#' `GeneTonic` simplifies and optimizes the integration of all components of
7
+#' Diffeential Expression analysis, with functional enrichment analyis and the
8 8
 #' original expression quantifications.
9
-#' It does so in a way that makes it easier to generate insightful observations 
10
-#' and hypothesis - combining the benefits of interactivity and reproducibility, 
11
-#' e.g. by capturing the features and gene sets of interest highlighted during 
12
-#' the live session, and creating an HTML report as an artifact where text, 
9
+#' It does so in a way that makes it easier to generate insightful observations
10
+#' and hypothesis - combining the benefits of interactivity and reproducibility,
11
+#' e.g. by capturing the features and gene sets of interest highlighted during
12
+#' the live session, and creating an HTML report as an artifact where text,
13 13
 #' code, and output coexist.
14
-#'  
14
+#'
15 15
 #' @author Federico Marini \email{marinif@@uni-mainz.de}
16 16
 #'
17 17
 #' @importFrom AnnotationDbi Definition GOID Ontology Secondary Synonym Term
... ...
@@ -61,7 +61,7 @@
61 61
 #' @importFrom tidyr separate_rows pivot_longer
62 62
 #' @importFrom tools file_ext file_path_sans_ext
63 63
 #' @importFrom utils read.delim sessionInfo browseURL citation data write.table
64
-#' @importFrom visNetwork renderVisNetwork visExport visIgraph visNetworkOutput 
64
+#' @importFrom visNetwork renderVisNetwork visExport visIgraph visNetworkOutput
65 65
 #' visOptions
66 66
 #' @importFrom viridis viridis
67 67
 #'
... ...
@@ -43,7 +43,7 @@
43 43
 #'
44 44
 #' # dds object
45 45
 #' data("gse", package = "macrophage")
46
-#' dds_macrophage <- DESeqDataSet(gse, design = ~line + condition)
46
+#' dds_macrophage <- DESeqDataSet(gse, design = ~ line + condition)
47 47
 #' rownames(dds_macrophage) <- substr(rownames(dds_macrophage), 1, 15)
48 48
 #' dds_macrophage <- estimateSizeFactors(dds_macrophage)
49 49
 #'
... ...
@@ -51,9 +51,10 @@
51 51
 #' anno_df <- data.frame(
52 52
 #'   gene_id = rownames(dds_macrophage),
53 53
 #'   gene_name = mapIds(org.Hs.eg.db,
54
-#'                      keys = rownames(dds_macrophage),
55
-#'                      column = "SYMBOL",
56
-#'                      keytype = "ENSEMBL"),
54
+#'     keys = rownames(dds_macrophage),
55
+#'     column = "SYMBOL",
56
+#'     keytype = "ENSEMBL"
57
+#'   ),
57 58
 #'   stringsAsFactors = FALSE,
58 59
 #'   row.names = rownames(dds_macrophage)
59 60
 #' )
... ...
@@ -69,17 +70,22 @@
69 70
 #' res_enrich <- get_aggrscores(res_enrich, res_de, anno_df)
70 71
 #'
71 72
 #' # now everything is in place to launch the app
72
-#' if (interactive())
73
-#'   GeneTonic(dds = dds_macrophage,
74
-#'             res_de = res_de,
75
-#'             res_enrich = res_enrich,
76
-#'             annotation_obj = anno_df,
77
-#'             project_id = "myexample")
73
+#' if (interactive()) {
74
+#'   GeneTonic(
75
+#'     dds = dds_macrophage,
76
+#'     res_de = res_de,
77
+#'     res_enrich = res_enrich,
78
+#'     annotation_obj = anno_df,
79
+#'     project_id = "myexample"
80
+#'   )
81
+#' }
78 82
 #' # alternatively...
79
-#' gtl_macrophage <- GeneTonic_list(dds = dds_macrophage,
80
-#'                                  res_de = res_de,
81
-#'                                  res_enrich = res_enrich,
82
-#'                                  annotation_obj = anno_df)
83
+#' gtl_macrophage <- GeneTonic_list(
84
+#'   dds = dds_macrophage,
85
+#'   res_de = res_de,
86
+#'   res_enrich = res_enrich,
87
+#'   annotation_obj = anno_df
88
+#' )
83 89
 #' # GeneTonic(gtl = gtl_macrophage)
84 90
 GeneTonic <- function(dds,
85 91
                       res_de,
... ...
@@ -105,15 +111,19 @@ GeneTonic <- function(dds,
105 111
   }
106 112
 
107 113
   # checks on the objects provided
108
-  checkup_GeneTonic(dds,
109
-                    res_de,
110
-                    res_enrich,
111
-                    annotation_obj)
114
+  checkup_GeneTonic(
115
+    dds,
116
+    res_de,
117
+    res_enrich,
118
+    annotation_obj
119
+  )
112 120
 
113 121
   # clean up the result object, e.g. removing the NAs in the relevant columns
114 122
   removed_genes <- is.na(res_de$log2FoldChange)
115
-  message("Removing ", sum(removed_genes),
116
-          "/", nrow(res_de), " rows from the DE `res_de` object - log2FC values detected as NA")
123
+  message(
124
+    "Removing ", sum(removed_genes),
125
+    "/", nrow(res_de), " rows from the DE `res_de` object - log2FC values detected as NA"
126
+  )
117 127
   res_de <- res_de[!removed_genes, ]
118 128
 
119 129
   # UI definition -----------------------------------------------------------
... ...
@@ -128,8 +138,10 @@ GeneTonic <- function(dds,
128 138
       # older leftUi elements
129 139
       tagList(
130 140
         tags$code(tags$h3("GeneTonic")),
131
-        actionButton("bookmarker", label = "Bookmark", icon = icon("heart"),
132
-                     style = "color: #ffffff; background-color: #ac0000; border-color: #ffffff", class = "ml-5")
141
+        actionButton("bookmarker",
142
+          label = "Bookmark", icon = icon("heart"),
143
+          style = "color: #ffffff; background-color: #ac0000; border-color: #ffffff", class = "ml-5"
144
+        )
133 145
       ),
134 146
       # older rightUi elements
135 147
       # ideally to be spaced on the full right side...
... ...
@@ -150,8 +162,9 @@ GeneTonic <- function(dds,
150 162
             icon = icon("book-open"),
151 163
             label = "Open GeneTonic Vignette", style = .actionbutton_biocstyle,
152 164
             onclick = ifelse(system.file("doc", "GeneTonic_manual.html", package = "GeneTonic") != "",
153
-                             "",
154
-                             "window.open('https://federicomarini.github.io/GeneTonic/articles/GeneTonic_manual.html', '_blank')")
165
+              "",
166
+              "window.open('https://federicomarini.github.io/GeneTonic/articles/GeneTonic_manual.html', '_blank')"
167
+            )
155 168
             # sprintf("window.open('http://bioconductor.org/packages/%s/bioc/vignettes/GeneTonic/inst/doc/GeneTonic_manual.html', '_blank')",
156 169
             #         ifelse(unlist(packageVersion("GeneTonic"))[2] %% 2L==0L, "release", "devel")
157 170
             # )
... ...
@@ -187,7 +200,7 @@ GeneTonic <- function(dds,
187 200
       ),
188 201
       title = bs4Dash::bs4DashBrand(
189 202
         title = HTML("<small>GeneTonic</small>"),
190
-        href =  "https://bioconductor.org/packages/GeneTonic",
203
+        href = "https://bioconductor.org/packages/GeneTonic",
191 204
         # color = "info",
192 205
         image = "GeneTonic/GeneTonic.png"
193 206
       ),
... ...
@@ -195,9 +208,9 @@ GeneTonic <- function(dds,
195 208
       status = "gray-dark",
196 209
       border = FALSE,
197 210
       controlbarIcon = icon("gears"),
198
-      fixed = TRUE #,
199
-      # leftUi = 
200
-      # rightUi = 
211
+      fixed = TRUE # ,
212
+      # leftUi =
213
+      # rightUi =
201 214
     ),
202 215
 
203 216
     # sidebar definition ------------------------------------------------------
... ...
@@ -212,7 +225,6 @@ GeneTonic <- function(dds,
212 225
       # src = "logos/online-learning.png",
213 226
       elevation = 1,
214 227
       opacity = 0.8,
215
-
216 228
       bs4SidebarMenu(
217 229
         id = "gt_tabs",
218 230
         bs4SidebarMenuItem(
... ...
@@ -272,13 +284,11 @@ GeneTonic <- function(dds,
272 284
           )
273 285
         )
274 286
       ),
275
-
276 287
       tags$head(
277 288
         tags$style(
278 289
           ".biocdlbutton{background-color:#0092AC;} .biocdlbutton{color: #ffffff;}"
279 290
         )
280 291
       ),
281
-
282 292
       tags$script(HTML("$(function(){
283 293
       $(document).keyup(function(e) {
284 294
       if (e.which == 17) {
... ...
@@ -307,7 +317,8 @@ GeneTonic <- function(dds,
307 317
             column(
308 318
               width = 1,
309 319
               actionButton(
310
-                "tour_firststeps", label = "", icon = icon("question-circle"),
320
+                "tour_firststeps",
321
+                label = "", icon = icon("question-circle"),
311 322
                 style = .helpbutton_biocstyle
312 323
               )
313 324
             )
... ...
@@ -374,7 +385,8 @@ GeneTonic <- function(dds,
374 385
             column(
375 386
               width = 1,
376 387
               actionButton(
377
-                "tour_ggs", label = "", icon = icon("question-circle"),
388
+                "tour_ggs",
389
+                label = "", icon = icon("question-circle"),
378 390
                 style = .helpbutton_biocstyle
379 391
               )
380 392
             )
... ...
@@ -384,8 +396,9 @@ GeneTonic <- function(dds,
384 396
               width = 8,
385 397
               withSpinner(
386 398
                 visNetworkOutput("ggsnetwork",
387
-                                 height = "700px",
388
-                                 width = "100%")
399
+                  height = "700px",
400
+                  width = "100%"
401
+                )
389 402
               )
390 403
             ),
391 404
             column(
... ...
@@ -406,7 +419,6 @@ GeneTonic <- function(dds,
406 419
               )
407 420
             )
408 421
           ),
409
-
410 422
           fluidRow(
411 423
             bs4Dash::bs4Card(
412 424
               width = 12,
... ...
@@ -421,11 +433,13 @@ GeneTonic <- function(dds,
421 433
                 column(
422 434
                   width = 8,
423 435
                   uiOutput("ui_backbone_launch"),
424
-                  radioButtons(inputId = "backbone_on",
425
-                               label = "Compute the backbone on",
426
-                               choices = c("genesets", "features"),
427
-                               selected = "genesets",
428
-                               inline = TRUE),
436
+                  radioButtons(
437
+                    inputId = "backbone_on",
438
+                    label = "Compute the backbone on",
439
+                    choices = c("genesets", "features"),
440
+                    selected = "genesets",
441
+                    inline = TRUE
442
+                  ),
429 443
                   withSpinner(
430 444
                     visNetworkOutput("backbone_graph")
431 445
                   )
... ...
@@ -437,7 +451,6 @@ GeneTonic <- function(dds,
437 451
               )
438 452
             )
439 453
           )
440
-
441 454
         ),
442 455
 
443 456
         # ui panel enrichment map -------------------------------------------------
... ...
@@ -450,7 +463,8 @@ GeneTonic <- function(dds,
450 463
             column(
451 464
               width = 1,
452 465
               actionButton(
453
-                "tour_emap", label = "", icon = icon("question-circle"),
466
+                "tour_emap",
467
+                label = "", icon = icon("question-circle"),
454 468
                 style = .helpbutton_biocstyle
455 469
               )
456 470
             )
... ...
@@ -464,10 +478,12 @@ GeneTonic <- function(dds,
464 478
                     inputId = "emap_colorby",
465 479
                     label = "Color emap by",
466 480
                     choices = colnames(res_enrich)[unlist(lapply(res_enrich, is.numeric))],
467
-                    selected = "gs_pvalue"),
481
+                    selected = "gs_pvalue"
482
+                  ),
468 483
                   visNetworkOutput("emap_visnet",
469
-                                   height = "700px",
470
-                                   width = "100%")
484
+                    height = "700px",
485
+                    width = "100%"
486
+                  )
471 487
                 )
472 488
               )
473 489
             ),
... ...
@@ -497,7 +513,6 @@ GeneTonic <- function(dds,
497 513
                   withSpinner(
498 514
                     DT::dataTableOutput("dt_distill")
499 515
                   ),
500
-
501 516
                   uiOutput("distill_launch"),
502 517
                   numericInput(
503 518
                     inputId = "n_genesets_distill",
... ...
@@ -529,12 +544,12 @@ GeneTonic <- function(dds,
529 544
             column(
530 545
               width = 1,
531 546
               actionButton(
532
-                "tour_overview", label = "", icon = icon("question-circle"),
547
+                "tour_overview",
548
+                label = "", icon = icon("question-circle"),
533 549
                 style = .helpbutton_biocstyle
534 550
               )
535 551
             )
536 552
           ),
537
-
538 553
           fluidRow(
539 554
             bs4Dash::column(
540 555
               width = 11,
... ...
@@ -555,25 +570,31 @@ GeneTonic <- function(dds,
555 570
                   tabPanel(
556 571
                     title = "Geneset Volcano",
557 572
                     withSpinner(plotOutput("gs_volcano",
558
-                                           height = "650px"))
573
+                      height = "650px"
574
+                    ))
559 575
                   ),
560 576
                   shiny::tabPanel(
561 577
                     title = "Geneset Volcano - simplified",
562
-                    numericInput(inputId = "gs_overlap",
563
-                                 label = "Gene Set overlap",
564
-                                 value = 0.6, min = 0, max = 1, step = 0.05),
578
+                    numericInput(
579
+                      inputId = "gs_overlap",
580
+                      label = "Gene Set overlap",
581
+                      value = 0.6, min = 0, max = 1, step = 0.05
582
+                    ),
565 583
                     withSpinner(plotOutput("gs_volcano_simplified",
566
-                                           height = "650px"))
584
+                      height = "650px"
585
+                    ))
567 586
                   ),
568 587
                   shiny::tabPanel(
569 588
                     title = "Enhanced Table",
570 589
                     withSpinner(plotOutput("enriched_funcres",
571
-                                           height = "650px"))
590
+                      height = "650px"
591
+                    ))
572 592
                   ),
573 593
                   shiny::tabPanel(
574 594
                     title = "Enhanced Table - interactive",
575 595
                     withSpinner(plotlyOutput("enriched_funcres_plotly",
576
-                                             height = "650px"))
596
+                      height = "650px"
597
+                    ))
577 598
                   )
578 599
                 )
579 600
               )
... ...
@@ -591,12 +612,12 @@ GeneTonic <- function(dds,
591 612
             column(
592 613
               width = 1,
593 614
               actionButton(
594
-                "tour_gsviz", label = "", icon = icon("question-circle"),
615
+                "tour_gsviz",
616
+                label = "", icon = icon("question-circle"),
595 617
                 style = .helpbutton_biocstyle
596 618
               )
597 619
             )
598 620
           ),
599
-
600 621
           fluidRow(
601 622
             bs4Dash::column(
602 623
               width = 11,
... ...
@@ -616,38 +637,44 @@ GeneTonic <- function(dds,
616 637
                   shiny::tabPanel(
617 638
                     title = "Scores Heatmap",
618 639
                     withSpinner(plotOutput("gsscores_heatmap",
619
-                                           height = "650px"))
620
-                    
640
+                      height = "650px"
641
+                    ))
621 642
                   ),
622 643
                   shiny::tabPanel(
623 644
                     title = "Alluvial Plot",
624 645
                     withSpinner(plotlyOutput("alluvial_genesets",
625
-                                             height = "650px"))
646
+                      height = "650px"
647
+                    ))
626 648
                   ),
627 649
                   shiny::tabPanel(
628 650
                     title = "Summary Heatmap",
629 651
                     withSpinner(plotOutput("gs_summaryheat",
630
-                                           height = "650px"))
652
+                      height = "650px"
653
+                    ))
631 654
                   ),
632 655
                   shiny::tabPanel(
633 656
                     title = "Geneset MDS",
634 657
                     withSpinner(plotOutput("mds_genesets",
635
-                                           height = "650px"))
658
+                      height = "650px"
659
+                    ))
636 660
                   ),
637 661
                   shiny::tabPanel(
638 662
                     title = "Summary Overview",
639 663
                     withSpinner(plotOutput("gs_summaryoverview",
640
-                                           height = "650px"))
664
+                      height = "650px"
665
+                    ))
641 666
                   ),
642 667
                   shiny::tabPanel(
643 668
                     title = "Geneset Radar",
644 669
                     withSpinner(plotlyOutput("gs_summaryradar",
645
-                                             height = "650px"))
670
+                      height = "650px"
671
+                    ))
646 672
                   ),
647 673
                   shiny::tabPanel(
648 674
                     title = "Geneset Dendrogram",
649 675
                     withSpinner(plotOutput("gs_dendro",
650
-                                           height = "650px"))
676
+                      height = "650px"
677
+                    ))
651 678
                   )
652 679
                 )
653 680
               )
... ...
@@ -665,7 +692,8 @@ GeneTonic <- function(dds,
665 692
             column(
666 693
               width = 1,
667 694
               actionButton(
668
-                "tour_bookmarks", label = "", icon = icon("question-circle"),
695
+                "tour_bookmarks",
696
+                label = "", icon = icon("question-circle"),
669 697
                 style = .helpbutton_biocstyle
670 698
               )
671 699
             )
... ...
@@ -685,7 +713,8 @@ GeneTonic <- function(dds,
685 713
                 "start_happyhour",
686 714
                 "Start the happy hour!",
687 715
                 class = "biocdlbutton",
688
-                icon = "cocktail") # magic?
716
+                icon = "cocktail"
717
+              ) # magic?
689 718
             )
690 719
           ),
691 720
           hr(),
... ...
@@ -694,7 +723,8 @@ GeneTonic <- function(dds,
694 723
             column(
695 724
               width = 4,
696 725
               textInput(
697
-                "se_export_name",label = "Choose a filename for the serialized .rds object",
726
+                "se_export_name",
727
+                label = "Choose a filename for the serialized .rds object",
698 728
                 value = "se_GeneTonic_toiSEE.rds"
699 729
               )
700 730
             ),
... ...
@@ -714,17 +744,24 @@ GeneTonic <- function(dds,
714 744
     # controlbar definition ---------------------------------------------------
715 745
     controlbar = bs4Dash::bs4DashControlbar(
716 746
       collapsed = TRUE,
717
-      numericInput(inputId = "de_fdr",
718
-                   label = "False Discovery Rate (FDR) for DE",
719
-                   value = 0.05, min = 0.0001, max = 1, step = 0.01),
720
-      numericInput(inputId = "n_genesets",
721
-                   label = "Number of genesets",
722
-                   value = 15, min = 1, max = nrow(res_enrich)),
723
-      selectInput("exp_condition", label = "Group/color by: ",
724
-                  choices = c(NULL, names(colData(dds))), selected = NULL, multiple = TRUE),
747
+      numericInput(
748
+        inputId = "de_fdr",
749
+        label = "False Discovery Rate (FDR) for DE",
750
+        value = 0.05, min = 0.0001, max = 1, step = 0.01
751
+      ),
752
+      numericInput(
753
+        inputId = "n_genesets",
754
+        label = "Number of genesets",
755
+        value = 15, min = 1, max = nrow(res_enrich)
756
+      ),
757
+      selectInput("exp_condition",
758
+        label = "Group/color by: ",
759
+        choices = c(NULL, names(colData(dds))), selected = NULL, multiple = TRUE
760
+      ),
725 761
       colourInput("col", "Select colour for volcano plot", "#1a81c2",
726
-                  returnName = TRUE,
727
-                  allowTransparent = TRUE),
762
+        returnName = TRUE,
763
+        allowTransparent = TRUE
764
+      ),
728 765
       checkboxInput("labels", label = "Display all labels", value = FALSE)
729 766
     ),
730 767
 
... ...
@@ -733,12 +770,11 @@ GeneTonic <- function(dds,
733 770
       left = GeneTonic_footer,
734 771
       right = NULL
735 772
     )
736
-
737 773
   )
738 774
 
739 775
   options(shiny.maxRequestSize = 15 * 1024^2)
740 776
 
741
-  #nocov start
777
+  # nocov start
742 778
   genetonic_server <- function(input, output, session) {
743 779
 
744 780
     # reactive objects and setup commands -------------------------------------
... ...
@@ -749,9 +785,11 @@ GeneTonic <- function(dds,
749 785
 
750 786
     myvst <- vst(dds)
751 787
 
752
-    res_enhanced <- get_aggrscores(res_enrich = res_enrich,
753
-                                   res_de = res_de,
754
-                                   annotation_obj = annotation_obj)
788
+    res_enhanced <- get_aggrscores(
789
+      res_enrich = res_enrich,
790
+      res_de = res_de,
791
+      annotation_obj = annotation_obj
792
+    )
755 793
 
756 794
     # output$ui_exp_condition <- renderUI({
757 795
     # selectInput("exp_condition", label = "Group/color by: ",
... ...
@@ -783,9 +821,11 @@ GeneTonic <- function(dds,
783 821
         formatRound(columns = c("log2FoldChange"), digits = 3) %>%
784 822
         formatStyle(
785 823
           "log2FoldChange",
786
-          background = styleColorBar_divergent(as.data.frame(res_de)$log2FoldChange,
787
-                                               scales::alpha("navyblue", 0.4),
788
-                                               scales::alpha("darkred", 0.4)),
824
+          background = styleColorBar_divergent(
825
+            as.data.frame(res_de)$log2FoldChange,
826
+            scales::alpha("navyblue", 0.4),
827
+            scales::alpha("darkred", 0.4)
828
+          ),
789 829
           backgroundSize = "100% 90%",
790 830
           backgroundRepeat = "no-repeat",
791 831
           backgroundPosition = "center"
... ...
@@ -891,14 +931,19 @@ GeneTonic <- function(dds,
891 931
       # minimal example
892 932
 
893 933
       visNetwork::visIgraph(reactive_values$ggs_graph()) %>%
894
-        visOptions(highlightNearest = list(enabled = TRUE,
895
-                                           degree = 1,
896
-                                           hover = TRUE),
897
-                   nodesIdSelection = TRUE) %>%
898
-        visExport(name = "ggs_network",
899
-                  type = "png",
900
-                  label = "Save ggs graph")
901
-
934
+        visOptions(
935
+          highlightNearest = list(
936
+            enabled = TRUE,
937
+            degree = 1,
938
+            hover = TRUE
939
+          ),
940
+          nodesIdSelection = TRUE
941
+        ) %>%
942
+        visExport(
943
+          name = "ggs_network",
944
+          type = "png",
945
+          label = "Save ggs graph"
946
+        )
902 947
     })
903 948
 
904 949
     output$netnode <- renderPrint({
... ...
@@ -918,7 +963,6 @@ GeneTonic <- function(dds,
918 963
         h4("Highly connected genes"),
919 964
         DT::dataTableOutput("table_graph_summary")
920 965
       )
921
-
922 966
     })
923 967
 
924 968
     output$table_graph_summary <- DT::renderDataTable({
... ...
@@ -926,7 +970,6 @@ GeneTonic <- function(dds,
926 970
 
927 971
       node_degrees <- summarize_ggs_hubgenes(g)
928 972
       DT::datatable(node_degrees, escape = FALSE)
929
-
930 973
     })
931 974
 
932 975
     output$ui_ggs_genesetbox <- renderUI({
... ...
@@ -944,7 +987,7 @@ GeneTonic <- function(dds,
944 987
       cur_node <- match(cur_sel, V(g)$name)
945 988
       cur_nodetype <- V(g)$nodetype[cur_node]
946 989
       validate(need(cur_nodetype == "GeneSet",
947
-                    message = "Please select a gene set from the Gene-Geneset Graph."
990
+        message = "Please select a gene set from the Gene-Geneset Graph."
948 991
       ))
949 992
       cur_gsid <- res_enrich$gs_id[match(input$ggsnetwork_selected, res_enrich$gs_description)]
950 993
 
... ...
@@ -986,7 +1029,7 @@ GeneTonic <- function(dds,
986 1029
       cur_node <- match(cur_sel, V(g)$name)
987 1030
       cur_nodetype <- V(g)$nodetype[cur_node]
988 1031
       validate(need(cur_nodetype == "GeneSet",
989
-                    message = ""
1032
+        message = ""
990 1033
       ))
991 1034
       cur_gsid <- res_enrich$gs_id[match(input$ggsnetwork_selected, res_enrich$gs_description)]
992 1035
 
... ...
@@ -1008,7 +1051,7 @@ GeneTonic <- function(dds,
1008 1051
           geneset_id = cur_gsid,
1009 1052
           FDR = input$de_fdr,
1010 1053
           color = input$col
1011
-       )
1054
+        )
1012 1055
       }
1013 1056
     })
1014 1057
 
... ...
@@ -1018,7 +1061,7 @@ GeneTonic <- function(dds,
1018 1061
       cur_node <- match(cur_sel, V(g)$name)
1019 1062
       cur_nodetype <- V(g)$nodetype[cur_node]
1020 1063
       validate(need(cur_nodetype == "GeneSet",
1021
-                    message = "" # "Please select a gene set."
1064
+        message = "" # "Please select a gene set."
1022 1065
       ))
1023 1066
       cur_gsid <- res_enrich$gs_id[match(input$ggsnetwork_selected, res_enrich$gs_description)]
1024 1067
 
... ...
@@ -1038,7 +1081,7 @@ GeneTonic <- function(dds,
1038 1081
       cur_node <- match(cur_sel, V(g)$name)
1039 1082
       cur_nodetype <- V(g)$nodetype[cur_node]
1040 1083
       validate(need(cur_nodetype == "Feature",
1041
-                    message = "Please select a gene/feature."
1084
+        message = "Please select a gene/feature."
1042 1085
       ))
1043 1086
 
1044 1087
       cur_geneid <- annotation_obj$gene_id[match(cur_sel, annotation_obj$gene_name)]
... ...
@@ -1056,22 +1099,21 @@ GeneTonic <- function(dds,
1056 1099
       cur_node <- match(cur_sel, V(g)$name)
1057 1100
       cur_nodetype <- V(g)$nodetype[cur_node]
1058 1101
       validate(need(cur_nodetype == "Feature",
1059
-                    message = "" # "Please select a gene/feature."
1102
+        message = "" # "Please select a gene/feature."
1060 1103
       ))
1061 1104
       validate(need(input$exp_condition != "",
1062
-                    message = "Please select a group for the experimental condition."
1105
+        message = "Please select a group for the experimental condition."
1063 1106
       ))
1064 1107
 
1065 1108
       cur_geneid <- annotation_obj$gene_id[match(cur_sel, annotation_obj$gene_name)]
1066 1109
       gene_plot(dds,
1067
-                gene = cur_geneid,
1068
-                intgroup = input$exp_condition,
1069
-                annotation_obj = annotation_obj
1110
+        gene = cur_geneid,
1111
+        intgroup = input$exp_condition,
1112
+        annotation_obj = annotation_obj
1070 1113
       )
1071 1114
     })
1072 1115
 
1073 1116
     reactive_values$backbone_graph <- reactive({
1074
-
1075 1117
       not_msg <- sprintf("Computing backbone on %s of the current gene-geneset graph, please hold on...", input$backbone_on)
1076 1118
       showNotification(not_msg)
1077 1119
 
... ...
@@ -1091,18 +1133,28 @@ GeneTonic <- function(dds,
1091 1133
       # minimal example
1092 1134
       bbg <- reactive_values$backbone_graph()
1093 1135
       validate(
1094
-        need({igraph::vcount(bbg) > 0}, message = "Graph has no nodes, try increasing the number of sets to include...")
1136
+        need(
1137
+          {
1138
+            igraph::vcount(bbg) > 0
1139
+          },
1140
+          message = "Graph has no nodes, try increasing the number of sets to include..."
1141
+        )
1095 1142
       )
1096 1143
 
1097 1144
       visNetwork::visIgraph(bbg) %>%
1098
-        visOptions(highlightNearest = list(enabled = TRUE,
1099
-                                           degree = 1,
1100
-                                           hover = TRUE),
1101
-                   nodesIdSelection = TRUE) %>%
1102
-        visExport(name = "backbone_network",
1103
-                  type = "png",
1104
-                  label = "Save backbone graph")
1105
-
1145
+        visOptions(
1146
+          highlightNearest = list(
1147
+            enabled = TRUE,
1148
+            degree = 1,
1149
+            hover = TRUE
1150
+          ),
1151
+          nodesIdSelection = TRUE
1152
+        ) %>%
1153
+        visExport(
1154
+          name = "backbone_network",
1155
+          type = "png",
1156
+          label = "Save backbone graph"
1157
+        )
1106 1158
     })
1107 1159
 
1108 1160
 
... ...
@@ -1123,16 +1175,20 @@ GeneTonic <- function(dds,
1123 1175
     })
1124 1176
 
1125 1177
     output$emap_visnet <- renderVisNetwork({
1126
-
1127 1178
       visNetwork::visIgraph(emap_graph()) %>%
1128
-        visOptions(highlightNearest = list(enabled = TRUE,
1129
-                                           degree = 1,
1130
-                                           hover = TRUE),
1131
-                   nodesIdSelection = TRUE) %>%
1132
-        visExport(name = "emap_network",
1133
-                  type = "png",
1134
-                  label = "Save enrichment map")
1135
-
1179
+        visOptions(
1180
+          highlightNearest = list(
1181
+            enabled = TRUE,
1182
+            degree = 1,
1183
+            hover = TRUE
1184
+          ),
1185
+          nodesIdSelection = TRUE
1186
+        ) %>%
1187
+        visExport(
1188
+          name = "emap_network",
1189
+          type = "png",
1190
+          label = "Save enrichment map"
1191
+        )
1136 1192
     })
1137 1193
 
1138 1194
     output$ui_emap_sidecontent <- renderUI({
... ...
@@ -1145,7 +1201,8 @@ GeneTonic <- function(dds,
1145 1201
     output$emap_geneset_info <- renderUI({
1146 1202
       cur_gsid <- res_enrich$gs_id[match(input$emap_visnet_selected, res_enrich$gs_description)]
1147 1203
       validate(need(!is.na(cur_gsid),
1148
-                    message = ""))
1204
+        message = ""
1205
+      ))
1149 1206
 
1150 1207
       # message(cur_gsid)
1151 1208
       # GOTERM[[cur_gsid]]
... ...
@@ -1162,7 +1219,7 @@ GeneTonic <- function(dds,
1162 1219
       # ))
1163 1220
       cur_gsid <- res_enrich$gs_id[match(input$emap_visnet_selected, res_enrich$gs_description)]
1164 1221
       validate(need(!is.na(cur_gsid),
1165
-                    message = "Please select a gene set from the Enrichment Map."
1222
+        message = "Please select a gene set from the Enrichment Map."
1166 1223
       ))
1167 1224
 
1168 1225
 
... ...
@@ -1206,7 +1263,8 @@ GeneTonic <- function(dds,
1206 1263
         res_enrich = res_enrich,
1207 1264
         res_de = res_de,
1208 1265
         annotation_obj = annotation_obj,
1209
-        n_gs = input$n_genesets_distill)
1266
+        n_gs = input$n_genesets_distill
1267
+      )
1210 1268
       return(distillat)
1211 1269
     })
1212 1270
 
... ...
@@ -1216,13 +1274,14 @@ GeneTonic <- function(dds,
1216 1274
       # TODO: reorder the columns from the distilled table
1217 1275
 
1218 1276
       DT::datatable(
1219
-        dist_table[,1:4],
1277
+        dist_table[, 1:4],
1220 1278
         selection = "single",
1221 1279
         rownames = FALSE,
1222 1280
         options = list(
1223 1281
           pageLength = 50,
1224 1282
           scrollX = TRUE,
1225
-          scrollY = "400px")
1283
+          scrollY = "400px"
1284
+        )
1226 1285
       )
1227 1286
     })
1228 1287
 
... ...
@@ -1253,18 +1312,17 @@ GeneTonic <- function(dds,
1253 1312
       s <- input$dt_distill_rows_selected
1254 1313
 
1255 1314
       validate(need(length(s) > 0,
1256
-                    message = "Please select a meta-geneset from the table"
1315
+        message = "Please select a meta-geneset from the table"
1257 1316
       ))
1258 1317
 
1259
-      selrow <- dist_table[s,]$metags_msgs
1318
+      selrow <- dist_table[s, ]$metags_msgs
1260 1319
 
1261
-      sel_genes <- strsplit(dist_table[s,]$metags_genes, ",")[[1]]
1320
+      sel_genes <- strsplit(dist_table[s, ]$metags_genes, ",")[[1]]
1262 1321
       # message(length(sel_genes))
1263 1322
       sel_genes_id <- annotation_obj$gene_id[match(sel_genes, annotation_obj$gene_name)]
1264 1323
       # message(length(sel_genes_id))
1265 1324
 
1266 1325
       if (!is.null(input$exp_condition)) {
1267
-
1268 1326
         gs_heatmap(
1269 1327
           myvst,
1270 1328
           res_de,
... ...
@@ -1279,7 +1337,6 @@ GeneTonic <- function(dds,
1279 1337
           scale_row = TRUE,
1280 1338
           anno_col_info = input$exp_condition,
1281 1339
           plot_title = selrow
1282
-
1283 1340
         )
1284 1341
       } else {
1285 1342
         gs_heatmap(
... ...
@@ -1314,12 +1371,15 @@ GeneTonic <- function(dds,
1314 1371
       V(ig)$color.border <- "black"
1315 1372
 
1316 1373
       visNetwork::visIgraph(ig) %>%
1317
-        visOptions(highlightNearest = list(enabled = TRUE,
1318
-                                           degree = 1,
1319
-                                           hover = TRUE),
1320
-                   nodesIdSelection = TRUE,
1321
-                   selectedBy = "membership")
1322
-
1374
+        visOptions(
1375
+          highlightNearest = list(
1376
+            enabled = TRUE,
1377
+            degree = 1,
1378
+            hover = TRUE
1379
+          ),
1380
+          nodesIdSelection = TRUE,
1381
+          selectedBy = "membership"
1382
+        )
1323 1383
     })
1324 1384
 
1325 1385
 
... ...
@@ -1328,15 +1388,17 @@ GeneTonic <- function(dds,
1328 1388
 
1329 1389
     output$enriched_funcres <- renderPlot({
1330 1390
       enhance_table(res_enrich, res_de,
1331
-                    annotation_obj = annotation_obj,
1332
-                    n_gs = input$n_genesets)
1391
+        annotation_obj = annotation_obj,
1392
+        n_gs = input$n_genesets
1393
+      )
1333 1394
     })
1334 1395
 
1335 1396
     output$gs_volcano <- renderPlot({
1336 1397
       gs_volcano(
1337 1398
         get_aggrscores(res_enrich,
1338
-                       res_de,
1339
-                       annotation_obj = annotation_obj),
1399
+          res_de,
1400
+          annotation_obj = annotation_obj
1401
+        ),
1340 1402
         volcano_labels = input$n_genesets
1341 1403
       )
1342 1404
     })
... ...
@@ -1344,32 +1406,37 @@ GeneTonic <- function(dds,
1344 1406
     output$gs_volcano_simplified <- renderPlot({
1345 1407
       gs_volcano(
1346 1408
         get_aggrscores(gs_simplify(res_enrich, gs_overlap = input$gs_overlap),
1347
-                       res_de,
1348
-                       annotation_obj = annotation_obj),
1409
+          res_de,
1410
+          annotation_obj = annotation_obj
1411
+        ),
1349 1412
         volcano_labels = input$n_genesets
1350 1413
       )
1351 1414
     })
1352 1415
 
1353 1416
     output$enriched_funcres_plotly <- renderPlotly({
1354 1417
       ggplotly(enhance_table(res_enrich,
1355
-                             res_de,
1356
-                             annotation_obj = annotation_obj,
1357
-                             n_gs = input$n_genesets))
1418
+        res_de,
1419
+        annotation_obj = annotation_obj,
1420
+        n_gs = input$n_genesets
1421
+      ))
1358 1422
     })
1359 1423
 
1360 1424
 
1361 1425
     # panel GSViz -----------------------------------------------------
1362 1426
 
1363 1427
     gss_mat <- reactive({
1364
-      gs_scores(se = myvst,
1365
-                res_de = res_de,
1366
-                res_enrich = res_enrich,
1367
-                annotation_obj = annotation_obj)
1428
+      gs_scores(
1429
+        se = myvst,
1430
+        res_de = res_de,
1431
+        res_enrich = res_enrich,
1432
+        annotation_obj = annotation_obj
1433
+      )
1368 1434
     })
1369 1435
     output$gsscores_heatmap <- renderPlot({
1370 1436
       gs_scoresheat(
1371 1437
         gss_mat(),
1372
-        n_gs = input$n_genesets)
1438
+        n_gs = input$n_genesets
1439
+      )
1373 1440
     })
1374 1441
 
1375 1442
     output$alluvial_genesets <- renderPlotly({
... ...
@@ -1377,38 +1444,51 @@ GeneTonic <- function(dds,
1377 1444
     })
1378 1445
 
1379 1446
     output$mds_genesets <- renderPlot({
1380
-      gs_mds(res_enrich, res_de, annotation_obj, mds_colorby = "z_score",
1381
-             mds_labels = input$n_genesets)
1447
+      gs_mds(res_enrich, res_de, annotation_obj,
1448
+        mds_colorby = "z_score",
1449
+        mds_labels = input$n_genesets
1450
+      )
1382 1451
     })
1383 1452
 
1384 1453
     output$gs_summaryheat <- renderPlot({
1385 1454
       gs_summary_heat(res_enrich, res_de, annotation_obj,
1386
-                      n_gs = input$n_genesets)
1455
+        n_gs = input$n_genesets
1456
+      )
1387 1457
     })
1388 1458
 
1389 1459
     output$gs_summaryoverview <- renderPlot({
1390
-