From 9ed3622c007e70f17be8433ea5d0f0dbd433ca1b Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 08:27:30 +0100 Subject: [PATCH 01/15] scatterplot: added params x., y., z.names to individually select available options for the corresponding axis; enabled categorized scatterplot --- R/scatterPlot.R | 81 ++++++++++++++++++++++++++++++++++++++++------ man/scatterPlot.Rd | 13 ++++++-- 2 files changed, 82 insertions(+), 12 deletions(-) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index 9b75e5e..c3a0161 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -60,6 +60,11 @@ scatterPlotUI <- function(id) { id = ns("zaxis"), title = "Data on z-axis", label = T + ), + shiny::checkboxInput( + inputId = ns("force_cat"), + label = "Force categories", + value = FALSE ) ) ), @@ -117,6 +122,9 @@ scatterPlotUI <- function(id) { #' column2: corresponding column type #' column3: label (optional, used instead of id) #' column4: sub_label (optional, added to id/ label) +#' @param x.names Character vector of column names(data column names) which will be available for x-axis. Can be reactive. +#' @param y.names Character vector of column names(data column names) which will be available for y-axis. Can be reactive. +#' @param z.names Character vector of column names(data column names) which will be available for z-axis. Can be reactive. #' @param features data.table of the features to mark (first column = id) #' @param markerReac reactive containing inputs of marker module. #' @param plot.method Choose to rather render a 'interactive' or 'static' plot. Defaults to 'static'. @@ -130,7 +138,7 @@ scatterPlotUI <- function(id) { #' @details Make sure to have the same columnnames in data and features. #' #' @export -scatterPlot <- function(input, output, session, data, types, features = NULL, markerReac = NULL, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1) { +scatterPlot <- function(input, output, session, data, types, x.names = NULL, y.names = NULL, z.names = NULL, features = NULL, markerReac = NULL, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1) { #handle reactive data data.r <- shiny::reactive({ if(shiny::is.reactive(data)){ @@ -174,6 +182,58 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma scale = scale) }) + # available types for corresponding axis + types_x <- shiny::reactive({ + if(shiny::is.reactive(types)) { + t <- types() + } else { + t <- types + } + + if(shiny::is.reactive(x.names)) { + x <- x.names() + } else { + x <- x.names + } + if(is.null(x)) return(t) + + t[key %in% x] + }) + + types_y <- shiny::reactive({ + if(shiny::is.reactive(types)) { + t <- types() + } else { + t <- types + } + + if(shiny::is.reactive(y.names)) { + y <- y.names() + } else { + y <- y.names + } + if(is.null(y)) return(t) + + t[key %in% y] + }) + + types_z <- shiny::reactive({ + if(shiny::is.reactive(types)) { + t <- types() + } else { + t <- types + } + + if(shiny::is.reactive(z.names)) { + z <- z.names() + } else { + z <- z.names + } + if(is.null(z)) return(t) + + t[key %in% z] + }) + #Fetch the reactive guide for this module guide <- scatterPlotGuide(session, !is.null(markerReac)) shiny::observeEvent(input$guide, { @@ -192,9 +252,10 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma shinyjs::reset("line") shinyjs::reset("pointsize") shinyjs::reset("labelsize") - xaxis <<- shiny::callModule(columnSelector, "xaxis", type.columns = types, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_x$method())) - yaxis <<- shiny::callModule(columnSelector, "yaxis", type.columns = types, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) - zaxis <<- shiny::callModule(columnSelector, "zaxis", type.columns = types, columnTypeLabel = "Column type to choose from", multiple = FALSE, none = TRUE) + shinyjs::reset("force_cat") + xaxis <<- shiny::callModule(columnSelector, "xaxis", type.columns = types_x, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_x$method())) + yaxis <<- shiny::callModule(columnSelector, "yaxis", type.columns = types_y, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) + zaxis <<- shiny::callModule(columnSelector, "zaxis", type.columns = types_z, columnTypeLabel = "Column type to choose from", multiple = FALSE, none = TRUE) colorPicker <<- shiny::callModule(colorPicker2, "color", distribution = list("sequential", "diverging"), winsorize = winsorize) transform_x <<- shiny::callModule(transformation, "transform_x", data = data_x) transform_y <<- shiny::callModule(transformation, "transform_y", data = data_y) @@ -211,9 +272,9 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma } }) - xaxis <- shiny::callModule(columnSelector, "xaxis", type.columns = types, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_x$method())) - yaxis <- shiny::callModule(columnSelector, "yaxis", type.columns = types, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) - zaxis <- shiny::callModule(columnSelector, "zaxis", type.columns = types, columnTypeLabel = "Column type to choose from", labelLabel = "Color label", multiple = FALSE, none = TRUE) + xaxis <- shiny::callModule(columnSelector, "xaxis", type.columns = types_x, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_x$method())) + yaxis <- shiny::callModule(columnSelector, "yaxis", type.columns = types_y, columnTypeLabel = "Column type to choose from", labelLabel = "Axis label", multiple = FALSE, suffix = shiny::reactive(transform_y$method())) + zaxis <- shiny::callModule(columnSelector, "zaxis", type.columns = types_z, columnTypeLabel = "Column type to choose from", labelLabel = "Color label", multiple = FALSE, none = TRUE) colorPicker <- shiny::callModule(colorPicker2, "color", distribution = list("sequential", "diverging"), winsorize = winsorize) transform_x <- shiny::callModule(transformation, "transform_x", data = data_x) @@ -354,7 +415,8 @@ scatterPlot <- function(input, output, session, data, types, features = NULL, ma width = size()$width, height = size()$height, ppi = size()$ppi, - scale = size()$scale + scale = size()$scale, + categorized = if(input$force_cat || ncol(result.data()$processed.data) >= 4 && !is.numeric(result.data()$processed.data[[4]])) TRUE else FALSE ) progress$set(1) @@ -472,7 +534,8 @@ scatterPlotGuide <- function(session, marker = FALSE) { Use upper/ lower limit to customize the axis limits.", "guide_zaxis" = "

Data selection: z-axis

Select a column type for visualization, then select an individual column of the chosen type. The data from the selected column will be mapped onto a color scale.
- You can also set a customized label for the color bar. If left empty, the column name will be used as default.", + You can also set a customized label for the color bar. If left empty, the column name will be used as default. + If there is a non numeric column selected scatterplot will attempt to do a categorized coloring approach, whereas numeric data will result in a gradient. Use 'force categories' to achieve categorization with numeric values.", "guide_color" = "

Color palettes

Based on the data distribution, select either a sequential or diverging color palette.
Choose the range of the color legend by defining it's upper and lower limits with 'Winsorize to upper/lower'. Be aware that out of bounds values will be mapped to their nearest color.
diff --git a/man/scatterPlot.Rd b/man/scatterPlot.Rd index 53dc5c2..7d7489b 100644 --- a/man/scatterPlot.Rd +++ b/man/scatterPlot.Rd @@ -4,9 +4,10 @@ \alias{scatterPlot} \title{scatterPlot module server logic} \usage{ -scatterPlot(input, output, session, data, types, features = NULL, - markerReac = NULL, plot.method = "static", width = "auto", - height = "auto", ppi = 72, scale = 1) +scatterPlot(input, output, session, data, types, x.names = NULL, + y.names = NULL, z.names = NULL, features = NULL, markerReac = NULL, + plot.method = "static", width = "auto", height = "auto", ppi = 72, + scale = 1) } \arguments{ \item{input}{Shiny's input object} @@ -23,6 +24,12 @@ column2: corresponding column type column3: label (optional, used instead of id) column4: sub_label (optional, added to id/ label)} +\item{x.names}{Character vector of column names(data column names) which will be available for x-axis. Can be reactive.} + +\item{y.names}{Character vector of column names(data column names) which will be available for y-axis. Can be reactive.} + +\item{z.names}{Character vector of column names(data column names) which will be available for z-axis. Can be reactive.} + \item{features}{data.table of the features to mark (first column = id)} \item{markerReac}{reactive containing inputs of marker module.} From af06906514c20767d1e706f3a5a798013d356013 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 08:27:57 +0100 Subject: [PATCH 02/15] scatterplot_example: updated --- exec/scatterPlot_example.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/exec/scatterPlot_example.R b/exec/scatterPlot_example.R index 2728010..9f36aca 100644 --- a/exec/scatterPlot_example.R +++ b/exec/scatterPlot_example.R @@ -8,6 +8,7 @@ source("../R/transformation.R") source("../R/scatterPlot.R") source("../R/marker.R") source("../R/limit.R") +source("../R/label.R") ####Test Data data <- data.table::data.table(id = rownames(mtcars), mtcars) @@ -33,7 +34,7 @@ ui <- dashboardPage(header = dashboardHeader(), server <- function(input, output) { marker <- callModule(marker, "marker", data) # highlight all manual cars - plot <- callModule(scatterPlot, "id", data = data, types = metadata[level != "annotation"], features = data[am == 1], markerReac = marker, plot.method = "interactive", width = reactive(input$width), height = reactive(input$height), scale = reactive(input$scale)) + plot <- callModule(scatterPlot, "id", data = data, types = metadata, x.names = metadata[level != "annotation"][["key"]], y.names = metadata[level != "annotation"][["key"]], features = data[am == 1], markerReac = marker, plot.method = "interactive", width = reactive(input$width), height = reactive(input$height), scale = reactive(input$scale)) observe({ print(plot()) From 2f4ee268784f22e638d1e7143947860c62e16d38 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 09:09:40 +0100 Subject: [PATCH 03/15] columnSelector: don't return logical(0) --- R/columnSelector.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/columnSelector.R b/R/columnSelector.R index 159e89a..01c664d 100644 --- a/R/columnSelector.R +++ b/R/columnSelector.R @@ -141,7 +141,7 @@ columnSelector <- function(input, output, session, type.columns, type = NULL, co }) out.type <- shiny::reactive(input$select.type) - out.selectedColumns <- shiny::reactive(ifelse(input$select.column == "None", "", input$select.column)) + out.selectedColumns <- shiny::reactive(ifelse(shiny::req(input$select.column) == "None", "", input$select.column)) out.label <- shiny::reactive({ if(is.null(input$select.label)) { label <- create_label() From a411bf4797eb4208ebe388962c0e8e9f0279e01c Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 10:15:04 +0100 Subject: [PATCH 04/15] featureSelector: with DT version >= 0.3 dataTableProxy no longer needs session$ns; set wilson dependecy to DT >= 0.3 --- DESCRIPTION | 2 +- R/featureSelector.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 828acac..79bd383 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,7 @@ Imports: shiny, plotly, scales, shinydashboard, - DT, + DT (>= 0.3), colourpicker, RColorBrewer, shinyjs, diff --git a/R/featureSelector.R b/R/featureSelector.R index bb64b5d..0cfc84a 100644 --- a/R/featureSelector.R +++ b/R/featureSelector.R @@ -204,7 +204,7 @@ featureSelector <- function(input, output, session, data, features = NULL, featu }) # access data table information - proxy <- DT::dataTableProxy(session$ns("table")) + proxy <- DT::dataTableProxy("table") # select rows via row_selector shiny::observe({ From f289ce974fb7b8ae10f80fefe435fb69d93fd24d Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 10:22:40 +0100 Subject: [PATCH 05/15] scatterPlot: warn if there are more than 10 categories selected --- R/scatterPlot.R | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index c3a0161..0e2d338 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -293,6 +293,36 @@ scatterPlot <- function(input, output, session, data, types, x.names = NULL, y.n }) } + # show warning if there would more than 10 categories + shiny::observe({ + shiny::req(!is.null(zaxis$selectedColumn())) + + # something selected? + if(zaxis$selectedColumn() != "") { + # categories used? + if(input$force_cat || !is.numeric(data.r()[[zaxis$selectedColumn()]])) { + cat_num <- length(unique(data.r()[[zaxis$selectedColumn()]])) + + if(cat_num > 10) { + shiny::showNotification( + id = session$ns("cat-limit"), + paste("Warning! There are", cat_num, "different categories selected. This can result in unexpected behavior. Recommended are 10 or less categories."), + duration = NULL, + type = "warning" + ) + + shinyjs::runjs(paste0("$(document.getElementById('", paste0("shiny-notification-", session$ns("cat-limit")), "')).addClass('notification-position-center');")) + } else { + shiny::removeNotification(session$ns("cat-limit")) + } + } else { + shiny::removeNotification(session$ns("cat-limit")) + } + } else { + shiny::removeNotification(session$ns("cat-limit")) + } + }) + transformed_data <- shiny::reactive({ #reassemble after transformation if(zaxis$selectedColumn() != ""){ @@ -345,7 +375,7 @@ scatterPlot <- function(input, output, session, data, types, x.names = NULL, y.n duration = NULL, type = "warning" ) - shinyjs::addClass(selector = paste0("#shiny-notification-", session$ns("label-limit")), class = "notification-position-center") + shinyjs::runjs(paste0("$(document.getElementById('", paste0("shiny-notification-", session$ns("label-limit")), "')).addClass('notification-position-center');")) } } From 00cfad76acfb28a0d3410712d5211eef4efda0cd Mon Sep 17 00:00:00 2001 From: Schultheis Date: Tue, 30 Jan 2018 14:07:53 +0100 Subject: [PATCH 06/15] heatmaply dependency version >= 0.14.0 --- DESCRIPTION | 2 +- R/function.R | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 79bd383..4db4708 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,7 @@ Imports: shiny, rjson, FactoMineR, factoextra, - heatmaply, + heatmaply (>= 0.14.0), shinyBS, shinythemes RoxygenNote: 6.0.1 diff --git a/R/function.R b/R/function.R index 541f3b1..354a697 100644 --- a/R/function.R +++ b/R/function.R @@ -478,6 +478,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label #layout plot <- heatmaply::heatmaply(plot, plot_method = "ggplot", + node_type = "heatmap", scale_fill_gradient_fun = ggplot2::scale_fill_gradientn(colors = colors, name = unitlabel, limits = winsorize.colors, oob = scales::squish), heatmap_layers = ggplot2::theme(text = ggplot2::element_text(size = 12 * scale)) ) From d9cb5bb4eab7ed34a2d57f646af6876a2d29de07 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 09:47:06 +0100 Subject: [PATCH 07/15] columnSelector: return "" for falsy input$select.column --- R/columnSelector.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/columnSelector.R b/R/columnSelector.R index 01c664d..528de10 100644 --- a/R/columnSelector.R +++ b/R/columnSelector.R @@ -141,7 +141,7 @@ columnSelector <- function(input, output, session, type.columns, type = NULL, co }) out.type <- shiny::reactive(input$select.type) - out.selectedColumns <- shiny::reactive(ifelse(shiny::req(input$select.column) == "None", "", input$select.column)) + out.selectedColumns <- shiny::reactive(if(shiny::isTruthy(input$select.column) && input$select.column != "None") input$select.column else "") out.label <- shiny::reactive({ if(is.null(input$select.label)) { label <- create_label() From 6a09ed63e7c3894defc4bb6f60e9319e5ba91085 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 09:47:41 +0100 Subject: [PATCH 08/15] scatterPlot: disable plot button if mandatory value is missing --- R/scatterPlot.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/scatterPlot.R b/R/scatterPlot.R index 0e2d338..82644af 100644 --- a/R/scatterPlot.R +++ b/R/scatterPlot.R @@ -323,6 +323,15 @@ scatterPlot <- function(input, output, session, data, types, x.names = NULL, y.n } }) + # disable plot if mandatory x- or y-axis missing + shiny::observe({ + if(!isTruthy(xaxis$selectedColumn()) || !isTruthy(yaxis$selectedColumn())) { + shinyjs::disable("plot") + } else { + shinyjs::enable("plot") + } + }) + transformed_data <- shiny::reactive({ #reassemble after transformation if(zaxis$selectedColumn() != ""){ From 29bc64665d9afa38e62238778e7bc6ef0379914d Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 10:01:55 +0100 Subject: [PATCH 09/15] global_cor_heatmap: disable plotting if not enough data & show warning --- R/global_cor_heatmap.R | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/R/global_cor_heatmap.R b/R/global_cor_heatmap.R index 4ffd71b..6fcd7dc 100644 --- a/R/global_cor_heatmap.R +++ b/R/global_cor_heatmap.R @@ -258,9 +258,24 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method rintrojs::introjs(session, options = list(steps = guide())) }) + # show warning if not enough columns selected + shiny::observe({ + shiny::req(columns$selectedColumns()) + + if(length(columns$selectedColumns()) < 2) { + shiny::showNotification( + ui = "Warning! At least two columns needed. Please select more.", + id = "less_data_warning", + type = "warning" + ) + } else { + shiny::removeNotification("less_data_warning") + } + }) + # enable/ disable plot button shiny::observe({ - if(length(columns$selectedColumns()) <= 1) { + if(!shiny::isTruthy(columns$selectedColumns()) || length(columns$selectedColumns()) < 2) { shinyjs::disable("plot") }else { shinyjs::enable("plot") From f60732948a95d8b53283c8f1322195cb09abaee0 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 10:24:36 +0100 Subject: [PATCH 10/15] pca: better warning for insufficient data --- R/pca.R | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/R/pca.R b/R/pca.R index 53de734..a7b76b3 100644 --- a/R/pca.R +++ b/R/pca.R @@ -171,21 +171,16 @@ pca <- function(input, output, session, data, types, levels = NULL, entryLabel = #update dimension inputs shiny::observe({ - col.num <- length(columnSelect$selectedColumns()) - if(col.num < 3 | nrow(data.r()) < 3 | is.na(input$dimA) | is.na(input$dimB)){ + col.num <- length(shiny::req(columnSelect$selectedColumns())) + if(col.num < 3 || nrow(shiny::isolate(data.r())) < 3 || is.na(input$dimA) || is.na(input$dimB)){ shinyjs::disable("plot") # show warning if not enough selected - if(col.num > 0) { - shiny::showNotification( - ui = "Not enough columns selected! At least 3 needed for plotting.", - id = "warning", - type = "warning" - ) - }else { - shiny::removeNotification("warning") - } - + shiny::showNotification( + ui = "Not enough columns/ rows selected! At least 3 of each needed for plotting.", + id = "warning", + type = "warning" + ) }else{ shiny::removeNotification("warning") shinyjs::enable("plot") From 031c64fd91471850c81882c93ed8247965baf019 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 15:32:25 +0100 Subject: [PATCH 11/15] heatmap: enable plotting only for sufficient data --- R/heatmap.R | 48 +++++++++++++++++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 11 deletions(-) diff --git a/R/heatmap.R b/R/heatmap.R index df9c9ec..3f9a1e1 100644 --- a/R/heatmap.R +++ b/R/heatmap.R @@ -158,7 +158,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static", shiny::observe({ shiny::req(data.r()) - if(length(columns$selectedColumns()) > 0){ + if(shiny::isTruthy(columns$selectedColumns())){ if(input$clustering != "none") { # clustering if(plot.method == "static" && nrow(data.r()) > static) { # cluster limitation (static) shiny::showNotification( @@ -289,6 +289,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static", plot.method = plot.method, winsorize.colors = colorPicker()$winsorize ) + progress$set(1) return(plot) @@ -372,20 +373,45 @@ heatmap <- function(input, output, session, data, types, plot.method = "static", all <- list(selection = selection, clustering = clustering, options = options) }) - #enable/ disable plot button + # enable/ disable plot button + # show warning if disabled shiny::observe({ - if(length(columns$selectedColumns()) <= 0){ # columns selected - shinyjs::disable("plot") - } else { - # clustering - if(input$clustering != "none") { - if(plot.method == "static" && nrow(data.r()) > static || plot.method == "interactive" && nrow(data.r()) > interactive) { - shinyjs::disable("plot") - } else { + shinyjs::disable("plot") + show_warning <- TRUE + + # are columns selected? + if(shiny::isTruthy(columns$selectedColumns())) { + row.num <- nrow(shiny::isolate(data.r())) + col.num <- length(columns$selectedColumns()) + + # minimal heatmap possible (greater 1x1)? + if(row.num > 1 || col.num > 1) { + # no clustering for single rows or columns + if(row.num == 1 && !is.element(input$clustering, c("both", "row"))) { + show_warning <- FALSE + shinyjs::enable("plot") + } else if(col.num == 1 && !is.element(input$clustering, c("both", "column"))) { + show_warning <- FALSE + shinyjs::enable("plot") + } else if(row.num > 1 && col.num > 1) { # no border case heatmaps + show_warning <- FALSE shinyjs::enable("plot") } + } + + if(show_warning) { + shiny::showNotification( + ui = "Warning! Insufficient columns/ rows. Either disable the respective clustering or expand the dataset.", + id = "insuf_data", + type = "warning" + ) } else { - shinyjs::enable("plot") + shiny::removeNotification("insuf_data") + } + + # maximum heatmap reached? + if(plot.method == "static" && row.num > static || plot.method == "interactive" && row.num > interactive) { + shinyjs::disable("plot") } } }) From d28bbbb90524fc0aedf3532dba918afde08924d5 Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 15:35:02 +0100 Subject: [PATCH 12/15] create_heatmap: fixed bug addressing wrong axis --- R/function.R | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/R/function.R b/R/function.R index 354a697..4e417df 100644 --- a/R/function.R +++ b/R/function.R @@ -483,10 +483,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label heatmap_layers = ggplot2::theme(text = ggplot2::element_text(size = 12 * scale)) ) - # scale axis ticks - ticks <- list(tickfont = list(size = 12 * scale)) - - plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size), xaxis = ticks, yaxis2 = ticks) + plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size)) # decide which sizes should be used if(width == "auto") { @@ -517,14 +514,16 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label plot$x$layout$width <- width plot$x$layout$height <- height - #address correct axis + # address correct axis + # scale axis tickfont + ticks <- list(size = 12 * scale) if(clustering == "both" || clustering == "column"){ - plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label), - yaxis2 = list(showticklabels = row.label) + plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label, tickfont = ticks), + yaxis2 = list(showticklabels = row.label, tickfont = ticks) ) }else if(clustering == "row" || clustering == "none"){ - plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label), - yaxis = list(showticklabels = row.label) + plot <- plotly::layout(plot, xaxis = list(showticklabels = column.label, tickfont = ticks), + yaxis = list(showticklabels = row.label, tickfont = ticks) ) } From 84430a07eea933655d27cea378ca43c79b183e8d Mon Sep 17 00:00:00 2001 From: Schultheis Date: Thu, 1 Feb 2018 15:50:55 +0100 Subject: [PATCH 13/15] create_heatmap: don't show hideous dendrogram legend (interactive; clustering = column) --- R/function.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/function.R b/R/function.R index 4e417df..28d05c8 100644 --- a/R/function.R +++ b/R/function.R @@ -483,7 +483,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label heatmap_layers = ggplot2::theme(text = ggplot2::element_text(size = 12 * scale)) ) - plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size)) + plot <- plotly::layout(plot, autosize = ifelse(width == "auto", TRUE, FALSE), margin = list(l = rowlabel_size, r = legend, b = collabel_size), showlegend = FALSE) # decide which sizes should be used if(width == "auto") { From a7a1cda935d91986ae5897e1bb5ccc95249ecdfd Mon Sep 17 00:00:00 2001 From: Schultheis Date: Fri, 2 Feb 2018 08:40:27 +0100 Subject: [PATCH 14/15] heatmap: prevent crashing app with try --- R/function.R | 4 ++-- R/heatmap.R | 6 ++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/function.R b/R/function.R index 28d05c8..f7d7ed4 100644 --- a/R/function.R +++ b/R/function.R @@ -572,7 +572,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label row.names(prep.data) <- row.label.strings colnames(prep.data) <- column.label.strings - plot <- ComplexHeatmap::Heatmap( + plot <- try(ComplexHeatmap::Heatmap( prep.data, name = unitlabel, col = colors, @@ -602,7 +602,7 @@ create_heatmap <- function(data, unitlabel='auto', row.label=T, row.custom.label labels_gp = grid::gpar(fontsize = 8 * scale), grid_height = grid::unit(0.15 * scale, "inches") ) - ) + )) #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 diff --git a/R/heatmap.R b/R/heatmap.R index 3f9a1e1..e54854c 100644 --- a/R/heatmap.R +++ b/R/heatmap.R @@ -336,6 +336,12 @@ heatmap <- function(input, output, session, data, types, plot.method = "static", plot <- plot()$plot + # handle error + if(is(plot, "try-error")) { + # TODO add logging + stop("An error occured! Please try a different dataset.") + } + progress$set(1) return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom")) } From 0b80bccdfad754db46e28e5859673652b1c4bfd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jens=20Preu=C3=9Fner?= Date: Tue, 13 Feb 2018 14:11:22 +0100 Subject: [PATCH 15/15] Bumped heatmaply dependency --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4db4708..6e0fa29 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,7 @@ Imports: shiny, rjson, FactoMineR, factoextra, - heatmaply (>= 0.14.0), + heatmaply (>= 0.14.1), shinyBS, shinythemes RoxygenNote: 6.0.1