diff --git a/NEWS.md b/NEWS.md index f61bbd9..b73fa15 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # wilson 2.1.0 - implemented tobias_parser +# wilson 2.0.3 +- reactive transformation parameter # wilson 2.0.2 - fixed CRAN check Note/ Error # wilson 2.0.1 diff --git a/R/geneView.R b/R/geneView.R index 72aead3..8393890 100644 --- a/R/geneView.R +++ b/R/geneView.R @@ -143,7 +143,7 @@ geneView <- function(input, output, session, clarion, plot.method = "static", la # modules/ ui ##### color <- shiny::callModule(colorPicker, "color", distribution = "all", selected = "Dark2") - transform <- shiny::callModule(transformation, "transform", shiny::reactive(as.matrix(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes), selector$selected_columns(), with = FALSE]))) + transform <- shiny::callModule(transformation, "transform", shiny::reactive(as.matrix(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes), selector$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == selector$selected_columns()[1]][["level"]] == "contrast", 0, 1))) selector <- shiny::callModule(columnSelector, "selector", type.columns = shiny::reactive(object()$metadata[level != "feature", c("key", "level")]), column.type.label = "Select Columns") custom_label <- shiny::callModule(label, "labeller", data = shiny::reactive(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes)]), sep = label.sep) factor_data <- shiny::callModule(label, "group", label = "Select grouping factors", data = shiny::reactive(object()$get_factors()[key %in% selector$selected_columns(), !"key"]), sep = label.sep, unique = FALSE) @@ -182,7 +182,7 @@ geneView <- function(input, output, session, clarion, plot.method = "static", la shinyjs::reset("groupby") shinyjs::reset("plot_columns") color <<- shiny::callModule(colorPicker, "color", distribution = "all", selected = "Dark2") - transform <<- shiny::callModule(transformation, "transform", shiny::reactive(as.matrix(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes), selector$selected_columns(), with = FALSE]))) + transform <<- shiny::callModule(transformation, "transform", shiny::reactive(as.matrix(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes), selector$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == selector$selected_columns()[1]][["level"]] == "contrast", 0, 1))) selector <<- shiny::callModule(columnSelector, "selector", type.columns = shiny::reactive(object()$metadata[level != "feature", c("key", "level")]), column.type.label = "Select Columns") custom_label <<- shiny::callModule(label, "labeller", data = shiny::reactive(object()$data[which(object()$data[[object()$get_name()]] %in% input$genes)]), sep = label.sep) factor_data <<- shiny::callModule(label, "group", label = "Select grouping factors", data = shiny::reactive(object()$get_factors()[key %in% selector$selected_columns(), !"key"]), sep = label.sep, unique = FALSE) diff --git a/R/global_cor_heatmap.R b/R/global_cor_heatmap.R index 77292d7..ab76504 100644 --- a/R/global_cor_heatmap.R +++ b/R/global_cor_heatmap.R @@ -207,7 +207,7 @@ global_cor_heatmap <- function(input, output, session, clarion, plot.method = "s # load internal modules columns <- shiny::callModule(columnSelector, "select", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column types to choose from") - transform <- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE]))) + transform <- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == columns$selected_columns()[1]][["level"]] == "contrast", 0, 1)), replaceNA = FALSE) color <- shiny::callModule(colorPicker, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(result_data()[, -1]))) # load dynamic ui @@ -235,7 +235,7 @@ global_cor_heatmap <- function(input, output, session, clarion, plot.method = "s shinyjs::reset("row_label") shinyjs::reset("column_label") columns <<- shiny::callModule(columnSelector, "select", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column types to choose from") - transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE]))) + transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == columns$selected_columns()[1]][["level"]] == "contrast", 0, 1)), replaceNA = FALSE) color <<- shiny::callModule(colorPicker, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(result_data()[, -1]))) clear_plot(TRUE) }) diff --git a/R/heatmap.R b/R/heatmap.R index 1f25ac4..18e2740 100644 --- a/R/heatmap.R +++ b/R/heatmap.R @@ -155,7 +155,7 @@ heatmap <- function(input, output, session, clarion, plot.method = "static", lab # modules/ ui ##### columns <- shiny::callModule(columnSelector, "select", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column types to choose from") - transform <- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE]))) + transform <- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == columns$selected_columns()[1]][["level"]] == "contrast", 0, 1)), replaceNA = FALSE) color <- shiny::callModule(colorPicker, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(transform$data()))) custom_label <- shiny::callModule(label, "labeller", data = shiny::reactive(object()$data), label = "Select row label", sep = label.sep, disable = shiny::reactive(!input$row_label)) @@ -177,7 +177,7 @@ heatmap <- function(input, output, session, clarion, plot.method = "static", lab shinyjs::reset("row_label") shinyjs::reset("column_label") columns <<- shiny::callModule(columnSelector, "select", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column types to choose from") - transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE]))) + transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(object()$data[, columns$selected_columns(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == columns$selected_columns()[1]][["level"]] == "contrast", 0, 1)), replaceNA = FALSE) color <<- shiny::callModule(colorPicker, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(transform$data()))) custom_label <<- shiny::callModule(label, "labeller", data = shiny::reactive(object()$data), label = "Select row label", sep = label.sep, disable = shiny::reactive(!input$row_label)) clear_plot(TRUE) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index 950b2ea..988116b 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -187,8 +187,8 @@ scatterPlot <- function(input, output, session, clarion, marker.output = NULL, p yaxis <- shiny::callModule(columnSelector, "yaxis", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column type to choose from", label.label = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) zaxis <- shiny::callModule(columnSelector, "zaxis", type.columns = shiny::reactive(object()$metadata[, intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column type to choose from", label.label = "Color label", multiple = FALSE, none = TRUE) color <- shiny::callModule(colorPicker, "color", distribution = "all", winsorize = shiny::reactive(switch(shiny::isTruthy(zaxis$selected_column()) + 1, NULL, equalize(object()$data[, zaxis$selected_column(), with = FALSE])))) - transform_x <- shiny::callModule(transformation, "transform_x", data = shiny::reactive(as.matrix(object()$data[, xaxis$selected_column(), with = FALSE]))) - transform_y <- shiny::callModule(transformation, "transform_y", data = shiny::reactive(as.matrix(object()$data[, yaxis$selected_column(), with = FALSE]))) + transform_x <- shiny::callModule(transformation, "transform_x", data = shiny::reactive(as.matrix(object()$data[, xaxis$selected_column(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == xaxis$selected_column()][["level"]] == "contrast", 0, 1))) + transform_y <- shiny::callModule(transformation, "transform_y", data = shiny::reactive(as.matrix(object()$data[, yaxis$selected_column(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == yaxis$selected_column()][["level"]] == "contrast", 0, 1))) # transform highlight data if (!is.null(marker.output)) { # note: same id as transform_x/y so it depends on same ui @@ -223,8 +223,8 @@ scatterPlot <- function(input, output, session, clarion, marker.output = NULL, p yaxis <<- shiny::callModule(columnSelector, "yaxis", type.columns = shiny::reactive(object()$metadata[level != "feature", intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column type to choose from", label.label = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) zaxis <<- shiny::callModule(columnSelector, "zaxis", type.columns = shiny::reactive(object()$metadata[, intersect(names(object()$metadata), c("key", "level", "label", "sub_label")), with = FALSE]), column.type.label = "Column type to choose from", label.label = "Color label", multiple = FALSE, none = TRUE) color <<- shiny::callModule(colorPicker, "color", distribution = "all", winsorize = shiny::reactive(switch(shiny::isTruthy(zaxis$selected_column()) + 1, NULL, equalize(object()$data[, zaxis$selected_column(), with = FALSE])))) - transform_x <<- shiny::callModule(transformation, "transform_x", data = shiny::reactive(as.matrix(object()$data[, xaxis$selected_column(), with = FALSE]))) - transform_y <<- shiny::callModule(transformation, "transform_y", data = shiny::reactive(as.matrix(object()$data[, yaxis$selected_column(), with = FALSE]))) + transform_x <<- shiny::callModule(transformation, "transform_x", data = shiny::reactive(as.matrix(object()$data[, xaxis$selected_column(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == xaxis$selected_column()][["level"]] == "contrast", 0, 1))) + transform_y <<- shiny::callModule(transformation, "transform_y", data = shiny::reactive(as.matrix(object()$data[, yaxis$selected_column(), with = FALSE])), pseudocount = shiny::reactive(ifelse(object()$metadata[key == yaxis$selected_column()][["level"]] == "contrast", 0, 1))) # transform highlight data if (!is.null(marker.output)) { # note: same id as transform_x/y so it depends on same ui diff --git a/R/transformation.R b/R/transformation.R index 2a13f15..abf85fb 100644 --- a/R/transformation.R +++ b/R/transformation.R @@ -37,10 +37,10 @@ transformationUI <- function(id, label = "Transformation", selected = "raw", cho #' @param output Shiny's output object. #' @param session Shiny's session object. #' @param data Numeric matrix on which transformation is performed (column-wise). (Supports reactive) -#' @param transpose Whether the matrix should be transposed to enable row-wise transformation. -#' @param pseudocount Numeric Variable to add a pseudocount to log-based transformations. -#' @param replaceInf Change Infinite to NA, applied after transformation. -#' @param replaceNA Change NA to 0, applied after transformation. +#' @param transpose Whether the matrix should be transposed to enable row-wise transformation. (Supports reactive) +#' @param pseudocount Numeric Variable to add a pseudocount to log-based transformations. (Supports reactive) +#' @param replaceInf Change Infinite to NA, applied after transformation. (Supports reactive) +#' @param replaceNA Change NA to 0, applied after transformation. (Supports reactive) #' #' @return Namedlist of two containing data and name of the used method. #' data: Reactive containing the transformed matrix. Infinite values are replaced by NA and NA values are replaced by 0. @@ -49,7 +49,7 @@ transformationUI <- function(id, label = "Transformation", selected = "raw", cho #' #' @export transformation <- function(input, output, session, data, transpose = FALSE, pseudocount = 1, replaceInf = TRUE, replaceNA = TRUE) { - # handle reactive data + # handle reactive parameter data_r <- shiny::reactive({ if (shiny::is.reactive(data)) { data() @@ -58,6 +58,38 @@ transformation <- function(input, output, session, data, transpose = FALSE, pseu } }) + transpose_r <- shiny::reactive({ + if (shiny::is.reactive(transpose)) { + transpose() + } else { + transpose + } + }) + + pseudocount_r <- shiny::reactive({ + if (shiny::is.reactive(pseudocount)) { + pseudocount() + } else { + pseudocount + } + }) + + replaceInf_r <- shiny::reactive({ + if (shiny::is.reactive(replaceInf)) { + replaceInf() + } else { + replaceInf + } + }) + + replaceNA_r <- shiny::reactive({ + if (shiny::is.reactive(replaceNA)) { + replaceNA() + } else { + replaceNA + } + }) + # reset shinyjs::reset("transform") shinyjs::reset("transpose") @@ -111,30 +143,31 @@ transformation <- function(input, output, session, data, transpose = FALSE, pseu transformed_data <- shiny::reactive({ data <- data_r() - if (transpose | ifelse(!is.null(input$transpose), input$transpose == "row", FALSE) & input$transform == "zscore") { + if (transpose_r() | ifelse(!is.null(input$transpose), input$transpose == "row", FALSE) & input$transform == "zscore") { data <- t(data) } # transform data output <- switch(input$transform, - log2 = log2(data + pseudocount), - `-log2` = -log2(data + pseudocount), - log10 = log10(data + pseudocount), - `-log10` = -log10(data + pseudocount), + log2 = log2(data + pseudocount_r()), + `-log2` = -log2(data + pseudocount_r()), + log10 = log10(data + pseudocount_r()), + `-log10` = -log10(data + pseudocount_r()), zscore = scale(data, center = TRUE, scale = TRUE), - rlog = try_rlog(round(data) + pseudocount), + rlog = try_rlog(round(data) + pseudocount_r()), raw = data ) # replace infinite with NA & NA with 0 - if (replaceInf) { + if (replaceInf_r()) { is.na(output) <- vapply(output, FUN = is.infinite, FUN.VALUE = logical(1)) } - if (replaceNA) { + + if (replaceNA_r()) { output[is.na(output)] <- 0 } - if (transpose | ifelse(!is.null(input$transpose), input$transpose == "row", FALSE) & input$transform == "zscore") { + if (transpose_r() | ifelse(!is.null(input$transpose), input$transpose == "row", FALSE) & input$transform == "zscore") { output <- t(output) } diff --git a/exec/transformation_example.R b/exec/transformation_example.R index 693c743..5ccefac 100644 --- a/exec/transformation_example.R +++ b/exec/transformation_example.R @@ -3,21 +3,32 @@ library(shiny) source("../R/transformation.R") ui <- fluidPage( - transformationUI(id = "id", transposeOptions = TRUE) + h3("Module UI"), + transformationUI(id = "id", transposeOptions = TRUE), + hr(), + h3("Input parameter"), + numericInput(inputId = "pseudocount", label = "Pseudocount", value = 1), + checkboxInput(inputId = "transpose", label = "Transpose"), + checkboxInput(inputId = "replaceInf", label = "replace Inf with NA", value = TRUE), + checkboxInput(inputId = "replaceNA", label = "replace NA with 0", value = TRUE), + hr(), + h3("Module output"), + verbatimTextOutput(outputId = "module_out") ) server <- function(input, output) { - data_matrix <- matrix( 0:10, ncol = 10) + data_matrix <- matrix(c(0:9, 0:9), ncol = 10) data <- reactive({ data_matrix }) - mod <- callModule(transformation, "id", data, transpose = F, pseudocount = 0, replaceInf = T, replaceNA = T) + mod <- callModule(transformation, "id", data, transpose = reactive(input$transpose), pseudocount = reactive(input$pseudocount), replaceInf = reactive(input$replaceInf), replaceNA = reactive(input$replaceNA)) - observe({ + output$module_out <- renderPrint({ print(mod$method()) print(mod$data()) + print(mod$transpose()) }) } diff --git a/man/transformation.Rd b/man/transformation.Rd index 7bb7819..bc56bf1 100644 --- a/man/transformation.Rd +++ b/man/transformation.Rd @@ -16,13 +16,13 @@ transformation(input, output, session, data, transpose = FALSE, \item{data}{Numeric matrix on which transformation is performed (column-wise). (Supports reactive)} -\item{transpose}{Whether the matrix should be transposed to enable row-wise transformation.} +\item{transpose}{Whether the matrix should be transposed to enable row-wise transformation. (Supports reactive)} -\item{pseudocount}{Numeric Variable to add a pseudocount to log-based transformations.} +\item{pseudocount}{Numeric Variable to add a pseudocount to log-based transformations. (Supports reactive)} -\item{replaceInf}{Change Infinite to NA, applied after transformation.} +\item{replaceInf}{Change Infinite to NA, applied after transformation. (Supports reactive)} -\item{replaceNA}{Change NA to 0, applied after transformation.} +\item{replaceNA}{Change NA to 0, applied after transformation. (Supports reactive)} } \value{ Namedlist of two containing data and name of the used method.