R/heatmaply.R

In heatmaply: Interactive Cluster Heat Maps Using 'plotly' and 'ggplot2'

#' @title  Cluster heatmap based on plotly
#' @name heatmaply
#'
#' @description
#' An object of class heatmapr includes all the needed information
#' for producing a heatmap. The goal is to separate the pre-processing of the
#' heatmap elements from the graphical rendering of the object, which could be done
#'
#' (Please submit an issue on github if you have a feature that you wish to have added)
#'
#' @param x can either be a heatmapr object, or a numeric matrix
#'   Defaults to \code{TRUE} unless \code{x} contains any \code{NA}s.
#'
#' @param colors,col a vector of colors to use for heatmap color.
#' The default uses
#' \code{\link[viridis]{viridis}(n=256, alpha = 1, begin = 0, end = 1, option = "viridis")}
#' It is passed to \link[ggplot2]{scale_fill_gradientn}.
#' If colors is a color function (with the first argument being `n` = the number of colors),
#' it will be used to create 256 colors from that function.
#' (col is there to stay compatible with \link[gplots]{heatmap.2})
#' @param limits a two dimensional numeric vector specifying the data range for the scale.
#' @param na.value color to use for missing values (default is "grey50").
#'
#' @param row_text_angle numeric (Default is 0), the angle of the text of the
#' rows. (this is called srtRow in \link[gplots]{heatmap.2})
#' @param column_text_angle numeric (Default is 45), the angle of the text of
#' the columns. (this is called srtCol in \link[gplots]{heatmap.2})
#'
#' @param subplot_margin Currently not well implemented. It is passed to
#' \link[plotly]{subplot}. Default is 0. Either a single value or
#'  four values (all between 0 and 1). If four values are provided,
#'  the first is used as the left margin, the second is used as the right margin,
#'  the third is used as the top margin, and the fourth is used as the bottom margin.
#'  If a single value is provided, it will be used as all four margins.
#'
#' @param cellnote Values to be shown as annotations atop the heatmap cells.
#' @param draw_cellnote Should the cellnote annotations be drawn? Defaults is FALSE,
#' if cellnote is not supplied, TRUE if cellnote is supplied. If TRUE and
#' cellnote is not supplied, x will be used for cellnote.
#' @param cellnote_color The color of the cellnote text to be used.
#' @param cellnote_textposition The text positioning/centering of the cellnote.
#' Default is "middle right". Options are
#' "top left", "top center", "top right", "middle left", "middle center",
#' "middle right", "bottom left", "bottom center", "bottom right"
#' @param cellnote_size The font size (HTML/CSS) of the cellnote. Default is 12.
#' @param Rowv determines if and how the row dendrogram should be reordered.
#' By default, it is TRUE, which implies dendrogram is computed and reordered
#' based on row means. If NULL or FALSE, then no dendrogram is computed and
#' no reordering is done. If a \link{dendrogram} (or \link{hclust}),
#' then it is used "as-is", ie without any reordering. If a vector of integers,
#' then dendrogram is computed and reordered based on the order of the vector.
#' @param Colv determines if and how the column dendrogram should be reordered.
#' Has the options as the Rowv argument above and additionally when x is a
#' square matrix, Colv = "Rowv" means that columns should be treated
#' identically to the rows.
#' @param distfun function used to compute the distance (dissimilarity)
#' between both rows and columns. Defaults to dist.
#' The options "pearson", "spearman" and "kendall" can be used to
#' use correlation-based clustering, which uses \code{as.dist(1 - cor(t(x)))}
#' as the distance metric (using the specified correlation method).
#' @param hclustfun function used to compute the hierarchical clustering
#' when Rowv or Colv are not dendrograms. Defaults to hclust.
#'
#' @param dist_method default is NULL (which results in "euclidean" to be used).
#' Can accept alternative character strings indicating the
#' method to be passed to distfun. By default distfun. is \link{dist} hence
#' this can be one of "euclidean", "maximum", "manhattan", "canberra", "binary"
#' or "minkowski".
#' @param hclust_method default is NULL (which results in "complete" to be used).
#' Can accept alternative character strings indicating the
#' method to be passed to hclustfun By default hclustfun is \link{hclust} hence
#' this can be one of "ward.D", "ward.D2", "single", "complete", "average"
#' (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC).
#' Specifying hclust_method=NA causes heatmaply to use
#' \code{\link[dendextend]{find_dend}} to find the "optimal" dendrogram for
#' the data.
#'
#' @param distfun_row distfun for row dendrogram only.
#' @param hclustfun_row hclustfun for col dendrogram only.
#' @param distfun_col distfun for row dendrogram only.
#' @param hclustfun_col hclustfun for col dendrogram only.
#'
#' @param dendrogram character string indicating whether to compute 'none',
#' 'row', 'column' or 'both' dendrograms. Defaults to 'both'.
#' However, if Rowv (or Colv) is FALSE or NULL and dendrogram is 'both',
#' then a warning is issued and Rowv (or Colv) arguments are honoured.
#' It also accepts TRUE/FALSE as synonyms for "both"/"none".
#' @param show_dendrogram Logical vector of length two, controlling whether
#' the row and/or column dendrograms are displayed. If a logical scalar is
#' provided, it is repeated to become a logical vector of length two.
#' @param reorderfun function(d, w) of dendrogram and weights for reordering the
#' row and column dendrograms. The default uses stats{reorder.dendrogram}
#'
#' @param k_row an integer scalar with the desired number of groups by which to
#' color the dendrogram's branches in the rows (uses \link[dendextend]{color_branches})
#' If NA then \link[dendextend]{find_k} is used to deduce the optimal number of clusters.
#' @param k_col an integer scalar with the desired number of groups by which to
#' color the dendrogram's branches in the columns (uses \link[dendextend]{color_branches})
#' If NA then \link[dendextend]{find_k} is used to deduce the optimal number of clusters.
#'
#' @param symm logical indicating if x should be treated symmetrically; can only
#' be true when x is a square matrix.
#' @param revC logical indicating if the column order should be reversed for plotting.
#' Default (when missing) - is FALSE, unless symm is TRUE.
#' This is useful for cor matrix.
#'
#' @param scale character indicating if the values should be centered and scaled
#' in either the row direction or the column direction, or none. The default is
#' "none".
#' @param na.rm logical (default is TRUE) indicating whether NA's should be
#' removed when scaling (i.e.: when using rowMeans/colMeans). Generally it
#' should always be kept as TRUE, and is included here mainly to stay backward
#' compatible with gplots::heatmap.2. This argument does not effect the presence
#' of NA values in the matrix itself. For removing rows/columns with NAs you
#' should pre-process your matrix using na.omit (or some form of imputation).
#'
#' @param row_dend_left logical (default is FALSE). Should the row dendrogram be
#' plotted on the left side of the heatmap. If false then it will be plotted on
#' the right side.
#'
#' @param margins numeric vector of length 4 (default is c(50,50,NA,0))
#' containing the margins (see \link[plotly]{layout}) for column, row and main
#' title names, respectively. The top margin is NA by default. If main==""
#' then the top margin will be set to 0, otherwise it will get 30.
#' For a multiline title a larger default for the 3rd element should be set.
#' The right margin is NA by default, meaning it will be zero if row_dend_left
#' is FALSE, or 100 if row_dend_left is TRUE.
#'
#' @param ... other parameters passed to \link{heatmapr} (currently, various
#' parameters may be ignored.
#'
#' @param scale_fill_gradient_fun A function that creates a smooth gradient for the heatmap.
#' The default uses \link[ggplot2]{scale_fill_gradientn} with the values of colors, limits, and
#' na.value that are supplied by the user. The user can input a customized function, such as
#' \link{scale_color_gradient}() in order to get other results (although the virids default
#' is quite recommended)
#'
#' @param grid_color control the color of the heatmap grid. Default is NA.
#' Value passed to \link[ggplot2]{geom_tile}. Do not use this parameter on
#' larger matrix sizes, as it can dramatically prolong the build time of the heatmap.
#' (another parameter, grid_color, will be added in the future - once it is implemented in plotly)
#' In the meantime it is MUCH better to use the grid_gap argument.
#'
#' @param grid_gap this is a fast alternative to grid_color. The default is 0, but if a larger value
#' is used (for example, 1), then the resulting heatmap will have a white grid which can
#' help identify different cells. This is implemented using \link[plotly]{style} (with xgap and ygap).
#'
#' @param srtRow if supplied, this overrides row_text_angle (this is to stay compatible with \link[gplots]{heatmap.2})
#' @param srtCol if supplied, this overrides column_text_angle (this is to stay compatible with \link[gplots]{heatmap.2})
#'
#' @param xlab A character title for the x axis.
#' @param ylab A character title for the y axis.
#'
#' @param main A character title for the heatmap.
#'
#' @param titleX logical (TRUE). should x-axis titles be retained? (passed to \link[plotly]{subplot}).
#' @param titleY logical (TRUE). should y-axis titles be retained? (passed to \link[plotly]{subplot}).
#'
#'
#' @param hide_colorbar logical (FALSE). If TRUE, then the color bar (i.e.: the legend) is hidden.
#'
#' @param key.title (character) main title of the color key. If set to NULL (default) no title will be plotted.
#'
#' @param return_ppxpy logical (FALSE). If TRUE, then no plotting is done and the p, px and py objects are
#' returned (before turning into plotly objects). This is a temporary option which might be removed in the
#' future just to make it easy to create a ggplot heatmaps.
#'
#' @param row_side_colors,col_side_colors data.frame of factors to produce
#'    row/column side colors in the style of heatmap.2/heatmap.3.
#'    When a data.frame is provided, the column names are used as the label names for each of the newly added row_side_colors.
#'    When a vector is provided it is coerced into a data.frame and the name of the side color will be just row_side_colors.
#'
#' @param row_side_palette,col_side_palette Color palette functions to be
#'    used for row_side_colors and col_side_colors respectively.
#'
#' @param ColSideColors,RowSideColors passed to row_side_colors,col_side_colors in order
#' to keep compatibility with \link[gplots]{heatmap.2}
#'
#' @param plot_method Use "ggplot" or "plotly" to choose which library produces heatmap
#' and dendrogram plots
#' @param seriate character indicating the method of matrix sorting (default: "OLO").
#' Implemented options include:
#' "OLO" (Optimal leaf ordering, optimizes the Hamiltonian path length that is
#' restricted by the dendrogram structure - works in O(n^4) )
#' "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 heatmap_layers ggplot object(s) (eg, list(theme_bw())) to be added to
#'  the heatmap before conversion to a plotly object.
#' @param side_color_layers ggplot2 objects to be added to side color plots,
#'  similar to heatmap_layers.
#' @param dendrogram_layers ggplot2 objects to be added to dendrograms,
#'  similar to heatmap_layers and side_color_layers.
#' @param branches_lwd numeric (default is 0.6). The width of the dendrograms' branches.
#' If NULL then it is ignored. If the "lwd" is already defined in Rowv/Colv then this
#' parameter is ignored (it is checked using \link[dendextend]{has_edgePar}("lwd")).
#'
#'
#' @param file name of the file(s) into which to save the heatmaply output.
#' Should be a character vector of strings ending with ".html" for a dynamic output,
#' or ".png", ".jpeg", ".pdf" for a static output.
#'
#' For example: heatmaply(x, file = "heatmaply_plot.html") or
#' dir.create("folder");
#' heatmaply(x, file = "folder/heatmaply_plot.html")
#'
#' This is based on \link[htmlwidgets]{saveWidget}, and \link[webshot]{webshot} for the static files.
#' For more refined control over the static file output, you should save the heatmaply object using \link[plotly]{export} and pass the
#' arguments you want based on the ones in \link[webshot]{webshot}.
#'
#' Another example: heatmaply(x, file = c("heatmaply_plot.html", "heatmaply_plot.png"))
#' @param width,height The width and height of the output htmlwidget, or the
#' output file if exporting to png/pdf/etc. Presumed to be in pixels, but
#' if a plotly internal function decides it's in other units you may end up
#' with a huge file! Default is 800x500 when exporting to a file, and 100% width
#' as a htmlwidget.
#' @param long_data Data in long format. Replaces x, so both should not be used.
#'  Colnames must be c("name", "variable", "value"). If you do not have a names
#'  column you can simply use a sequence of numbers from 1 to the number of "rows"
#'  in the data.
#'
#' @param label_names Names for labels of x, y and value/fill mouseover.
#' @param fontsize_row,fontsize_col,cexRow,cexCol Font size for row and column labels.
#' @param subplot_widths,subplot_heights The relative widths and heights of each
#'  subplot. The length of these vectors will vary depending on the number of
#'  plots involved.
#'
#' @param colorbar_len The length of the colorbar/color key relative to the total
#' plot height. Only used if plot_method = "plotly"
#'
#' @param colorbar_thickness The thickness (width) of the colorbar/color key
#' in pixels. Only used if plot_method = "plotly".
#'
#' @param colorbar_xanchor,colorbar_yanchor The x and y anchoring points of the
#' colorbar/color legend. Can be "left", "middle" or "right" for colorbar_xanchor,
#' and "top", "middle" or "bottom" for colorbar_yanchor.
#' See \code{\link[plotly]{colorbar}} for more details.
#' @param colorbar_xpos,colorbar_ypos The x and y co-ordinates (in proportion of the plot window)
#' of the colorbar/color legend. See \code{\link[plotly]{colorbar}} for more details.
#'
#' @param showticklabels A logical vector of length two (default is TRUE).
#' If FALSE, then the ticks are removed from the sides of the plot. The first location refers to
#' the x axis and the second to the y axis. If only one value is supplied (TRUE/FALSE) then it is
#' replicated to get to length 2. When using this parameter, it might be worth also adjusting
#' margins.
#' This option should be used when working with medium to large matrix size as it
#' makes the heatmap much faster (and the hover still works).
#'
#' @param dynamicTicks (default: FALSE). passed to \link[plotly]{ggplotly}:
#' should plotly.js dynamically generate axis tick labels?
#' 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.
#' @param dend_hoverinfo Boolean value which controls whether mouseover text
#' is shown for the row and column dendrograms.
#' @param side_color_colorbar_len As with colorbar_len, this controls the
#' length of the colorbar/color key relative to the total plot height.
#' This argument controls the colorbar_len of the side colour plots.
#' Only used if plot_method = "plotly".
#' @param plotly_source See \code{source} argument in \code{\link[plotly]{plot_ly}}
#'
#' @export
#' @examples
#' \dontrun{
#'
#' # mtcars
#' # x <- heatmapr(mtcars)
#' library(heatmaply)
#' heatmaply(iris[, -5], k_row = 3, k_col = 2)
#' heatmaply(cor(iris[, -5]))
#' heatmaply(cor(iris[, -5]), limits = c(-1, 1))
#' heatmaply(mtcars, k_row = 3, k_col = 2)
#' # heatmaply(mtcars, k_row = 3, k_col = 2, grid_color = "white")
#' heatmaply(mtcars, k_row = 3, k_col = 2, grid_gap = 1)
#'
#' # make sure there is enough room for the labels:
#' heatmaply(mtcars, margins = c(40, 130))
#' # this is the same as using:
#' heatmaply(mtcars) %>% layout(margin = list(l = 130, b = 40))
#'
#' # control text angle
#' heatmaply(mtcars, column_text_angle = 90, margins = c(40, 130))
#' # the same as using srtCol:
#' # heatmaply(mtcars, srtCol = 90) %>% layout(margin = list(l = 130, b = 40))
#'
#'
#'
#' x <- mtcars
#' # different colors
#' heatmaply(x, colors = heat.colors(200))
#' # using special scale_fill_gradient_fun colors
#' heatmaply(x, scale_fill_gradient_fun = scale_color_gradient())
#'
#'
#' # We can join two heatmaps together:
#' library(heatmaply)
#' hm1 <- heatmaply(mtcars, margins = c(40, 130))
#' hm2 <- heatmaply(mtcars, scale = "col", margins = c(40, 130))
#' subplot(hm1, hm2, margin = .2)
#'
#' # If we want to share the Y axis, then it is risky to keep any of the dendrograms:
#' library(heatmaply)
#' hm1 <- heatmaply(mtcars, Colv = FALSE, Rowv = FALSE, margins = c(40, 130))
#' hm2 <- heatmaply(mtcars,
#'   scale = "col", Colv = FALSE, Rowv = FALSE,
#'   margins = c(40, 130)
#' )
#' subplot(hm1, hm2, margin = .02, shareY = TRUE)
#'
#'
#' # We can save heatmaply as an HTML file by using:
#' heatmaply(iris[, -5], file = "heatmaply_iris.html")
#' # or a png/pdf/jpeg file using:
#' heatmaply(iris[, -5], file = "heatmaply_iris.png")
#' # or just doing it in one go:
#' heatmaply(iris[, -5], file = c("heatmaply_iris.html", "heatmaply_iris.png"))
#'
#'
#'
#' # If we don't want the HTML to be selfcontained, we can use the following:
#' library(heatmaply)
#' library(htmlwidgets)
#' heatmaply(iris[, -5]) %>%
#'   saveWidget(file = "heatmaply_iris.html", selfcontained = FALSE)
#'
#'
#' # Example for using RowSideColors
#'
#' x <- as.matrix(datasets::mtcars)
#' rc <- colorspace::rainbow_hcl(nrow(x))
#'
#' library(gplots)
#' library(viridis)
#' heatmap.2(x,
#'   trace = "none", col = viridis(100),
#'   RowSideColors = rc
#' )
#'
#' heatmaply(x,
#'   seriate = "mean",
#'   RowSideColors = rc
#' )
#'
#'
#' heatmaply(x[, -c(8, 9)],
#'   seriate = "mean",
#'   col_side_colors = c(rep(0, 5), rep(1, 4)),
#'   row_side_colors = x[, 8:9]
#' )
#' heatmaply(x[, -c(8, 9)],
#'   seriate = "mean",
#'   col_side_colors = data.frame(a = c(rep(0, 5), rep(1, 4))),
#'   row_side_colors = x[, 8:9]
#' )
#'
#'
#' ## Example of using Rowv And Colv for custumized dendrograms.
#'
#'
#' x <- as.matrix(datasets::mtcars)
#'
#' # now let's spice up the dendrograms a bit:
#' library(dendextend)
#'
#' row_dend <- x %>%
#'   dist() %>%
#'   hclust() %>%
#'   as.dendrogram() %>%
#'   set("branches_k_color", k = 3) %>%
#'   set("branches_lwd", 4) %>%
#'   ladderize()
#' #    rotate_DendSer(ser_weight = dist(x))
#' col_dend <- x %>%
#'   t() %>%
#'   dist() %>%
#'   hclust() %>%
#'   as.dendrogram() %>%
#'   set("branches_k_color", k = 2) %>%
#'   set("branches_lwd", 4) %>%
#'   ladderize()
#' #    rotate_DendSer(ser_weight = dist(t(x)))
#'
#' heatmaply(x, Rowv = row_dend, Colv = col_dend)
#'
#'
#' heatmaply(is.na10(airquality))
#' heatmaply(is.na10(airquality), grid_gap = 1)
#'
#' # grid_gap can handle quite large data matrix
#' heatmaply(matrix(1:10000, 100, 100), k_row = 3, k_col = 3, grid_gap = 1)
#'
#' # Examples of playing with font size:
#' heatmaply(mtcars, fontsize_col = 20, fontsize_row = 5, margin = c(100, 90))
#'
#'
#'
#' # Example for using subplot_width/subplot_height
#'
#' heatmaply(percentize(mtcars),
#'   subplot_widths = c(0.6, 0.4),
#'   subplot_heights = c(0.05, 0.95)
#' )
#'
#'
#'
#' # Example of removing labels and thus making the plot faster
#' heatmaply(iris, showticklabels = c(T, F), 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 <- function(x, ...) {
  UseMethod("heatmaply")
}


#' @export
#' @description
#' heatmaply_na is a wrapper for `heatmaply` which comes with defaults that are better
#' for exploring missing value (NA) patterns. Specifically, the grid_gap is set to 1, and the
#' colors include two shades of grey. It also calculates the \link{is.na10} automatically.
#' @rdname heatmaply
#' @examples
#' \dontrun{
#' heatmaply_na(airquality)
#' }
heatmaply_na <- function(x,
                         grid_gap = 1,
                         colors = c("grey80", "grey20"),
                         ...) {
  heatmaply(
    is.na10(x),
    grid_gap = grid_gap,
    colors = colors, ...
  )
}

#' @export
#' @description
#' heatmaply_cor is a wrapper for `heatmaply` which comes with defaults that are better
#' for correlation matrixes. Specifically, the limits are set from -1 to 1, and the color palette is \link{RdBu}.
#' @rdname heatmaply
#' @examples
#' \dontrun{
#' heatmaply_cor(cor(mtcars))
#' }
heatmaply_cor <- function(x,
                          limits = c(-1, 1),
                          colors = cool_warm,
                          ...) {
  heatmaply(
    x,
    limits = limits, # symm = TRUE,
    colors = colors, ...
  )
}



#' @export
#' @rdname heatmaply
heatmaply.default <- function(x,
                              # elements for scale_fill_gradientn
                              colors = viridis(
                                n = 256, alpha = 1, begin = 0,
                                end = 1, option = "viridis"
                              ),
                              limits = NULL,
                              na.value = "grey50",
                              row_text_angle = 0,
                              column_text_angle = 45,
                              subplot_margin = 0,
                              cellnote = NULL,
                              draw_cellnote = !is.null(cellnote),
                              cellnote_color = "auto",
                              cellnote_textposition = "middle right",
                              cellnote_size = 12,
                              ## dendrogram control
                              Rowv = NULL,
                              Colv = NULL,
                              distfun = stats::dist,
                              hclustfun = stats::hclust,
                              dist_method = NULL,
                              hclust_method = NULL,
                              distfun_row = distfun,
                              hclustfun_row = hclustfun,
                              distfun_col = distfun,
                              hclustfun_col = hclustfun,
                              dendrogram = c("both", "row", "column", "none"),
                              show_dendrogram = c(TRUE, TRUE),
                              reorderfun = function(d, w) reorder(d, w),
                              k_row = 1,
                              k_col = 1,
                              symm = FALSE,
                              revC = symm || (is.dendrogram(Colv) & is.dendrogram(Rowv) & identical(Rowv, rev(Colv))),
                              ## data scaling
                              scale = c("none", "row", "column"),
                              na.rm = TRUE,
                              row_dend_left = FALSE,
                              margins = c(NA, NA, NA, NA),
                              ...,
                              scale_fill_gradient_fun = NULL,
                              grid_color = NA,
                              grid_gap = 0,
                              srtRow = NULL, srtCol = NULL,
                              xlab = "", ylab = "",
                              main = "",
                              titleX = TRUE, titleY = TRUE,
                              hide_colorbar = FALSE,
                              key.title = NULL,
                              return_ppxpy = FALSE,
                              row_side_colors = NULL,
                              row_side_palette = NULL,
                              col_side_colors = NULL,
                              col_side_palette = NULL,
                              ColSideColors = NULL,
                              RowSideColors = NULL,
                              seriate = c("OLO", "mean", "none", "GW"),
                              heatmap_layers = NULL,
                              side_color_layers = NULL,
                              dendrogram_layers = NULL,
                              branches_lwd = 0.6,
                              file = NULL,
                              width = NULL,
                              height = NULL,
                              long_data = NULL,
                              plot_method = c("ggplot", "plotly"),
                              label_names = c("row", "column", "value"),
                              fontsize_row = 10,
                              fontsize_col = 10,
                              cexRow = NULL, cexCol = NULL,
                              subplot_widths = NULL,
                              subplot_heights = NULL,
                              colorbar_len = 0.3,
                              colorbar_thickness = 30,
                              colorbar_xanchor = if (row_dend_left) "right" else "left",
                              colorbar_yanchor = "bottom",
                              colorbar_xpos = if (row_dend_left) -0.1 else 1.1,
                              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 = NULL, labCol = NULL,
                              custom_hovertext = NULL,
                              col = NULL,
                              dend_hoverinfo = TRUE,
                              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")
    }
    assert_that(
      ncol(long_data) == 3,
      all(colnames(long_data) == c("name", "variable", "value"))
    )
    x <- reshape2::dcast(long_data, name ~ variable)
    rownames(x) <- x$name
    x$name <- NULL
  }


  # this is to fix the error: "argument * matches multiple formal arguments"
  if (!is.null(col)) colors <- col


  # informative errors for mis-specified limits
  if (!is.null(limits)) {
    if (!is.numeric(limits)) stop("limits must be numeric")
    if (length(limits) != 2L) stop("limits must be of length 2 (i.e.: two dimensional)")

    r <- range(as.matrix(x), na.rm = TRUE)
    limits <- sort(limits)

  
    ## Warn for broken heatmap colors
    if (limits[1] > r[1]) {
      limits[1] <- r[1]
      warning("Lower limit is not <= lowest value in x, min of limits is set to the min of the range (otherwise, colors will be broken!)")
    }
    if (limits[2] < r[2]) {
      limits[2] <- r[2]
      warning("Upper limit is not >= highest value in x, max of limits is set to the max of the range (otherwise, colors will be broken!)")
    }
  }

  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)

  if (plot_method == "ggplot") {

    ## Suppress creation of new graphcis device, but on exit replace it.
    ## TODO: Avoid this or find better method
    old_dev <- options()[["device"]]
    on.exit(options(device = old_dev))
    options(device = names(capabilities()[which(capabilities())])[1])
  }


  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"
  }
  dendrogram <- match.arg(dendrogram)

  if (!(is.data.frame(x) | is.matrix(x))) {
    stop("x must be either a data.frame or a matrix.")
  }

  if (!is.null(srtRow)) {
    row_text_angle <- srtRow
  }
  if (!is.null(srtCol)) {
    column_text_angle <- srtCol
  }
  if (!is.null(ColSideColors)) {
    col_side_colors <- ColSideColors
  }
  if (!is.null(RowSideColors)) {
    row_side_colors <- RowSideColors
  }

  if (!is.null(cexRow)) {
    fontsize_row <- if (is.numeric(cexRow)) cexRow * 10 else cexRow
  }
  if (!is.null(cexCol)) {
    fontsize_col <- if (is.numeric(cexCol)) cexCol * 10 else cexCol
  }

  # TODO: maybe create heatmaply.data.frame heatmaply.matrix instead.
  #       But right now I am not sure this would be needed.
  if (is.data.frame(x)) {
    ss_c_numeric <- sapply(x, is.numeric)
  }
  if (is.matrix(x)) {
    ss_c_numeric <- apply(x, 2, is.numeric)
  }

  # We must have some numeric values to be able to make a heatmap
  if (!any(ss_c_numeric)) {
    stop("heatmaply only works for data.frame/matrix which includes some numeric columns.")
  }

  # If we have non-numeric columns, we should move them to row_side_colors
  # TODO: add a parameter to control removing of non-numeric columns without moving them to row_side_colors
  if (!all(ss_c_numeric)) {
    row_side_colors <- if (is.null(row_side_colors)) {
      data.frame(x[, !ss_c_numeric, drop = FALSE], check.names = FALSE)
    } else {
      data.frame(row_side_colors, x[, !ss_c_numeric, drop = FALSE], check.names = FALSE)
    }
    x <- x[, ss_c_numeric]
  }
  if (!is.null(labRow)) {
    if (all(is.na(labRow))) {
      showticklabels[[2]] <- FALSE
    }
  } else {
    labRow <- rownames(x)
  }
  if (!is.null(labCol)) {
    if (all(is.na(labCol))) {
      showticklabels[[1]] <- FALSE
    }
  } else {
    labCol <- colnames(x)
  }
  if (!is.logical(showticklabels)) {
    stop("showticklabels must be a logical vector of length 2 or 1")
  }
  if (length(showticklabels) == 1) {
    showticklabels <- rep(showticklabels, 2)
  }

  # help dendrogram work again:
  if (dendrogram == "row") Colv <- FALSE
  if (dendrogram == "column") Rowv <- FALSE
  if (dendrogram == "none") Rowv <- Colv <- FALSE

  # this also occurs in heatmapr, so it may be o.k. to remove the following line.
  seriate <- match.arg(seriate)

  if (is.numeric(cellnote_color)) cellnote_color <- grDevices::palette()[cellnote_color]

  hm <- heatmapr(
    x,
    row_side_colors = row_side_colors,
    col_side_colors = col_side_colors,
    point_size_mat = point_size_mat,
    seriate = seriate,
    cellnote = cellnote,

    ## dendrogram control
    Rowv = Rowv,
    Colv = Colv,
    distfun = distfun,
    hclustfun = hclustfun,
    dist_method = dist_method,
    hclust_method = hclust_method,
    distfun_row = distfun_row,
    hclustfun_row = hclustfun_row,
    distfun_col = distfun_col,
    hclustfun_col = hclustfun_col,
    dendrogram = dendrogram,
    show_dendrogram = show_dendrogram,
    reorderfun = reorderfun,
    k_row = k_row,
    k_col = k_col,
    symm = symm,
    revC = revC,

    ## data scaling
    scale = scale,
    na.rm = na.rm,
    custom_hovertext = custom_hovertext,
    labRow = labRow,
    labCol = labCol,
    ...
  )
  hmly <- heatmaply(
    hm,
    colors = colors, limits = limits,
    scale_fill_gradient_fun = scale_fill_gradient_fun,
    grid_color = grid_color,
    grid_gap = grid_gap,
    row_text_angle = row_text_angle,
    column_text_angle = column_text_angle,
    subplot_margin = subplot_margin,
    row_dend_left = row_dend_left,
    xlab = xlab, ylab = ylab, main = main,
    titleX = titleX, titleY = titleY,
    hide_colorbar = hide_colorbar,
    key.title = key.title,
    return_ppxpy = return_ppxpy,
    margins = margins,
    row_side_palette = row_side_palette,
    col_side_palette = col_side_palette,
    heatmap_layers = heatmap_layers,
    side_color_layers = side_color_layers,
    dendrogram_layers = dendrogram_layers,
    ColSideColors = ColSideColors,
    RowSideColors = RowSideColors,
    branches_lwd = branches_lwd,
    label_names = label_names,
    plot_method = plot_method,
    draw_cellnote = draw_cellnote,
    cellnote_textposition = cellnote_textposition,
    cellnote_size = cellnote_size,
    cellnote_color = cellnote_color,
    fontsize_row = fontsize_row,
    fontsize_col = fontsize_col,
    subplot_widths = subplot_widths,
    subplot_heights = subplot_heights,
    colorbar_len = colorbar_len,
    colorbar_thickness = colorbar_thickness,
    colorbar_xanchor = colorbar_xanchor,
    colorbar_yanchor = colorbar_yanchor,
    colorbar_xpos = colorbar_xpos,
    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,
    dend_hoverinfo = dend_hoverinfo,
    side_color_colorbar_len = side_color_colorbar_len,
    plotly_source = plotly_source,
    height = height,
    width = width
  )

  # TODO: think more on what should be passed in "..."


  if (!is.null(file)) {
    hmly_to_file(hmly = hmly, file = file, width = width, height = height)
  }

  hmly
}

#' @export
#' @rdname heatmaply
heatmaply.heatmapr <- function(x,
                               # elements for scale_fill_gradientn
                               colors = viridis(
                                 n = 256, alpha = 1, begin = 0,
                                 end = 1, option = "viridis"
                               ),
                               limits = NULL,
                               na.value = "grey50",
                               row_text_angle = 0,
                               column_text_angle = 45,
                               subplot_margin = 0,
                               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
                               ),
                               grid_color = NA,
                               grid_gap = 0,
                               srtRow = NULL, srtCol = NULL,
                               xlab = "", ylab = "",
                               main = "",
                               titleX = TRUE, titleY = TRUE,
                               hide_colorbar = FALSE,
                               key.title = NULL,
                               return_ppxpy = FALSE,
                               draw_cellnote = FALSE,
                               cellnote_color = "auto",
                               cellnote_textposition = "middle right",
                               cellnote_size = 12,
                               row_side_colors = x[["row_side_colors"]],
                               row_side_palette = NULL,
                               col_side_colors = x[["col_side_colors"]],
                               col_side_palette = NULL,
                               plot_method = c("ggplot", "plotly"),
                               ColSideColors = NULL,
                               RowSideColors = NULL,
                               heatmap_layers = NULL,
                               side_color_layers = NULL,
                               dendrogram_layers = NULL,
                               branches_lwd = 0.6,
                               label_names = c("row", "column", "value"),
                               fontsize_row = 10,
                               fontsize_col = 10,
                               subplot_widths = NULL,
                               subplot_heights = NULL,
                               colorbar_xanchor = if (row_dend_left) "right" else "left",
                               colorbar_yanchor = "bottom",
                               colorbar_xpos = if (row_dend_left) -0.1 else 1.1,
                               colorbar_ypos = 0,
                               colorbar_len = 0.3,
                               colorbar_thickness = 30,
                               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"]],
                               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(
    cellnote_textposition,
    choices = c(
      "top left", "top center", "top right", "middle left",
      "middle center", "middle right", "bottom left", "bottom center",
      "bottom right"
    )
  )

  is.Rgui <- function(...) {
    .Platform$GUI == "Rgui" # if running on MAC OS, this would likely be "AQUA"
  }

  if (is.Rgui()) {
    # print(p) # solves R crashes - not sure why...
    dev.new() # it seems we need just some device to be open...
  }


  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)
  # x <- heatmapr(mtcars)
  # source: http://stackoverflow.com/questions/6528180/ggplot2-plot-without-axes-legends-etc
  theme_clear_grid_dends <- theme(
    axis.line = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.position = "none",
    panel.background = element_blank(),
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    plot.background = element_blank()
  )
  # dendrograms:
  rows <- x$rows
  cols <- x$cols

  if (!is.null(branches_lwd) && branches_lwd != 1) {
    if (is.dendrogram(rows) && !has_edgePar(rows, "lwd")) {
      rows <- set(rows, "branches_lwd", branches_lwd)
    }
    if (is.dendrogram(cols) && !has_edgePar(cols, "lwd")) {
      cols <- set(cols, "branches_lwd", branches_lwd)
    }
  }



  # this is using dendextend
  if (is.null(cols)) {
    py <- NULL
  } else {
    if (plot_method == "ggplot") {
      col_ggdend <- as.ggdend(cols)
      xlims <- c(0.5, nrow(col_ggdend$labels) + 0.5)
      py <- ggplot(cols, labels = FALSE, na.rm = TRUE) +
        theme_bw() +
        coord_cartesian(expand = FALSE, xlim = xlims) +
        theme_clear_grid_dends +
        dendrogram_layers
    } else {
      py <- plotly_dend(cols,
        side = "col",
        dend_hoverinfo = dend_hoverinfo,
        plotly_source = plotly_source
      )
    }
  }
  if (is.null(rows)) {
    px <- NULL
  } else {
    if (plot_method == "ggplot") {
      row_ggdend <- as.ggdend(rows)
      ylims <- c(0.5, nrow(row_ggdend$labels) + 0.5)

      px <- ggplot(row_ggdend, labels = FALSE, na.rm = TRUE) +
        theme_bw() +
        coord_flip(expand = FALSE, xlim = ylims) +
        theme_clear_grid_dends +
        dendrogram_layers
      if (row_dend_left) {
        px <- px + scale_y_reverse()
      }
    } else {
      px <- plotly_dend(rows,
        flip = row_dend_left,
        side = "row",
        dend_hoverinfo = dend_hoverinfo,
        plotly_source = plotly_source
      )
    }
  }
  # create the heatmap
  data_mat <- x$matrix$data

  if (plot_method == "ggplot") {
    p <- ggplot_heatmap(
      data_mat,
      row_text_angle,
      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,
      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,
      showticklabels = showticklabels
    )
  } else if (plot_method == "plotly") {
    p <- plotly_heatmap(
      data_mat,
      limits = limits,
      colors = colors,
      key_title = key.title,
      label_names = label_names,
      row_text_angle = row_text_angle, column_text_angle = column_text_angle,
      fontsize_row = fontsize_row, fontsize_col = fontsize_col,
      colorbar_yanchor = colorbar_yanchor, colorbar_xanchor = colorbar_xanchor,
      colorbar_xpos = colorbar_xpos, colorbar_ypos = colorbar_ypos,
      point_size_mat = point_size_mat,
      point_size_name = point_size_name,
      colorbar_len = colorbar_len,
      colorbar_thickness = colorbar_thickness,
      custom_hovertext = custom_hovertext,
      label_format_fun = label_format_fun,
      height = height,
      width = width,
      plotly_source = plotly_source
    )
  }


  # TODO: Possibly use function to generate all 3 plots to prevent complex logic here
  if (is.null(row_side_colors)) {
    pr <- NULL
  } else {
    side_color_df <- x[["row_side_colors"]]
    if (is.matrix(side_color_df)) side_color_df <- as.data.frame(side_color_df)
    assert_that(
      nrow(side_color_df) == nrow(data_mat),
      is.data.frame(side_color_df)
    )
    ## Just make sure it's character first
    side_color_df[] <- lapply(side_color_df, as.character)
    if (plot_method == "ggplot") {
      pr <- ggplot_side_color_plot(
        side_color_df,
        type = "row",
        text_angle = column_text_angle,
        palette = row_side_palette,
        fontsize = fontsize_col,
        is_colors = !is.null(RowSideColors),
        label_name = label_names[[1]]
      ) + side_color_layers
    } else {
      pr <- plotly_side_color_plot(
        side_color_df,
        type = "row",
        text_angle = column_text_angle,
        palette = row_side_palette,
        fontsize = fontsize_col,
        is_colors = !is.null(RowSideColors),
        colorbar_len = side_color_colorbar_len,
        label_name = label_names[[1]],
        plotly_source = plotly_source
      )
    }
  }

  if (is.null(col_side_colors)) {
    pc <- NULL
  } else {
    side_color_df <- x[["col_side_colors"]]
    if (is.matrix(side_color_df)) side_color_df <- as.data.frame(side_color_df)
    assert_that(
      nrow(side_color_df) == ncol(data_mat),
      is.data.frame(side_color_df)
    )
    if (plot_method == "ggplot") {
      pc <- ggplot_side_color_plot(
        side_color_df,
        type = "column",
        text_angle = row_text_angle,
        palette = col_side_palette,
        is_colors = !is.null(ColSideColors),
        fontsize = fontsize_row,
        label_name = label_names[[2]]
      ) + side_color_layers
    } else {
      pc <- plotly_side_color_plot(
        side_color_df,
        type = "column",
        text_angle = row_text_angle,
        palette = col_side_palette,
        fontsize = fontsize_row,
        is_colors = !is.null(ColSideColors),
        colorbar_len = side_color_colorbar_len,
        label_name = label_names[[2]],
        plotly_source = plotly_source
      )
    }
  }

  if (return_ppxpy) {
    return(list(p = p, px = px, py = py, pr = pr, pc = pc))
  } else {
    if (!is.null(pc)) {
      pc <- ggplotly(pc, source = plotly_source)
      pc <- layout(pc, showlegend = TRUE)
    }
    if (!is.null(pr)) {
      pr <- ggplotly(pr, source = plotly_source)
      pr <- layout(pr, showlegend = TRUE)
    }
  }

  ## plotly:
  # turn p, px, and py to plotly objects if necessary
  if (!is.plotly(p)) {
    p <- ggplotly(
        p,
        dynamicTicks = dynamicTicks,
        tooltip = "text",
        height = height,
        width = width,
        source = plotly_source) %>%
        layout(showlegend = FALSE)
      ## Currently broken, see:
      ##  https://github.com/ropensci/plotly/issues/1701
      # %>%
      # colorbar(
      #   len = colorbar_len,
      #   thickness = colorbar_thickness
      # )
  }

  if (draw_cellnote) {
    ## Predict cell color luminosity based on colorscale
    if (cellnote_color == "auto") {
      cellnote_color <- predict_colors(p, plot_method = plot_method)
    }
    data_mdf <- melt_df(x[["matrix"]][["data"]], label_names)

    cellnote_df <- as.data.frame(x[["matrix"]][["cellnote"]])
    cellnote_df[["_row"]] <- seq_len(nrow(cellnote_df))
    cellnote_mdf <- reshape2::melt(cellnote_df, id.vars = "_row")
    cellnote_mdf[["__data_value"]] <- data_mdf[[label_names[[3]]]]

    ## TODO: Enforce same dimnames to ensure it's not scrambled?
    # cellnote_mdf$variable <- factor(cellnote_mdf$variable, levels = p$x$layout$xaxis$ticktext)
    cellnote_mdf$variable <- as.numeric(as.factor(cellnote_mdf$variable))
    cellnote_mdf$value <- factor(cellnote_mdf$value)

    p <- p %>% add_trace(
      data = cellnote_mdf,
      x = ~variable,
      y = ~`_row`,
      text = ~value,
      customdata = ~`__data_value`,
      inherit = FALSE,
      type = "scatter",
      mode = "text",
      textposition = cellnote_textposition,
      # hoverinfo = "none",
      hovertemplate = paste0(
        label_names[[1]], ": %{y}\n",
        label_names[[2]], ": %{x}\n",
        label_names[[3]], ": %{customdata}<extra></extra>" ## see here for extra tag https://plotly.com/python/reference/#scatter-hovertemplate
      ),
      showlegend = FALSE,
      textfont = list(color = plotly::toRGB(cellnote_color), size = cellnote_size)
    )
  }

  if (!is.null(px) && !is.plotly(px)) {
    px <- ggplotly(px,
      tooltip = if (dend_hoverinfo) "y" else "none",
      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,
      source = plotly_source
    ) %>%
      layout(showlegend = FALSE)
  }

  # https://plot.ly/r/reference/#Layout_and_layout_style_objects
  p <- layout(
    p, # all of layout's properties: /r/reference/#layout
    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
    ),
    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
    )
  )
  if (hide_colorbar) {
    p <- hide_colorbar(p)
  }

  # Adjust top based on whether main is empty or not.
  if (is.na(margins[3])) margins[3] <- ifelse(main == "", 0, 30)

  rn <- c(rownames(data_mat), colnames(x[["col_side_colors"]]))
  min_marg_row <- calc_margin(rn, fontsize = p$x$layout$yaxis$tickfont$size)
  if (row_dend_left && is.na(margins[4])) {
    margins[4] <- min_marg_row
  } else if (!row_dend_left && is.na(margins[2])) {
    margins[2] <- min_marg_row
  }
  if (is.na(margins[1])) {
    cn <- c(colnames(data_mat), colnames(x[["row_side_colors"]]))
    margins[1] <- calc_margin(cn, fontsize = p$x$layout$yaxis$tickfont$size)
  }

  # add a white grid
  if (grid_gap > 0) {
    p <- style(p, xgap = grid_gap, ygap = grid_gap, traces = 1)
    # doesn't seem to work for ggplot2.
    if (plot_method == "plotly") {
      if (!is.null(pr)) {
        pr <- style(pr, ygap = grid_gap)
      }
      if (!is.null(pc)) {
        pc <- style(pc, xgap = grid_gap)
      }
    }
  }


  if (!all(showticklabels)) {
    if (!showticklabels[[1]]) {
      p <- p %>%
        layout(xaxis = list(
          showticklabels = FALSE,
          ticklen = 0
        ))
    }
    if (!showticklabels[[2]]) {
      p <- p %>%
        layout(yaxis = list(
          showticklabels = FALSE,
          ticklen = 0
        ))
    }
  }

  heatmap_subplot <- heatmap_subplot_from_ggplotly(
    p = p,
    px = px,
    py = py,
    row_dend_left = row_dend_left,
    subplot_margin = subplot_margin,
    widths = subplot_widths,
    heights = subplot_heights,
    titleX = titleX,
    titleY = titleY,
    pr = pr,
    pc = pc,
    plot_method = plot_method,
    showticklabels = showticklabels,
    empty = plotly_empty(source = plotly_source)
  )
  l <- layout(
    heatmap_subplot,
    margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4]),
    legend = list(y = 1, yanchor = "top")
  )

  # keep only relevant plotly options
  l <- config(
    l,
    displaylogo = FALSE,
    modeBarButtonsToRemove = c("sendDataToCloud", "select2d", "lasso2d", "autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "sendDataToCloud")
  )

  l
}






default_dims <- function(px, pr) {
  if (!is.null(px)) {
    if (is.null(pr)) {
      widths <- c(0.8, 0.2)
    } else {
      widths <- c(0.7, 0.1, 0.2)
    }
  } else {
    if (is.null(pr)) {
      widths <- 1
    } else {
      widths <- c(0.9, 0.1)
    }
  }
  widths
}


heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc,
                                          row_dend_left = FALSE, subplot_margin = 0,
                                          titleX = TRUE, titleY = TRUE,
                                          widths = NULL, heights = NULL,
                                          plot_method,
                                          showticklabels = c(TRUE, TRUE),
                                          empty = plotly_empty(source = "A")) {
  widths <- widths %||% default_dims(px, pr)
  if (row_dend_left) {
    widths <- rev(widths)
  }
  heights <- heights %||% rev(default_dims(py, pc))


  # make different plots based on which dendrogram and sidecolors we have
  row1_list <- list(py, empty, empty)
  row2_list <- list(pc, empty, empty)
  row3_list <- list(p, pr, px)

  if (row_dend_left) {
    row3_list <- rev(row3_list)
    row2_list <- rev(row2_list)
    row1_list <- rev(row1_list)
  }
  plots <- c(
    row1_list,
    row2_list,
    row3_list
  )

  column_list <- list(py, pc, p)
  ind_null_col <- sapply(column_list, is.null)
  ## number of rows depends on vertically aligned components
  nrows <- sum(!ind_null_col)
  ind_remove_col <- rep(ind_null_col, each = length(plots) / 3)

  ind_null_row <- sapply(row3_list, is.null)
  ind_remove_row <- rep(ind_null_row, length.out = length(plots))

  if (sum(!ind_null_col) != length(heights)) {
    stop(paste(
      "Number of subplot_heights supplied is not correct; should be",
      sum(!ind_null_col), "but is", length(heights)
    ))
  }
  if (sum(!ind_null_row) != length(widths)) {
    stop(paste(
      "Number of subplot_widths supplied is not correct; should be",
      sum(!ind_null_row), "but is", length(widths)
    ))
  }

  ## Remove all null plots
  plots <- plots[!(ind_remove_row | ind_remove_col)]

  ## Interim solution before removing warnings in documented way
  suppressMessages(
    suppressWarnings(
      s <- subplot(
        plots,
        nrows = nrows,
        widths = widths,
        shareX = TRUE,
        shareY = TRUE,
        titleX = titleX,
        titleY = titleY,
        margin = subplot_margin,
        heights = heights
      )
    )
  )

  if (plot_method == "plotly") {
    if (row_dend_left) {
      num_rows <- sum(!ind_null_row)
      str <- ifelse(num_rows > 1, num_rows, "")
      l <- list(
        anchor = paste0("x", str),
        side = "right",
        showticklabels = showticklabels[[2]]
      )
      num_cols <- sum(!ind_null_col)
      if (num_cols == 1) {
        lay <- function(p) layout(p, yaxis = l)
      } else if (num_cols == 2) {
        lay <- function(p) layout(p, yaxis2 = l)
      } else if (num_cols == 3) {
        lay <- function(p) layout(p, yaxis3 = l)
      }
      s <- lay(s)
    }
  }


  # s <- subplot(plots,
  #   nrows = nrows,
  #   widths = if(row_dend_left) rev(widths) else widths,
  #   shareX = TRUE, shareY = TRUE,
  #   titleX = titleX, titleY = titleY,
  #   margin = subplot_margin,
  #   heights = heights)


  return(s)
}


## TODO: Better/safer estimation of total size, or use monospace.
calc_margin <- function(labels, fontsize) {
  max(nchar(labels) * fontsize, na.rm = TRUE) * 0.6
  # http://stackoverflow.com/questions/19113725/what-dependency-between-font-size-and-width-of-char-in-monospace-font
}

#' @title Checks if an object is of class plotly or not.
#' @export
#' @description
#' Helpful for the plot_method in link{heatmaply}.
#'
#' @param x an object to check
#'
#' @return
#' TRUE if the object inherits "plotly" as a class.
#'
is.plotly <- function(x) {
  inherits(x, "plotly")
}