From ad9573aea06caccc6b492bef41d4de202d09b870 Mon Sep 17 00:00:00 2001
From: Schultheis <hschult@kerckhoff.mpg.de>
Date: Fri, 29 Jun 2018 09:00:38 +0200
Subject: [PATCH] replaced sapply with type safe v- /lapply
---
R/and.R | 10 +++-------
R/clarion.R | 2 +-
R/featureSelector.R | 2 +-
R/function.R | 10 +++++-----
R/pca.R | 10 ++++++++--
R/transformation.R | 2 +-
6 files changed, 19 insertions(+), 17 deletions(-)
diff --git a/R/and.R b/R/and.R
index 3614a52..0d7f889 100644
--- a/R/and.R
+++ b/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)
diff --git a/R/clarion.R b/R/clarion.R
index 5c0260d..22ce390 100644
--- a/R/clarion.R
+++ b/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.")
}
diff --git a/R/featureSelector.R b/R/featureSelector.R
index 2d9f4ba..40b2bce 100644
--- a/R/featureSelector.R
+++ b/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 {
diff --git a/R/function.R b/R/function.R
index 41cfc11..d93701a 100644
--- a/R/function.R
+++ b/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
diff --git a/R/pca.R b/R/pca.R
index 6dade4a..edca112 100644
--- a/R/pca.R
+++ b/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 #####
diff --git a/R/transformation.R b/R/transformation.R
index b535995..2a13f15 100644
--- a/R/transformation.R
+++ b/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