From ad9573aea06caccc6b492bef41d4de202d09b870 Mon Sep 17 00:00:00 2001 From: Schultheis 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