replaced sapply with type safe v- /lapply

R/and.R

@@ -260,21 +260,17 @@ and <- function(input, output, session, data, show.elements = NULL, element.grou
 
     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) {
+
+    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)
 

R/clarion.R

@@ -245,7 +245,7 @@ Clarion <- R6::R6Class("Clarion",
                            } else {
                              expected_numeric_cols <- self$metadata[level %in% c("sample", "condition", "contrast")][["key"]]
                            }
-                           not_numeric <- names(self$data[, expected_numeric_cols, with = FALSE][, which(!sapply(self$data[, expected_numeric_cols, with = FALSE], is.numeric))])
+                           not_numeric <- names(self$data[, expected_numeric_cols, with = FALSE][, which(!vapply(self$data[, expected_numeric_cols, with = FALSE], is.numeric, FUN.VALUE = logical(1)))])
                            if (length(not_numeric) > 0) {
                              stop("Data: Column(s): ", paste0(not_numeric, collapse = ", "), " not numeric! Probably wrong decimal separator.")
                            }

R/featureSelector.R

@@ -83,7 +83,7 @@ featureSelector <- function(input, output, session, clarion, multiple = TRUE, co
   # delimiter vector
   # only delimit type = array
   delimiter <- shiny::reactive({
-    sapply(object()$metadata[["key"]], function(x) {
+    lapply(object()$metadata[["key"]], function(x) {
       if (object()$is_delimited(x)) {
         return(object()$get_delimiter())
       } else {

R/function.R

@@ -690,10 +690,10 @@ create_heatmap <- function(data, unitlabel = "auto", row.label = TRUE, row.custo
     ))
 
     # width/ height calculation
-    col_names_maxlength_label_width <- max(sapply(colnames(prep_data), graphics::strwidth, units = "in", font = 12))	# longest column label when plotted in inches
-    col_names_maxlength_label_height <- max(sapply(colnames(prep_data), graphics::strheight, units = "in", font = 12))	# highest column label when plotted in inches
-    row_names_maxlength_label_width <- max(sapply(rownames(prep_data), graphics::strwidth, units = "in", font = 12))	# longest row label when plotted in inches
-    row_names_maxlength_label_height <- max(sapply(rownames(prep_data), graphics::strheight, units = "in", font = 12))	# highest row label when plotted in inches
+    col_names_maxlength_label_width <- max(vapply(colnames(prep_data), FUN.VALUE = numeric(1), graphics::strwidth, units = "in", font = 12))	# longest column label when plotted in inches
+    col_names_maxlength_label_height <- max(vapply(colnames(prep_data), FUN.VALUE = numeric(1), graphics::strheight, units = "in", font = 12))	# highest column label when plotted in inches
+    row_names_maxlength_label_width <- max(vapply(rownames(prep_data), FUN.VALUE = numeric(1), graphics::strwidth, units = "in", font = 12))	# longest row label when plotted in inches
+    row_names_maxlength_label_height <- max(vapply(rownames(prep_data), FUN.VALUE = numeric(1), graphics::strheight, units = "in", font = 12))	# highest row label when plotted in inches
 
     # width
     if (row.label) {
@@ -791,7 +791,7 @@ create_geneview <- function(data, grouping, plot.type = "line", facet.target = "
   } else {
     data_id <- gene.label
   }
-  data <- data[, sapply(data, is.numeric), with = FALSE]
+  data <- data[, vapply(data, is.numeric, FUN.VALUE = logical(1)), with = FALSE]
 
   data_cols <- names(data)
   data <- data.table::transpose(data) 								# switch columns <> rows

R/pca.R

@@ -249,11 +249,17 @@ pca <- function(input, output, session, clarion, width = 28, height = 28, ppi =
 
   # group data by dimension
   reorganized_data <- shiny::reactive({
-    sapply(colnames(plot()$data$var$coord), USE.NAMES = TRUE, simplify = FALSE, function(dim) {
-      sapply(plot()$data$var, function(table) {
+    dims <- lapply(colnames(plot()$data$var$coord), function(dim) {
+      dim_data <- lapply(plot()$data$var, function(table) {
         table[, dim]
       })
+
+      do.call(cbind, dim_data)
     })
+
+    names(dims) <- colnames(plot()$data$var$coord)
+
+    return(dims)
   })
 
   # download #####

R/transformation.R

@@ -128,7 +128,7 @@ transformation <- function(input, output, session, data, transpose = FALSE, pseu
 
     # replace infinite with NA & NA with 0
     if (replaceInf) {
-      is.na(output) <- sapply(output, is.infinite)
+      is.na(output) <- vapply(output, FUN = is.infinite, FUN.VALUE = logical(1))
     }
     if (replaceNA) {
       output[is.na(output)] <- 0