Add option suppress_default_hovertext for plot_method = "ggplot" (#301)

* Add option suppress_default_hovertext

* Add suppress hovertext arg to ggplot_heatmap

* Style changes and invert if/else

* revert if/else switch

* Try fix for empty text slot with no custom and no default hovertext

* conform if style

* Add Matt Simenc to DESCRIPTION as contributor

* Fix DESCRIPTION, conform style, and improve consistency in logic

* Removed extra paren in DESCRIPTION file

* Added roxygen documentation for suppress_default_hovertext

* Add @param for suppress_default_hovertext to heatmapr

* Added item to roxygen Rd documentation for suppress_default_hovertext and modified param descriptions in R files to match.

* Remove @param for suppress_default_hovertext in heatmapr.R

* Ran roxygenise

---------

Co-authored-by: mcsimenc@gmail.com <mcsimenc@Mathews-MacBook-Air.local>

DESCRIPTION

@@ -8,7 +8,8 @@ Authors@R: c(
     person("Alan", "O'Callaghan", comment = "https://github.com/Alanocallaghan",role = "aut"),
     person("Jonathan", "Sidi", email = "yonis@metrumrg.com", comment = "https://github.com/yonicd",role = "ctb"),
     person("Jaehyun", "Joo", comment = "https://github.com/jaehyunjoo",role = "ctb"),
-    person("Yoav", "Benjamini", email = "ybenja@tau.ac.il",role = "ths"))
+    person("Yoav", "Benjamini", email = "ybenja@tau.ac.il",role = "ths"),
+    person("Mathew", "Simenc", role = "ctb", comment = "https://gitlab.com/mcsimenc, https://github.com/mcsimenc"))
 Description: Create interactive cluster 'heatmaps' that can be saved as a stand-
     alone HTML file, embedded in 'R Markdown' documents or in a 'Shiny' app, and
     available in the 'RStudio' viewer pane. Hover the mouse pointer over a cell to

R/heatmaply.R

@@ -266,6 +266,11 @@
 #' @param custom_hovertext Custom hovertext matrix (the same dimensions as the input).
 #' If plot_method is "plotly" then just this text is displayed; if plot_method
 #' if "ggplot" then it is appended to the existing text.
+#'
+#' @param suppress_default_hovertext Logical indicating whether to hide the 
+#' default hovertext for plot_method = "ggplot" of row, column, value, and Point 
+#' size.
+#'
 #' @param label_format_fun Function to format hovertext (eg,
 #'    \code{function(...) round(..., digits=3)} or
 #'    \code{function(...) format(..., digits=3)}
@@ -427,12 +432,12 @@
 #'
 #'
 #' # Example of removing labels and thus making the plot faster
-#' heatmaply(iris, showticklabels = c(T, F), margins = c(80, 10))
+#' heatmaply(iris, showticklabels = c(TRUE, FALSE), margins = c(80, 10))
 #'
 #' # this is what allows for a much larger matrix to be printed:
 #' set.seed(2017 - 05 - 18)
 #' large_x <- matrix(rnorm(19), 1000, 100)
-#' heatmaply(large_x, dendrogram = F, showticklabels = F, margins = c(1, 1))
+#' heatmaply(large_x, dendrogram = FALSE, showticklabels = FALSE, margins = c(1, 1))
 #' }
 heatmaply <- function(x, ...) {
   UseMethod("heatmaply")
@@ -571,6 +576,7 @@ heatmaply.default <- function(x,
                               label_format_fun = function(...) format(..., digits = 4),
                               labRow = NULL, labCol = NULL,
                               custom_hovertext = NULL,
+                              suppress_default_hovertext = FALSE,
                               col = NULL,
                               dend_hoverinfo = TRUE,
                               side_color_colorbar_len = 0.3,
@@ -642,8 +648,8 @@ heatmaply.default <- function(x,
   if (is.logical(dendrogram)) {
     # Using if and not ifelse to make sure the output is a "scalar".
     dendrogram <- if (dendrogram) "both" else "none"
-    # if(T) "both" else "none"
-    # if(F) "both" else "none"
+    # if (TRUE) "both" else "none"
+    # if (FALSE) "both" else "none"
   }
   dendrogram <- match.arg(dendrogram)
 
@@ -757,6 +763,7 @@ heatmaply.default <- function(x,
     scale = scale,
     na.rm = na.rm,
     custom_hovertext = custom_hovertext,
+    suppress_default_hovertext = suppress_default_hovertext,
     labRow = labRow,
     labCol = labCol,
     ...
@@ -807,6 +814,7 @@ heatmaply.default <- function(x,
     node_type = node_type,
     point_size_name = point_size_name,
     label_format_fun = label_format_fun,
+    suppress_default_hovertext = suppress_default_hovertext,
     dend_hoverinfo = dend_hoverinfo,
     side_color_colorbar_len = side_color_colorbar_len,
     plotly_source = plotly_source,
@@ -887,6 +895,7 @@ heatmaply.heatmapr <- function(x,
                                point_size_name = "Point size",
                                label_format_fun = function(...) format(..., digits = 4),
                                custom_hovertext = x[["matrix"]][["custom_hovertext"]],
+                               suppress_default_hovertext = FALSE,
                                dend_hoverinfo = TRUE,
                                side_color_colorbar_len = 0.3,
                                plotly_source = "A",
@@ -1017,6 +1026,7 @@ heatmaply.heatmapr <- function(x,
       point_size_name = point_size_name,
       label_format_fun = label_format_fun,
       custom_hovertext = custom_hovertext,
+      suppress_default_hovertext = suppress_default_hovertext,
       showticklabels = showticklabels
     )
   } else if (plot_method == "plotly") {
@@ -1208,7 +1218,7 @@ heatmaply.heatmapr <- function(x,
     title = main, # layout's title: /r/reference/#layout-title
     xaxis = list( # layout's xaxis is a named list. List of valid keys: /r/reference/#layout-xaxis
       title = xlab # xaxis's title: /r/reference/#layout-xaxis-title
-      # showgrid = T        # xaxis's showgrid: /r/reference/#layout-xaxis-showgrid
+      # showgrid = TRUE        # xaxis's showgrid: /r/reference/#layout-xaxis-showgrid
     ),
     yaxis = list( # layout's yaxis is a named list. List of valid keys: /r/reference/#layout-yaxis
       title = ylab # yaxis's title: /r/reference/#layout-yaxis-title
@@ -1416,7 +1426,7 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc,
 
   # s <- subplot(plots,
   #   nrows = nrows,
-  #   widths = if(row_dend_left) rev(widths) else widths,
+  #   widths = if (row_dend_left) rev(widths) else widths,
   #   shareX = TRUE, shareY = TRUE,
   #   titleX = titleX, titleY = titleY,
   #   margin = subplot_margin,

R/heatmapr.R

@@ -126,6 +126,7 @@ fix_not_all_unique <- function(x, ...) {
 #' "GW" (Gruvaeus and Wainer heuristic to optimize the Hamiltonian path length that is restricted by the dendrogram structure)
 #' @param point_size_mat A matrix of values which can be mapped to point size
 #' @param custom_hovertext Custom hovertext matrix (the same dimensions as the input).
+#'
 #' @param ... currently ignored
 #'
 #' @export
@@ -232,7 +233,7 @@ heatmapr <- function(x,
   nr <- nrow(x)
   nc <- ncol(x)
   ### TODO: debating if to include this or not:
-  #   if(nr <= 1 || nc <= 1)
+  #   if (nr <= 1 || nc <= 1)
   #     stop("`x' must have at least 2 rows and 2 columns")
 
 
@@ -398,7 +399,7 @@ heatmapr <- function(x,
   # ----------------
   # Due to the internal working of dendextend, in order to use it we first need
   # to populate the dendextend::dendextend_options() space:
-  # if(!missing(k_row) | !missing(k_col))  # Setting k_row and k_col to 1 by default
+  # if (!missing(k_row) | !missing(k_col))  # Setting k_row and k_col to 1 by default
   dendextend::assign_dendextend_options()
 
   if (is.dendrogram(Rowv)) {
@@ -446,7 +447,7 @@ heatmapr <- function(x,
   ## Final touches before exporting the object
   ## =======================
 
-  # if(!is.null(custom_hovertext) && !is.matrix(custom_hovertext)) {
+  # if (!is.null(custom_hovertext) && !is.matrix(custom_hovertext)) {
   if (is.data.frame(custom_hovertext)) {
     custom_hovertext <- as.matrix(custom_hovertext)
   }

R/plots.R

@@ -24,6 +24,7 @@ ggplot_heatmap <- function(xx,
                            point_size_name = "Point size",
                            label_format_fun = function(...) format(..., digits = 4),
                            custom_hovertext = NULL,
+                           suppress_default_hovertext = FALSE,
                            showticklabels = c(TRUE, TRUE),
                            ...) {
   theme_clear_grid_heatmap <- theme(
@@ -60,11 +61,15 @@ ggplot_heatmap <- function(xx,
   col <- label_names[[2]]
   val <- label_names[[3]]
 
-  mdf[["text"]] <- paste0(
-    row, ": ", mdf[[1]], "<br>",
-    col, ": ", mdf[[2]], "<br>",
-    val, ": ", label_format_fun(mdf[[3]])
-  )
+  if (!suppress_default_hovertext) {
+    mdf[["text"]] <- paste0(
+      row, ": ", mdf[[1]], "<br>",
+      col, ": ", mdf[[2]], "<br>",
+      val, ": ", label_format_fun(mdf[[3]])
+    )
+  } else {
+    mdf[["text"]] <- ""
+  }
 
   if (type == "heatmap") {
     geom <- "geom_tile"
@@ -77,10 +82,13 @@ ggplot_heatmap <- function(xx,
     geom <- "geom_point"
     geom_args <- list()
     if (!is.null(point_size_mat)) {
-      mdf[["text"]] <- paste(
-        mdf[["text"]], "<br>",
-        point_size_name, ": ", label_format_fun(mdf[[4]])
-      )
+      if (!suppress_default_hovertext)
+      {
+        mdf[["text"]] <- paste(
+          mdf[["text"]], "<br>",
+          point_size_name, ": ", label_format_fun(mdf[[4]])
+        )
+      }
       aes_mapping <- aes(
         color = .data[[val]],
         text = .data$text,
@@ -95,7 +103,11 @@ ggplot_heatmap <- function(xx,
     }
   }
   if (!is.null(custom_hovertext)) {
-    mdf[["text"]] <- paste0(mdf[["text"]], "<br>", custom_hovertext)
+    if (!suppress_default_hovertext) {
+      mdf[["text"]] <- paste0(mdf[["text"]], "<br>", custom_hovertext)
+    } else {
+      mdf[["text"]] <- reshape2::melt(as.matrix(custom_hovertext))[[3]]
+    }
   }
   geom_args[["mapping"]] <- aes_mapping
 
@@ -467,7 +479,7 @@ ggplot_side_color_plot <- function(df,
   )
 
   ## Don't need this hack any more?
-  # if(original_dim[2] > 1) {
+  # if (original_dim[2] > 1) {
   text_element <- element_text(angle = text_angle, hjust = 1, size = fontsize)
   # } else text_element <- element_blank()
 

R/zzz.R

@@ -250,7 +250,7 @@ heatmaplyWelcomeMessage <- function() {
 # # http://stackoverflow.com/questions/10330425/how-do-i-export-a-git-log-to-a-text-file
 # # http://stackoverflow.com/questions/3523534/good-ways-to-manage-a-changelog-using-git
 # # http://www.commandlinefu.com/commands/view/12420/generate-a-change-log-with-git
-# shell("git log --decorate > ChangeLog", intern = T)
+# shell("git log --decorate > ChangeLog", intern = TRUE)
 
 # Modify it using: http://git-scm.com/book/en/Git-Basics-Viewing-the-Commit-History
 #         http://stackoverflow.com/questions/9007181/custom-log-format-omits-newline-at-end-of-output
@@ -305,6 +305,6 @@ heatmaplyWelcomeMessage <- function() {
 # file.copy("NEWS", "NEWS.md",overwrite = TRUE)
 # devtools::check_win_devel()
 # pkgdown::build_home()
-# pkgdown::build_site(run_dont_run = F)
+# pkgdown::build_site(run_dont_run = FALSE)
 # pkgdown::build_news()
 # release()