Resolve #295

talgalili · Sep 7, 2023 · 17c5526 · 17c5526
1 parent 817b566
commit 17c5526
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: heatmaply
 Type: Package
 Title: Interactive Cluster Heat Maps Using 'plotly' and 'ggplot2'
 Version: 1.4.3
-Date: 2023-07-11
+Date: 2023-09-07
 Authors@R: c(
     person("Tal", "Galili", role = c("aut", "cre", "cph"), email = "tal.galili@gmail.com", comment = "https://www.r-statistics.com"),
     person("Alan", "O'Callaghan", comment = "https://github.com/Alanocallaghan",role = "aut"),

diff --git a/NEWS b/NEWS
@@ -5,6 +5,7 @@ heatmaply 1.4.3 (2023-07-11)
 
 - `width` and `height` arguments now control the size of the output plots, to some extent at least.
 - Improved error message when using `scale` argument with zero variance rows/columns.
+- Add `plotly_source` argument for handling multiple heatmaply instances in a shiny page (see #295)
 
 heatmaply 1.4.2 (2023-01-06)
 ===============

diff --git a/R/heatmaply.R b/R/heatmaply.R
@@ -481,10 +481,6 @@ heatmaply_cor <- function(x,
 
 
 
-
-
-
-
 #' @export
 #' @rdname heatmaply
 heatmaply.default <- function(x,
@@ -576,7 +572,8 @@ heatmaply.default <- function(x,
                               custom_hovertext = NULL,
                               col = NULL,
                               dend_hoverinfo = TRUE,
-                              side_color_colorbar_len = 0.3) {
+                              side_color_colorbar_len = 0.3,
+                              plotly_source = "A") {
   if (!is.null(long_data)) {
     if (!missing(x)) {
       stop("x and long_data should not be used together")
@@ -811,6 +808,7 @@ heatmaply.default <- function(x,
     label_format_fun = label_format_fun,
     dend_hoverinfo = dend_hoverinfo,
     side_color_colorbar_len = side_color_colorbar_len,
+    plotly_source = plotly_source,
     height = height,
     width = width
   )
@@ -890,8 +888,10 @@ heatmaply.heatmapr <- function(x,
                                custom_hovertext = x[["matrix"]][["custom_hovertext"]],
                                dend_hoverinfo = TRUE,
                                side_color_colorbar_len = 0.3,
+                               plotly_source = "A",
                                height = NULL,
                                width = NULL) {
+
   node_type <- match.arg(node_type)
   plot_method <- match.arg(plot_method)
   cellnote_textposition <- match.arg(
@@ -916,8 +916,6 @@ heatmaply.heatmapr <- function(x,
   if (!is.null(srtRow)) row_text_angle <- srtRow
   if (!is.null(srtCol)) column_text_angle <- srtCol
 
-
-
   # x is a heatmapr object.
   # heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, image = imgUri,
   #                  theme = theme, options = options)
@@ -967,7 +965,8 @@ heatmaply.heatmapr <- function(x,
     } else {
       py <- plotly_dend(cols,
         side = "col",
-        dend_hoverinfo = dend_hoverinfo
+        dend_hoverinfo = dend_hoverinfo,
+        plotly_source = plotly_source
       )
     }
   }
@@ -990,7 +989,8 @@ heatmaply.heatmapr <- function(x,
       px <- plotly_dend(rows,
         flip = row_dend_left,
         side = "row",
-        dend_hoverinfo = dend_hoverinfo
+        dend_hoverinfo = dend_hoverinfo,
+        plotly_source = plotly_source
       )
     }
   }
@@ -1036,7 +1036,8 @@ heatmaply.heatmapr <- function(x,
       custom_hovertext = custom_hovertext,
       label_format_fun = label_format_fun,
       height = height,
-      width = width
+      width = width,
+      plotly_source = plotly_source
     )
   }
 
@@ -1072,7 +1073,8 @@ heatmaply.heatmapr <- function(x,
         fontsize = fontsize_col,
         is_colors = !is.null(RowSideColors),
         colorbar_len = side_color_colorbar_len,
-        label_name = label_names[[1]]
+        label_name = label_names[[1]],
+        plotly_source = plotly_source
       )
     }
   }
@@ -1105,7 +1107,8 @@ heatmaply.heatmapr <- function(x,
         fontsize = fontsize_row,
         is_colors = !is.null(ColSideColors),
         colorbar_len = side_color_colorbar_len,
-        label_name = label_names[[2]]
+        label_name = label_names[[2]],
+        plotly_source = plotly_source
       )
     }
   }
@@ -1114,11 +1117,11 @@ heatmaply.heatmapr <- function(x,
     return(list(p = p, px = px, py = py, pr = pr, pc = pc))
   } else {
     if (!is.null(pc)) {
-      pc <- ggplotly(pc)
+      pc <- ggplotly(pc, source = plotly_source)
       pc <- layout(pc, showlegend = TRUE)
     }
     if (!is.null(pr)) {
-      pr <- ggplotly(pr)
+      pr <- ggplotly(pr, source = plotly_source)
       pr <- layout(pr, showlegend = TRUE)
     }
   }
@@ -1131,8 +1134,8 @@ heatmaply.heatmapr <- function(x,
         dynamicTicks = dynamicTicks,
         tooltip = "text",
         height = height,
-        width = width
-      ) %>%
+        width = width,
+        source = plotly_source) %>%
         layout(showlegend = FALSE)
       ## Currently broken, see:
       ##  https://github.com/ropensci/plotly/issues/1701
@@ -1184,14 +1187,16 @@ heatmaply.heatmapr <- function(x,
   if (!is.null(px) && !is.plotly(px)) {
     px <- ggplotly(px,
       tooltip = if (dend_hoverinfo) "y" else "none",
-      dynamicTicks = dynamicTicks
+      dynamicTicks = dynamicTicks,
+      source = plotly_source
     ) %>%
       layout(showlegend = FALSE)
   }
   if (!is.null(py) && !is.plotly(py)) {
     py <- ggplotly(py,
       tooltip = if (dend_hoverinfo) "y" else "none",
-      dynamicTicks = dynamicTicks
+      dynamicTicks = dynamicTicks,
+      source = plotly_source
     ) %>%
       layout(showlegend = FALSE)
   }
@@ -1257,9 +1262,6 @@ heatmaply.heatmapr <- function(x,
           ticklen = 0
         ))
     }
-    # ggplotly() %>%
-    # layout(yaxis = list(tickmode='auto'),
-    #        xaxis = list(tickmode='auto'))
   }
 
   heatmap_subplot <- heatmap_subplot_from_ggplotly(
@@ -1275,7 +1277,8 @@ heatmaply.heatmapr <- function(x,
     pr = pr,
     pc = pc,
     plot_method = plot_method,
-    showticklabels = showticklabels
+    showticklabels = showticklabels,
+    empty = plotly_empty(source = plotly_source)
   )
   l <- layout(
     heatmap_subplot,
@@ -1321,7 +1324,8 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc,
                                           titleX = TRUE, titleY = TRUE,
                                           widths = NULL, heights = NULL,
                                           plot_method,
-                                          showticklabels = c(TRUE, TRUE)) {
+                                          showticklabels = c(TRUE, TRUE),
+                                          empty = plotly_empty(source = "A")) {
   widths <- widths %||% default_dims(px, pr)
   if (row_dend_left) {
     widths <- rev(widths)
@@ -1330,8 +1334,8 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc,
 
 
   # make different plots based on which dendrogram and sidecolors we have
-  row1_list <- list(py, plotly_empty(), plotly_empty())
-  row2_list <- list(pc, plotly_empty(), plotly_empty())
+  row1_list <- list(py, empty, empty)
+  row2_list <- list(pc, empty, empty)
   row3_list <- list(p, pr, px)
 
   if (row_dend_left) {

diff --git a/R/plots.R b/R/plots.R
@@ -35,8 +35,6 @@ ggplot_heatmap <- function(xx,
   )
 
   type <- match.arg(type)
-  # heatmap
-  # xx <- x$matrix$data
 
   df <- xx
   if (!is.data.frame(df)) df <- as.data.frame(df, check.rows = FALSE)
@@ -210,8 +208,8 @@ plotly_heatmap <- function(x,
                            showticklabels = c(TRUE, TRUE),
                            label_format_fun = function(...) format(..., digits = 4),
                            height = NULL,
-                           width = NULL
-                           ) {
+                           width = NULL,
+                           plotly_source = "A") {
   if (is.function(colors)) colors <- colors(256)
 
   if (is.null(label_names)) {
@@ -260,7 +258,8 @@ plotly_heatmap <- function(x,
       hoverinfo = "text",
       zmin = limits[1], zmax = limits[2],
       height = height,
-      width = width
+      width = width,
+      source = plotly_source
     )
   } else {
     melt <- function(x, cn = colnames(x), rn = rownames(x)) {
@@ -282,7 +281,8 @@ plotly_heatmap <- function(x,
       mode = "markers",
       showlegend = FALSE,
       colors = colors,
-      hoverinfo = "text"
+      hoverinfo = "text",
+      source = plotly_source
     )
   }
   p <- p %>%
@@ -322,7 +322,8 @@ plotly_heatmap <- function(x,
 plotly_dend <- function(dend,
                         side = c("row", "col"),
                         flip = FALSE,
-                        dend_hoverinfo = TRUE) {
+                        dend_hoverinfo = TRUE,
+                        plotly_source = "A") {
   if (is.hclust(dend)) {
     dend <- as.dendrogram(dend)
   }
@@ -398,7 +399,7 @@ plotly_dend <- function(dend,
     }
   }
 
-  p <- plot_ly(segs) %>% add_plot_lines()
+  p <- plot_ly(segs, source = plotly_source) %>% add_plot_lines()
 
   if (flip) {
     p <- layout(p, xaxis = list(autorange = "reversed"))
@@ -653,7 +654,8 @@ plotly_side_color_plot <- function(df,
                                    label_name = NULL,
                                    colorbar_len = 0.3,
                                    fontsize = 10,
-                                   show_legend = TRUE) {
+                                   show_legend = TRUE,
+                                   plotly_source = "A") {
   type <- match.arg(type)
 
   if (is.null(label_name)) label_name <- type
@@ -743,7 +745,8 @@ plotly_side_color_plot <- function(df,
       ),
       ticktext = levels,
       len = colorbar_len
-    )
+    ),
+    source = plotly_source
   )
   if (type == "row") {
     p <- p %>% layout(