Clarion object

.Rbuildignore

@@ -1,3 +1,4 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.buildkite.*
+^revdep$

.buildkite/wilson-env.yml

@@ -43,4 +43,3 @@ dependencies:
   - r-devtools
   - "readline==6.3"
   - r-roxygen2
-  - r-shinybs

DESCRIPTION

@@ -1,13 +1,13 @@
 Package: wilson
 Type: Package
-Title: WIlsON Webbased Interactive Omics visualizatioN
-Version: 1.0.0
+Title: Web-Based Interactive Omics Visualization
+Version: 2.0.0
 Authors@R: c(
     person("Hendrik", "Schultheis", email = "hendrik.schultheis@mpi-bn.mpg.de", role = c("aut", "cre")),
     person("Jens", "Preussner", email = "jens.preussner@mpi-bn.mpg.de", role = "aut"),
     person("Looso", "Mario", email = "mario.looso@mpi-bn.mpg.de", role = "aut"))
-Description: This package provides modules for webbased tools that use plot based strategies to visualize and analyze multi-omics data.
-    WIlsON utilizes the Rshiny and Plotly frameworks to provide a user friendly dashboard for interactive plotting.
+Description: This package provides modules for web-based tools that use plot based strategies to visualize and analyze multi-omics data.
+    'wilson' utilizes the 'shiny' and 'plotly' frameworks to provide a user friendly dashboard for interactive plotting.
 URL: https://github.molgen.mpg.de/loosolab/wilson
 BugReports: https://github.molgen.mpg.de/loosolab/wilson/issues
 License: MIT + file LICENSE
@@ -34,19 +34,17 @@ Imports: shiny,
     gplots,
     reshape,
     rintrojs,
-    webshot,
     RJSONIO,
     ggrepel (>= 0.6.12),
     DESeq2,
     rjson,
     FactoMineR,
     factoextra,
     heatmaply (>= 0.14.1),
-    shinyBS,
-    shinythemes,
     shinycssloaders,
     log4r,
     openssl,
-    methods
+    methods,
+    R6
 RoxygenNote: 6.0.1
 biocViews:

NAMESPACE

@@ -1,10 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(Clarion)
 export(and)
 export(andUI)
 export(colorPicker)
-export(colorPicker2)
-export(colorPicker2UI)
 export(colorPickerUI)
 export(columnSelector)
 export(columnSelectorUI)

R/and.R

@@ -38,78 +38,78 @@ andUI <- function(id) {
 #' @export
 and <- function(input, output, session, data, show.elements = NULL, element.grouping = NULL, column.labels = NULL, delimiter = NULL, multiple = TRUE, contains = FALSE, ranged = FALSE, step = 100, reset = NULL) {
   # handle reactive data
-  data.r <- shiny::reactive({
-    if(shiny::is.reactive(data)){
+  data_r <- shiny::reactive({
+    if (shiny::is.reactive(data)) {
       data()
     }else{
       data
     }
   })
 
   # handle reactive show.elements
-  show.elements.r <- shiny::reactive({
-    if(shiny::is.reactive(show.elements)) {
+  show_elements_r <- shiny::reactive({
+    if (shiny::is.reactive(show.elements)) {
       show.elements <- show.elements()
     } else {
       show.elements <- show.elements
     }
-    if(is.null(show.elements)) {
-      show.elements <- names(data.r())
+    if (is.null(show.elements)) {
+      show.elements <- names(data_r())
     }
 
     return(show.elements)
   })
 
   # handle reactive grouping
-  element.grouping.r <- shiny::reactive({
-    if(shiny::is.reactive(element.grouping)){
+  element_grouping_r <- shiny::reactive({
+    if (shiny::is.reactive(element.grouping)) {
       element.grouping()
-    }else{
+    } else {
       element.grouping
     }
   })
 
   parameter <- shiny::reactive({
     # get column labels
-    if(is.null(column.labels)){
-      column.labels <- names(data.r())
-    }else{
+    if (is.null(column.labels)) {
+      column.labels <- names(data_r())
+    } else {
       column.labels <- column.labels
     }
     # fill multiple if vector is too small
-    if(shiny::is.reactive(multiple)) {
+    if (shiny::is.reactive(multiple)) {
       multiple <- multiple()
     }
-    if (length(multiple) < ncol(data.r())) {
-      multiple <- rep(multiple, length.out = ncol(data.r()))
+    if (length(multiple) < ncol(data_r())) {
+      multiple <- rep(multiple, length.out = ncol(data_r()))
     }
     # fill contains if vector is too small
-    if(shiny::is.reactive(contains)) {
+    if (shiny::is.reactive(contains)) {
       contains <- contains()
     }
-    if (length(contains) < ncol(data.r())) {
-      contains <- rep(contains, length.out = ncol(data.r()))
+    if (length(contains) < ncol(data_r())) {
+      contains <- rep(contains, length.out = ncol(data_r()))
     }
     # fill ranged if vector is too small
-    if(shiny::is.reactive(ranged)) {
+    if (shiny::is.reactive(ranged)) {
       ranged <- ranged()
     }
-    if (length(ranged) < ncol(data.r())) {
-      ranged <- rep(ranged, length.out = ncol(data.r()))
+    if (length(ranged) < ncol(data_r())) {
+      ranged <- rep(ranged, length.out = ncol(data_r()))
     }
     # fill delimiter if vector is too small
-    if(shiny::is.reactive(delimiter)) {
+    if (shiny::is.reactive(delimiter)) {
       delimiter <- delimiter()
     }
-    if (length(delimiter) < ncol(data.r()) & !is.null(delimiter)) {
-      delimiter <- rep(delimiter, length.out = ncol(data.r()))
+    if (length(delimiter) < ncol(data_r()) & !is.null(delimiter)) {
+      delimiter <- rep(delimiter, length.out = ncol(data_r()))
     }
     # fill step if vector is too small
-    if(shiny::is.reactive(step)) {
+    if (shiny::is.reactive(step)) {
       step <- step()
     }
-    if (length(step) < ncol(data.r()) & !is.null(step)) {
-      step <- rep(step, length.out = ncol(data.r()))
+    if (length(step) < ncol(data_r()) & !is.null(step)) {
+      step <- rep(step, length.out = ncol(data_r()))
     }
 
     return(list(column.labels = column.labels, multiple = multiple, contains = contains, ranged = ranged, delimiter = delimiter, step = step))
@@ -122,35 +122,35 @@ and <- function(input, output, session, data, show.elements = NULL, element.grou
     progress$set(0, message = "Render orModules:")
 
     # select data based on show.elements
-    data <- data.r()[, show.elements.r(), with = FALSE]
+    data <- data_r()[, show_elements_r(), with = FALSE]
 
     step <- ncol(data)
 
-    if(!is.null(element.grouping.r())){
+    if (!is.null(element_grouping_r())) {
       # only group shown data
-      element.grouping <- element.grouping.r()[element.grouping.r()[[1]] %in% show.elements.r()]
+      element.grouping <- element_grouping_r()[element_grouping_r()[[1]] %in% show_elements_r()]
 
-      grouping <- tapply(element.grouping[[1]], element.grouping[[2]], function(x){x})
+      grouping <- tapply(element.grouping[[1]], element.grouping[[2]], function(x) {x})
       # keep grouping order
       grouping <- grouping[unique(element.grouping[[2]])]
 
-      return <- lapply(1:length(grouping), function(i){
+      return <- lapply(seq_len(length(grouping)), function(i){
         group <- lapply(unlist(grouping[i]), function(x){
           progress$inc(step, detail = x)
 
-          if(is.numeric(data[[x]])){
+          if (is.numeric(data[[x]])) {
             ui <- orNumericUI(id = session$ns(openssl::sha1(x)))
-          }else{
+          } else {
             ui <- orTextualUI(id = session$ns(openssl::sha1(x)))
           }
 
-          if(length(ui) < 4){ # orTextual
+          if (length(ui) < 4) { # orTextual
             shiny::tagList(shiny::fluidRow(
               shiny::column(width = 4, ui[1]),
               shiny::column(width = 3, ui[2]),
               shiny::column(width = 1, offset = 4, ui[3])
             ))
-          }else{ # orNumeric
+          } else { # orNumeric
             shiny::tagList(shiny::fluidRow(
               shiny::column(width = 4, ui[1]),
               shiny::column(width = 1, ui[2]),
@@ -163,23 +163,23 @@ and <- function(input, output, session, data, show.elements = NULL, element.grou
 
         shiny::tagList(shinydashboard::box(width = 12, collapsible = TRUE, collapsed = TRUE, title = names(grouping[i]), shiny::tagList(group)))
       })
-    }else{
-      return <- lapply(1:ncol(data), function(x) {
+    } else {
+      return <- lapply(seq_len(ncol(data)), function(x) {
         progress$inc(step, detail = names(data)[x])
         if (is.numeric(data[[x]])) {
           ui <- orNumericUI(id = session$ns(openssl::sha1(names(data)[x])))
 
-        } else{
+        } else {
           ui <- orTextualUI(id = session$ns(openssl::sha1(names(data)[x])))
         }
 
-        if(length(ui) < 4){ # orTextual
+        if (length(ui) < 4) { # orTextual
           shiny::tagList(shiny::fluidRow(
             shiny::column(width = 4, ui[1]),
             shiny::column(width = 3, ui[2]),
             shiny::column(width = 1, offset = 4, ui[3])
           ))
-        }else{ # orNumeric
+        } else { # orNumeric
           shiny::tagList(shiny::fluidRow(
             shiny::column(width = 4, ui[1]),
             shiny::column(width = 1, ui[2]),
@@ -203,41 +203,41 @@ and <- function(input, output, session, data, show.elements = NULL, element.grou
     progress <- shiny::Progress$new()
     on.exit(progress$close())
     progress$set(0, message = "Filtering Module:")
-    step <- ncol(data.r())
+    step <- ncol(data_r())
 
-    lapply(1:ncol(data.r()), function(x) {
-      progress$inc(step, detail = names(data.r())[x])
-      if (is.numeric(data.r()[[x]])) {
+    lapply(seq_len(ncol(data_r())), function(x) {
+      progress$inc(step, detail = names(data_r())[x])
+      if (is.numeric(data_r()[[x]])) {
         if (parameter()$ranged[x]) {
           shiny::callModule(
             module = orNumeric,
-            id = openssl::sha1(names(data.r())[x]),
-            choices = data.r()[[x]],
-            value = c(floor(min(data.r()[[x]], na.rm = TRUE)), ceiling(max(data.r()[[x]], na.rm = TRUE))),
+            id = openssl::sha1(names(data_r())[x]),
+            choices = data_r()[[x]],
+            value = c(floor(min(data_r()[[x]], na.rm = TRUE)), ceiling(max(data_r()[[x]], na.rm = TRUE))),
             label = parameter()$column.labels[x],
             step = parameter()$step[x],
-            min. = floor(min(data.r()[[x]], na.rm = TRUE)),
-            max. = ceiling(max(data.r()[[x]], na.rm = TRUE)),
+            min. = floor(min(data_r()[[x]], na.rm = TRUE)),
+            max. = ceiling(max(data_r()[[x]], na.rm = TRUE)),
             reset = reset
           )
         } else{
           shiny::callModule(
             module = orNumeric,
-            id = openssl::sha1(names(data.r())[x]),
-            choices = data.r()[[x]],
-            value = mean(data.r()[[x]], na.rm = TRUE),
+            id = openssl::sha1(names(data_r())[x]),
+            choices = data_r()[[x]],
+            value = mean(data_r()[[x]], na.rm = TRUE),
             label = parameter()$column.labels[x],
             step = parameter()$step[x],
-            min. = floor(min(data.r()[[x]], na.rm = TRUE)),
-            max. = ceiling(max(data.r()[[x]], na.rm = TRUE)),
+            min. = floor(min(data_r()[[x]], na.rm = TRUE)),
+            max. = ceiling(max(data_r()[[x]], na.rm = TRUE)),
             reset = reset
           )
         }
       } else{
         shiny::callModule(
           module = orTextual,
-          id = openssl::sha1(names(data.r())[x]),
-          choices = as.character(data.r()[[x]]),
+          id = openssl::sha1(names(data_r())[x]),
+          choices = as.character(data_r()[[x]]),
           label = parameter()$column.labels[x],
           delimiter = parameter()$delimiter[x],
           multiple = parameter()$multiple[x],
@@ -256,35 +256,31 @@ and <- function(input, output, session, data, show.elements = NULL, element.grou
 
     log_message(message = "Applying filter...", level = "INFO", token = session$token)
 
-    or.modules <- modules()
+    or_modules <- modules()
 
-    step <- 0.9 / length(or.modules)
+    step <- 0.9 / length(or_modules)
     # OR modules selection
-    or.selection.bool <- sapply(or.modules, function(x) {
+    or_selection_bool <- vapply(or_modules, FUN.VALUE = logical(nrow(data_r())), FUN = function(x) {
       progress$inc(step, detail = x()$label)
       x()$bool
     })
-    or.selection.text <- sapply(or.modules, function(x) {
-      if(shiny::isTruthy(x()$text)){
+
+    or_selection_text <- lapply(or_modules, function(x) {
+      if (shiny::isTruthy(x()$text)) {
         return(paste0(x()$label, ": ", paste(x()$text, collapse = ","), collapse = ""))
       }
     })
 
-    # cast to matrix if sapply returns vector
-    if(is.vector(or.selection.bool)){
-      or.selection.bool <- t(as.matrix(or.selection.bool))
-    }
-
     # selected rows (and selection)
-    and.selection.bool <- apply(or.selection.bool, 1, all)
+    and_selection_bool <- apply(or_selection_bool, 1, all)
 
-    or.selection.text <- unlist(or.selection.text)
+    or_selection_text <- unlist(or_selection_text)
 
     progress$set(1)
 
     log_message(message = "Done.", level = "INFO", token = session$token)
 
-    return(list(bool = and.selection.bool, text = unlist(or.selection.text)))
+    return(list(bool = and_selection_bool, text = unlist(or_selection_text)))
   })
 
   return(selection)