talgalili · alanocallaghan · Dec 19, 2017 · Sep 16, 2017 · Sep 16, 2017 · Sep 16, 2017
diff --git a/.gitignore b/.gitignore
@@ -12,3 +12,4 @@ MANIFEST.txt
 test2.rda
 tests/testthat/tmp.*
 tmp*
+\.\.Rcheck
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: heatmaply
 Type: Package
 Title: Interactive Cluster Heat Maps Using 'plotly'
-Version: 0.13.1
+Version: 0.14.0
 Date: 2017-11-27
 Authors@R: c(person("Tal", "Galili", role = c("aut", "cre", "cph"), email =
     "tal.galili@gmail.com", comment = "https://www.r-statistics.com"),
@@ -58,4 +58,4 @@ URL: https://cran.r-project.org/package=heatmaply,
     https://www.r-statistics.com/tag/heatmaply/
 BugReports: https://github.com/talgalili/heatmaply/issues
 LazyData: true
-RoxygenNote: 6.0.1
+RoxygenNote: 6.0.1.9000
diff --git a/NEWS b/NEWS
@@ -1,3 +1,17 @@
+heatmaply 0.14.0 (2017-12-02)
+================
+### NEW FEATURES
+* heatmaply
+  - Add `custom_hovertext` argument, adding custom hovertext option
+  - Add `label_format_fun` argument, which formats text before adding to hovertext
+  - Add `node_type argument, which allows users to plot the heatmap with 
+    discs rather than squares. See also the `point_size_mat` argument.
+  - Add `point_size_mat` argument, which is mapped to point size when
+    `node_type="scatter"`. Also adds `point_size_name` argument, which is the 
+    name of this parameter in the heatmap hovertext.
+
+
+
 heatmaply 0.13.1 (2017-11-27)
 ================
 
@@ -32,22 +46,16 @@ heatmaply 0.13.0 (2017-11-11)
 
 
 
-
-
-
 heatmaply 0.12.1 (2017-10-25)
 ================
-
-
-### NEW FEATURES
-* heatmaply
-  - Add `cellnote_size` argument, controlling the font size of the cellnote.
-
 ### BUG FIXES
 * heatmaply
   - removing tick labels with `showticklabels` now removes the ticks as
     well as the tick labels.
   - Prevent grid_gap warning (#105)
+  - Add `cellnote_size` argument, controlling the font size of the cellnote.
+
+
 * ggplot_heatmap
   - now handles data.frame input
 

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,5 @@
+<<<<<<< HEAD
+=======
 heatmaply 0.13.1 (2017-11-23)
 ================
 
@@ -33,6 +35,7 @@ heatmaply 0.13.0 (2017-11-11)
 
 
 
+>>>>>>> ba5298c685797e7048d61bfbfad6b2f4250e511e
 
 heatmaply 0.12.1 (2017-10-25)
 ================
@@ -56,9 +59,6 @@ heatmaply 0.12.1 (2017-10-25)
 
 
 
-heatmaply 0.11.1 (2017-09-27)
-================
-
 ### NEW FEATURES
 * heatmaply
   - `side_color_layers` argument, which allows the user to pass in ggplot functions which will be

diff --git a/R/heatmaply.R b/R/heatmaply.R
@@ -267,6 +267,22 @@ is.plotly <- function(x) {
 #' Dynamic ticks are useful for updating ticks in response to zoom/pan interactions; however,
 #' they can not always reproduce labels as they would appear in the static ggplot2 image.
 #'
+#' @param node_type For plot_method = "ggplot", should the heatmap be rendered as
+#'  a x-y scatter plot (node_type = "scatter") or a heatmap (node_type = "heatmap").
+#'  Default is node_type = "heatmap".
+#'
+#' @param grid_size When node_type is "scatter", this controls point size. When
+#' node_type is "heatmap", this controls the size of the grid between heatmap cells.
+#'
+#' @param point_size_mat Matrix to map to point size
+#' @param point_size_name Name of point size mapping (for hovertext/legend)
+#' @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 label_format_fun Function to format hovertext (eg,
+#'    \code{function(...) round(..., digits=3)} or
+#'    \code{function(...) format(..., digits=3)}
+#'
 #' @param labRow,labCol character vectors with row and column labels to use; these default to rownames(x) or colnames(x), respectively.
 #' if set to NA, they change the value in showticklabels to be FALSE. This is mainly to keep
 #' backward compatibility with gplots::heatmap.2.
@@ -504,10 +520,7 @@ heatmaply.default <- function(x,
                               row_dend_left = FALSE,
                               margins = c(NA, NA, NA, NA),
                               ...,
-                              scale_fill_gradient_fun = scale_fill_gradientn(
-                                colors = if (is.function(colors)) colors(256) else colors,
-                                na.value = na.value, limits = limits
-                              ),
+                              scale_fill_gradient_fun = NULL,
                               grid_color = NA,
                               grid_gap = 0,
                               srtRow, srtCol,
@@ -545,10 +558,14 @@ heatmaply.default <- function(x,
                               colorbar_ypos = 0,
                               showticklabels = c(TRUE, TRUE),
                               dynamicTicks = FALSE,
-
+                              grid_size = 0.1,
+                              node_type = "heatmap",
+                              point_size_mat = NULL,
+                              point_size_name = "Point size",
+                              label_format_fun = function(...) format(..., digits = 4),
                               labRow, labCol,
-
-                              col) {
+                              custom_hovertext = NULL,
+                              col = NULL) {
   if (!missing(long_data)) {
     if (!missing(x)) {
       warning("x and long_data should not be used together")
@@ -563,7 +580,21 @@ heatmaply.default <- function(x,
   }
 
   # this is to fix the error: "argument * matches multiple formal arguments"
-  if (!missing(col)) colors <- col
+  if (!is.null(col)) colors <- col
+
+  if (is.null(scale_fill_gradient_fun)) {
+    if (node_type == "heatmap") {
+      scale_fill_gradient_fun <- scale_fill_gradientn(
+        colors = if (is.function(colors)) colors(256) else colors,
+        na.value = na.value, limits = limits
+      )
+    } else {
+      scale_fill_gradient_fun <- scale_color_gradientn(
+        colors = if (is.function(colors)) colors(256) else colors,
+        na.value = na.value, limits = limits
+      )
+    }
+  }
 
   plot_method <- match.arg(plot_method)
 
@@ -637,6 +668,7 @@ heatmaply.default <- function(x,
     x,
     row_side_colors = row_side_colors,
     col_side_colors = col_side_colors,
+    point_size_mat = point_size_mat,
     seriate = seriate,
 
     cellnote = cellnote,
@@ -666,6 +698,7 @@ heatmaply.default <- function(x,
     ## data scaling
     scale = scale,
     na.rm = na.rm,
+    custom_hovertext = custom_hovertext,
 
     ...
   )
@@ -708,7 +741,10 @@ heatmaply.default <- function(x,
     colorbar_ypos = colorbar_ypos,
     showticklabels = showticklabels,
     dynamicTicks = dynamicTicks,
-
+    grid_size = grid_size,
+    node_type = node_type,
+    point_size_name = point_size_name,
+    label_format_fun = label_format_fun,
     labRow = labRow, labCol = labCol
   )
 
@@ -779,8 +815,14 @@ heatmaply.heatmapr <- function(x,
                                colorbar_len = 0.3,
                                showticklabels = c(TRUE, TRUE),
                                dynamicTicks = FALSE,
-
+                               node_type = c("scatter", "heatmap"),
+                               grid_size = 0.1,
+                               point_size_mat = x[["matrix"]][["point_size_mat"]],
+                               point_size_name = "Point size",
+                               label_format_fun = function(...) format(..., digits = 4),
+                               custom_hovertext = x[["matrix"]][["custom_hovertext"]],
                                labRow, labCol) {
+  node_type <- match.arg(node_type)
   plot_method <- match.arg(plot_method)
   cellnote_textposition <- match.arg(
     cellnote_textposition,
@@ -791,7 +833,6 @@ heatmaply.heatmapr <- function(x,
     )
   )
 
-
   is.Rgui <- function(...) {
     .Platform$GUI == "Rgui" # if running on MAC OS, this would likely be "AQUA"
   }
@@ -803,7 +844,6 @@ heatmaply.heatmapr <- function(x,
   }
 
 
-
   # informative errors for mis-specified limits
   if (!is.null(limits)) {
     if (!is.numeric(limits)) stop("limits must be numeric")
@@ -916,11 +956,17 @@ heatmaply.heatmapr <- function(x,
       column_text_angle,
       scale_fill_gradient_fun,
       grid_color,
+      grid_size = grid_size,
       key.title = key.title,
       layers = heatmap_layers,
       row_dend_left = row_dend_left,
       label_names = label_names,
-      fontsize_row = fontsize_row, fontsize_col = fontsize_col
+      type = node_type,
+      fontsize_row = fontsize_row, fontsize_col = fontsize_col,
+      point_size_mat = point_size_mat,
+      point_size_name = point_size_name,
+      label_format_fun = label_format_fun,
+      custom_hovertext = custom_hovertext
     )
   } else if (plot_method == "plotly") {
     p <- plotly_heatmap(
@@ -930,7 +976,8 @@ heatmaply.heatmapr <- function(x,
       fontsize_row = fontsize_row, fontsize_col = fontsize_col,
       colorbar_yanchor = colorbar_yanchor, colorbar_xanchor = colorbar_xanchor,
       colorbar_xpos = colorbar_xpos, colorbar_ypos = colorbar_ypos,
-      colorbar_len = colorbar_len
+      colorbar_len = colorbar_len,
+      custom_hovertext = custom_hovertext
     )
   }
 
@@ -1027,7 +1074,8 @@ heatmaply.heatmapr <- function(x,
   ## plotly:
   # turn p, px, and py to plotly objects if necessary
   if (!is.plotly(p)) {
-    p <- ggplotly(p, dynamicTicks = dynamicTicks) %>% layout(showlegend = TRUE)
+    p <- ggplotly(p, dynamicTicks = dynamicTicks, tooltip = "text") %>%
+      layout(showlegend = TRUE)
   }
 
 
@@ -1048,7 +1096,7 @@ heatmaply.heatmapr <- function(x,
     p <- p %>% add_trace(
       y = mdf$row, x = mdf$variable, text = mdf$value,
       type = "scatter", mode = "text", textposition = cellnote_textposition,
-      hoverinfo = "none",
+      hoverinfo = "none", showlegend = FALSE,
       textfont = list(color = plotly::toRGB(cellnote_color), size = cellnote_size)
     )
   }

diff --git a/R/heatmapr.R b/R/heatmapr.R
@@ -97,7 +97,8 @@
 #' "mean" (sorts the matrix based on the reorderfun using marginal means of the matrix. This is the default used by \link[gplots]{heatmap.2}),
 #' "none" (the default order produced by the dendrogram),
 #' "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
@@ -167,9 +168,10 @@ heatmapr <- function(x,
                      row_side_colors,
                      col_side_colors,
                      seriate = c("OLO", "mean", "none", "GW"),
+                     point_size_mat = NULL,
+                     custom_hovertext = NULL,
                      ...) {
 
-
   ## update hclust/dist functions?
   ## ====================
   distfun <- match.fun(distfun)
@@ -378,7 +380,12 @@ heatmapr <- function(x,
   }
   x <- x[rowInd, colInd, drop = FALSE]
   cellnote <- cellnote[rowInd, colInd, drop = FALSE]
-
+  if (!is.null(point_size_mat)) {
+    point_size_mat <- point_size_mat[rowInd, colInd, drop = FALSE]
+  }
+  if (!is.null(custom_hovertext)) {
+    custom_hovertext <- custom_hovertext[rowInd, colInd, drop = FALSE]
+  }
   if (!missing(row_side_colors)) {
     if (!(is.data.frame(row_side_colors) | is.matrix(row_side_colors))) {
       row_side_colors <- data.frame("row_side_colors" = row_side_colors)
@@ -453,7 +460,9 @@ heatmapr <- function(x,
     cellnote = cellnote,
     dim = dim(x),
     rows = rownames(x),
-    cols = colnames(x)
+    cols = colnames(x),
+    point_size_mat = point_size_mat,
+    custom_hovertext = custom_hovertext
   )