From 15b4c62fefe32ea019e8d14d821f86c50d487621 Mon Sep 17 00:00:00 2001 From: Alanocallaghan Date: Tue, 8 Nov 2016 12:59:31 +0000 Subject: [PATCH 01/46] Update DESCRIPTION --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 77ddfc3..1dbd7bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Version: 0.6.1 Date: 2016-11-08 Authors@R: c(person("Tal", "Galili", role = c("aut", "cre", "cph"), email = "tal.galili@gmail.com", comment = "https://www.r-statistics.com"), - person("Alan", "Ocallaghan", comment = "https://github.com/Alanocallaghan",role = "ctb"), + person("Alan", "O'Callaghan", comment = "https://github.com/Alanocallaghan",role = "ctb"), person("Yoav", "Benjamini", email = "ybenja@tau.ac.il",role = "ths")) Description: Create interactive 'heatmaps' that are usable from the R console, in the 'RStudio' viewer pane, in 'R Markdown' documents, and in 'Shiny' apps. From 9b89411e1834072ddc4126722961ea98e55d71ff Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 23 Nov 2016 09:46:49 +0000 Subject: [PATCH 02/46] tests and add heatmaply class --- DESCRIPTION | 3 ++- R/heatmaply.R | 21 ++++++++++++--------- tests/test_heatmap_subplot_from_ggplotly.R | 1 + tests/test_heatmaply.R | 1 + tests/test_heatmaply_default.R | 1 + tests/test_heatmaply_heatmapr.R | 1 + tests/test_heatmapr.R | 1 + tests/test_sidecolorplot.R | 4 ++++ tests/testthat.R | 4 ++++ 9 files changed, 27 insertions(+), 10 deletions(-) create mode 100644 tests/test_heatmap_subplot_from_ggplotly.R create mode 100644 tests/test_heatmaply.R create mode 100644 tests/test_heatmaply_default.R create mode 100644 tests/test_heatmaply_heatmapr.R create mode 100644 tests/test_heatmapr.R create mode 100644 tests/test_sidecolorplot.R create mode 100644 tests/testthat.R diff --git a/DESCRIPTION b/DESCRIPTION index 39f9c58..76e5f87 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,8 @@ Suggests: rmarkdown, gplots, htmlwidgets, - RColorBrewer + RColorBrewer, + testthat VignetteBuilder: knitr License: GPL-2 | GPL-3 URL: https://cran.r-project.org/package=heatmaply, diff --git a/R/heatmaply.R b/R/heatmaply.R index 7f7aa40..6eb7072 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -424,16 +424,18 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, plots <- plots[!(ind_remove_row | ind_remove_col)] ## Interim solution before removing warnings in documented way - suppressMessages(suppressWarnings( - s <- subplot(plots, - nrows = nrows, - widths = if(row_dend_left) rev(widths) else widths, - heights = heights, - shareX = TRUE, shareY = TRUE, - titleX = titleX, titleY = titleY, - margin = subplot_margin + suppressMessages( + suppressWarnings( + s <- subplot(plots, + nrows = nrows, + widths = if(row_dend_left) rev(widths) else widths, + heights = heights, + shareX = TRUE, shareY = TRUE, + titleX = titleX, titleY = titleY, + margin = subplot_margin ) - )) + ) + ) return(s) } @@ -613,6 +615,7 @@ heatmaply.heatmapr <- function(x, layout(margin = list(l = margins[2], b = margins[1])) # print(l) + class(l) <- c("heatmaply", class(l)) return(l) } diff --git a/tests/test_heatmap_subplot_from_ggplotly.R b/tests/test_heatmap_subplot_from_ggplotly.R new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/tests/test_heatmap_subplot_from_ggplotly.R @@ -0,0 +1 @@ + diff --git a/tests/test_heatmaply.R b/tests/test_heatmaply.R new file mode 100644 index 0000000..51b0e21 --- /dev/null +++ b/tests/test_heatmaply.R @@ -0,0 +1 @@ +expect_that(heatmaply(mtcars), is_a("heatmaply")) diff --git a/tests/test_heatmaply_default.R b/tests/test_heatmaply_default.R new file mode 100644 index 0000000..b303338 --- /dev/null +++ b/tests/test_heatmaply_default.R @@ -0,0 +1 @@ +heatmaply.default \ No newline at end of file diff --git a/tests/test_heatmaply_heatmapr.R b/tests/test_heatmaply_heatmapr.R new file mode 100644 index 0000000..5482108 --- /dev/null +++ b/tests/test_heatmaply_heatmapr.R @@ -0,0 +1 @@ +expect_that(heatmaply.heatmapr(mtcars), is_a("plotly")) \ No newline at end of file diff --git a/tests/test_heatmapr.R b/tests/test_heatmapr.R new file mode 100644 index 0000000..814b68a --- /dev/null +++ b/tests/test_heatmapr.R @@ -0,0 +1 @@ +expect_that(heatmapr(mtcars), is_a("heatmapr")) \ No newline at end of file diff --git a/tests/test_sidecolorplot.R b/tests/test_sidecolorplot.R new file mode 100644 index 0000000..4adfc92 --- /dev/null +++ b/tests/test_sidecolorplot.R @@ -0,0 +1,4 @@ +## Normal +expect_that(side_color_plot(mtcars[,1:2]), ) +## Error +expect_that(side_color_plot(mtcars[, 1]), ) diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..bb209dd --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(heatmaply) + +test_check("heatmaply") From 97a3bf1eb5fdc5b8d93d1baa900f45c93d8dc2d9 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 12:18:06 +0000 Subject: [PATCH 03/46] Add native plotly support --- R/heatmaply.R | 111 ++++++++++++++++++++++++++++++++++++++------------ R/heatmapr.R | 14 +++---- 2 files changed, 92 insertions(+), 33 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 547d5d9..7ebfdaf 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -175,12 +175,14 @@ heatmaply.default <- function(x, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, - row_side_colors = NULL, + row_side_colors, row_side_palette, - col_side_colors = NULL, + col_side_colors, col_side_palette, - heatmap_layers = NULL + heatmap_layers = NULL, + plot_method = c("ggplot", "plotly") ) { + plot_method <- match.arg(plot_method) if(!missing(srtRow)) row_text_angle <- srtRow if(!missing(srtCol)) column_text_angle <- srtCol hm <- heatmapr(x, @@ -204,7 +206,8 @@ heatmaply.default <- function(x, row_side_palette = row_side_palette, col_side_colors = col_side_colors, col_side_palette = col_side_palette, - heatmap_layers = heatmap_layers + heatmap_layers = heatmap_layers, + plot_method = plot_method ) # TODO: think more on what should be passed in "..." } @@ -393,8 +396,11 @@ heatmaply.heatmapr <- function(x, row_side_palette, col_side_colors, col_side_palette, - heatmap_layers + heatmap_layers, + plot_method = c("ggplotly", "plotly") ) { + + plot_method <- match.arg(plot_method) # informative errors for mis-specified limits if(!is.null(limits)) { if(!is.numeric(limits)) stop("limits must be numeric") @@ -422,37 +428,62 @@ heatmaply.heatmapr <- function(x, if(is.null(cols)) { py <- NULL } else { - py <- ggplot(cols, labels = FALSE) + theme_bw() + - coord_cartesian(expand = FALSE) + - theme_clear_grid_dends + if (plot_method == "ggplot") { + py <- ggplot(cols, labels = FALSE) + theme_bw() + + coord_cartesian(expand = FALSE) + + theme_clear_grid_dends + } else { + py <- plotly_dend_col(cols) + } } if(is.null(rows)) { px <- NULL } else { - px <- ggplot(rows, labels = FALSE) + - # coord_cartesian(expand = FALSE) + - coord_flip(expand = FALSE) + theme_bw() + theme_clear_grid_dends - if(row_dend_left) px <- px + scale_y_reverse() + if (plot_method == "ggplot") { + px <- ggplot(rows, labels = FALSE) + + # coord_cartesian(expand = FALSE) + + coord_flip(expand = FALSE) + theme_bw() + theme_clear_grid_dends + if(row_dend_left) px <- px + scale_y_reverse() + } else { + px <- plotly_dend_row(rows, flip = row_dend_left) + } } # create the heatmap data_mat <- x$matrix$data - p <- ggplot_heatmap(data_mat, - row_text_angle, - column_text_angle, - scale_fill_gradient_fun, - grid_color, - key.title = key.title, - layers = heatmap_layers) + + if (plot_method == "ggplot") { + p <- ggplot_heatmap(data_mat, + row_text_angle, + column_text_angle, + scale_fill_gradient_fun, + grid_color, + key.title = key.title, + layers = heatmap_layers) + } else { + p <- plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), + type = "heatmap") %>% + layout( + xaxis = list( + tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat) + ), + yaxis = list( + tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat) + ) + ) + } + if(return_ppxpy) { return(list(p=p, px=px, py=py)) } - if (missing(row_side_colors)) pr <- NULL - else { + if (missing(row_side_colors)) { + pr <- NULL + } else { pr <- side_color_plot(x[["row_side_colors"]], type = "row", palette = row_side_palette) } - if (missing(col_side_colors)) pc <- NULL - else { + if (missing(col_side_colors)) { + pc <- NULL + } else { ## Have to transpose, otherwise it is the wrong orientation side_color_df <- data.frame(t(x[["col_side_colors"]])) @@ -464,9 +495,9 @@ heatmaply.heatmapr <- function(x, ## plotly: # turn p, px, and py to plotly objects - p <- ggplotly(p) - if(!is.null(px)) px <- ggplotly(px, tooltip = "y") - if(!is.null(py)) py <- ggplotly(py, tooltip = "y") + if (!is(p, "plotly")) p <- ggplotly(p) + if(!is.null(px) && !is(px, "plotly")) px <- ggplotly(px, tooltip = "y") + if(!is.null(py) && !is(py, "plotly")) py <- ggplotly(py, tooltip = "y") # https://plot.ly/r/reference/#Layout_and_layout_style_objects p <- layout(p, # all of layout's properties: /r/reference/#layout # title = "unemployment", # layout's title: /r/reference/#layout-title @@ -515,8 +546,36 @@ heatmaply.heatmapr <- function(x, } +plotly_dend_row <- function(dend, flip = FALSE) { + dend_data <- dendro_data(dend) + segs <- dend_data$segment + + p <- plot_ly(segs) %>% + add_segments(x=~y, xend=~yend, y=~x, yend=~xend, + line=list(color='#000000')) %>% + layout( + xaxis = list(title="", linecolor = "#ffffff"), + yaxis = list(range = c(0, max(segs$x) + 1), linecolor = "#ffffff") + ) + if (flip) { + p <- layout(p, xaxis = list(autorange = "reverse")) + } + p +} +plotly_dend_col <- function(dend, flip = FALSE) { + dend_data <- dendro_data(dend) + segs <- dend_data$segment + + plot_ly(segs) %>% + add_segments(x=~x, xend=~xend, y=~y, yend=~yend, + line=list(color='#000000')) %>% + layout( + xaxis = list(range = c(0, max(segs$x) + 1), linecolor = "#ffffff"), + yaxis = list(title="", linecolor = "#ffffff") + ) +} diff --git a/R/heatmapr.R b/R/heatmapr.R index 63183d1..0848734 100644 --- a/R/heatmapr.R +++ b/R/heatmapr.R @@ -136,8 +136,8 @@ heatmapr <- function(x, show_grid = TRUE, anim_duration = 500, - row_side_colors = NULL, - col_side_colors = NULL, + row_side_colors, + col_side_colors, seriate = c("OLO", "mean", "none", "GW"), ... @@ -308,8 +308,8 @@ heatmapr <- function(x, if (!missing(cellnote)) cellnote <- cellnote[rowInd, colInd, drop = FALSE] - if (!is.null(row_side_colors)) row_side_colors <- row_side_colors[rowInd, ] - if (!is.null(col_side_colors)) col_side_colors <- col_side_colors[, colInd] + if (!missing(row_side_colors)) row_side_colors <- row_side_colors[rowInd, ] + if (!missing(col_side_colors)) col_side_colors <- col_side_colors[, colInd] ## Dendrograms - Update the labels and change to dendToTree ##======================= @@ -412,9 +412,9 @@ heatmapr <- function(x, } heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, # image = imgUri, - theme = theme, options = options, - row_side_colors = row_side_colors, - col_side_colors = col_side_colors) + theme = theme, options = options) + if (!missing(row_side_colors)) heatmapr[["row_side_colors"]] <- row_side_colors + if (!missing(col_side_colors)) heatmapr[["col_side_colors"]] <- col_side_colors class(heatmapr) <- "heatmapr" From 519408d4c7a95d650a57931952d93a94aa7ca116 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 13:04:45 +0000 Subject: [PATCH 04/46] Add funtionality to move axis --- R/heatmaply.R | 77 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 59 insertions(+), 18 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 7ebfdaf..2e895bd 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -148,7 +148,8 @@ heatmaply <- function(x, row_side_palette, col_side_colors = NULL, col_side_palette, - heatmap_layers + heatmap_layers, + plot_method ) { UseMethod("heatmaply") } @@ -298,7 +299,8 @@ ggplot_heatmap <- function(xx, heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, row_dend_left, subplot_margin = 0, titleX = TRUE, titleY = TRUE, - widths=NULL, heights=NULL, ...) { + widths=NULL, heights=NULL, + plot_method, ...) { if (is.null(widths)) { if (!is.null(px)) { if (!is.null(pr)) { @@ -349,7 +351,6 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, ## Remove all null plots plots <- plots[!(ind_remove_row | ind_remove_col)] - s <- subplot(plots, nrows = nrows, widths = if(row_dend_left) rev(widths) else widths, @@ -357,6 +358,28 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, titleX = titleX, titleY = titleY, margin = subplot_margin, heights = heights) + + if (plot_method == "plotly") { + if (row_dend_left) { + # sum(!ind_null_col) #y axis number + l <- list( + anchor = paste0("x", sum(!ind_null_row)), + side = "right", + showticklabels=TRUE + ) + 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) + } + } + return(s) } @@ -368,7 +391,6 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, - #' @export heatmaply.heatmapr <- function(x, # elements for scale_fill_gradientn @@ -397,7 +419,7 @@ heatmaply.heatmapr <- function(x, col_side_colors, col_side_palette, heatmap_layers, - plot_method = c("ggplotly", "plotly") + plot_method = c("ggplot", "plotly") ) { plot_method <- match.arg(plot_method) @@ -464,10 +486,12 @@ heatmaply.heatmapr <- function(x, type = "heatmap") %>% layout( xaxis = list( - tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat) + tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), + showticklabels = TRUE ), yaxis = list( - tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat) + tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), + showticklabels = TRUE ) ) } @@ -538,7 +562,7 @@ heatmaply.heatmapr <- function(x, # create the subplot heatmap_subplot <- heatmap_subplot_from_ggplotly(p = p, px = px, py = py, row_dend_left = row_dend_left, subplot_margin = subplot_margin, - titleX = titleX, titleY = titleY, pr = pr, pc = pc) + titleX = titleX, titleY = titleY, pr = pr, pc = pc, plot_method = plot_method) l <- layout(heatmap_subplot, showlegend = FALSE) %>% layout(margin = list(l = margins[2], b = margins[1])) # print(l) @@ -549,17 +573,25 @@ heatmaply.heatmapr <- function(x, plotly_dend_row <- function(dend, flip = FALSE) { dend_data <- dendro_data(dend) segs <- dend_data$segment - p <- plot_ly(segs) %>% - add_segments(x=~y, xend=~yend, y=~x, yend=~xend, - line=list(color='#000000')) %>% + add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, + line=list(color = '#000000')) %>% layout( - xaxis = list(title="", linecolor = "#ffffff"), - yaxis = list(range = c(0, max(segs$x) + 1), linecolor = "#ffffff") + xaxis = list( + title = "", + linecolor = "#ffffff", + showgrid = FALSE + ), + yaxis = list( + title = "", + range = c(0, max(segs$x) + 1), + linecolor = "#ffffff", + showgrid = FALSE + ) ) if (flip) { - p <- layout(p, xaxis = list(autorange = "reverse")) + p <- layout(p, xaxis = list(autorange = "reversed")) } p } @@ -569,11 +601,20 @@ plotly_dend_col <- function(dend, flip = FALSE) { segs <- dend_data$segment plot_ly(segs) %>% - add_segments(x=~x, xend=~xend, y=~y, yend=~yend, - line=list(color='#000000')) %>% + add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, + line = list(color='#000000')) %>% layout( - xaxis = list(range = c(0, max(segs$x) + 1), linecolor = "#ffffff"), - yaxis = list(title="", linecolor = "#ffffff") + xaxis = list( + title = "", + range = c(0, max(segs$x) + 1), + linecolor = "#ffffff", + showgrid = FALSE + ), + yaxis = list( + title = "", + linecolor = "#ffffff", + showgrid = FALSE + ) ) } From 04323185a971ca291dfa23cd8eb1ba54666a0dd6 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 13:23:45 +0000 Subject: [PATCH 05/46] Fix minor error --- R/heatmaply.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index b1fd1db..bb664ac 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -270,9 +270,8 @@ heatmaply.default <- function(x, heatmap_layers = NULL, ColSideColors = NULL, RowSideColors = NULL, - heatmap_layers = NULL, branches_lwd = 0.6, - plot_method = c("ggplot", "plotly") + plot_method = c("ggplot", "plotly"), file ) { plot_method <- match.arg(plot_method) From 3d857ab5774907695f978f205c05edb39b6b6915 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 14:00:26 +0000 Subject: [PATCH 06/46] Fix potential bug --- R/heatmaply.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index bb664ac..30976c4 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -543,9 +543,10 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, if (plot_method == "plotly") { if (row_dend_left) { - # sum(!ind_null_col) #y axis number + num_rows <- sum(!ind_null_row) + str <- ifelse(num_rows > 1, num_rows, "") l <- list( - anchor = paste0("x", sum(!ind_null_row)), + anchor = paste0("x", str), side = "right", showticklabels=TRUE ) From 40a74c77959c21b3d2d20bd59212df4d588ea8bf Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 14:29:11 +0000 Subject: [PATCH 07/46] Fix R CMD check fails --- R/heatmaply.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 30976c4..f85307c 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -99,12 +99,15 @@ #' col_side_colors should be "wide", ie be the same dimensions #' as the column side colors it will produce. #' -#' @param ColSideColors,RowSideColors passed to row_side_colors,col_side_colors in order -#' to keep compatibility with \link[gplots]{heatmap.2} -#' #' @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 heatmap_layers ggplot object (eg, theme_bw()) to be added to #' the heatmap before conversion to a plotly object. #' @@ -267,9 +270,9 @@ heatmaply.default <- function(x, row_side_palette, col_side_colors = NULL, col_side_palette, - heatmap_layers = NULL, ColSideColors = NULL, RowSideColors = NULL, + heatmap_layers = NULL, branches_lwd = 0.6, plot_method = c("ggplot", "plotly"), file From bd5d339dc98ea0668400ae53fac2aa8b6d949d8e Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 14:31:42 +0000 Subject: [PATCH 08/46] Fix CMD check warnings --- R/heatmaply.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index f85307c..1fc834f 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -220,6 +220,7 @@ #' heatmaply(x, Rowv = row_dend, Colv = col_dend) #' #' } +#' @importFrom plotly plot_ly add_segments heatmaply <- function(x, ...) { UseMethod("heatmaply") @@ -730,7 +731,7 @@ heatmaply.heatmapr <- function(x, ## plotly: # turn p, px, and py to plotly objects if necessary - if (!is(p, "plotly")) p <- ggplotly(p) + if (!inherits(p, "plotly")) p <- ggplotly(p) if(!is.null(px) && !is(px, "plotly")) px <- ggplotly(px, tooltip = "y") if(!is.null(py) && !is(py, "plotly")) py <- ggplotly(py, tooltip = "y") @@ -787,7 +788,7 @@ heatmaply.heatmapr <- function(x, plotly_dend_row <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) + dend_data <- dendextend::dendro_data(dend) segs <- dend_data$segment p <- plot_ly(segs) %>% add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, @@ -813,7 +814,7 @@ plotly_dend_row <- function(dend, flip = FALSE) { } plotly_dend_col <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) + dend_data <- dendextend::dendro_data(dend) segs <- dend_data$segment plot_ly(segs) %>% From a1a71a5d0c677254c4f26d10cb7effa2358e01a6 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 14:48:04 +0000 Subject: [PATCH 09/46] Update docs --- NAMESPACE | 2 ++ man/heatmaply.Rd | 9 ++++++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5d5a28a..7bcdfbf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,9 +26,11 @@ importFrom(dendextend,rotate) importFrom(dendextend,seriate_dendrogram) importFrom(dendextend,set) importFrom(htmlwidgets,saveWidget) +importFrom(plotly,add_segments) importFrom(plotly,ggplotly) importFrom(plotly,hide_colorbar) importFrom(plotly,layout) +importFrom(plotly,plot_ly) importFrom(plotly,plotly) importFrom(plotly,plotly_empty) importFrom(plotly,subplot) diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 81456b0..0888243 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -22,7 +22,7 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, row_side_palette, col_side_colors = NULL, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6, file) + branches_lwd = 0.6, plot_method = c("ggplot", "plotly"), file) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -34,8 +34,8 @@ heatmaply(x, ...) main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, row_side_palette, col_side_colors = NULL, col_side_palette, - ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6) + plot_method = c("ggplot", "plotly"), ColSideColors = NULL, + RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix @@ -145,6 +145,9 @@ the heatmap before conversion to a plotly object.} 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")).} +\item{plot_method}{Use "ggplot" or "plotly" to choose which library produces heatmap +and dendrogram plots} + \item{file}{HTML file name to save the heatmaply into. Should be a character string ending with ".html". For example: heatmaply(x, file = "heatmaply_plot.html"). This should not include a directory, only the name of the file. From e5cf94e95ed8529abf3c96f15129b9e6272cce12 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 18 Feb 2017 15:21:25 +0000 Subject: [PATCH 10/46] Fix minor CMD check warning --- R/heatmaply.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 1fc834f..f2ab0f4 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -732,8 +732,8 @@ heatmaply.heatmapr <- function(x, ## plotly: # turn p, px, and py to plotly objects if necessary if (!inherits(p, "plotly")) p <- ggplotly(p) - if(!is.null(px) && !is(px, "plotly")) px <- ggplotly(px, tooltip = "y") - if(!is.null(py) && !is(py, "plotly")) py <- ggplotly(py, tooltip = "y") + if(!is.null(px) && !inherits(px, "plotly")) px <- ggplotly(px, tooltip = "y") + if(!is.null(py) && !inherits(py, "plotly")) py <- ggplotly(py, tooltip = "y") # https://plot.ly/r/reference/#Layout_and_layout_style_objects p <- layout(p, # all of layout's properties: /r/reference/#layout @@ -786,9 +786,9 @@ heatmaply.heatmapr <- function(x, l } - +#' @importFrom dendextend dendro_data plotly_dend_row <- function(dend, flip = FALSE) { - dend_data <- dendextend::dendro_data(dend) + dend_data <- dendro_data(dend) segs <- dend_data$segment p <- plot_ly(segs) %>% add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, @@ -814,7 +814,7 @@ plotly_dend_row <- function(dend, flip = FALSE) { } plotly_dend_col <- function(dend, flip = FALSE) { - dend_data <- dendextend::dendro_data(dend) + dend_data <- dendro_data(dend) segs <- dend_data$segment plot_ly(segs) %>% From 66ba6785c1d4b3efc4df917efaad71abc8381080 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 21:47:22 +0000 Subject: [PATCH 11/46] Test README --- README.md | 87 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 39 deletions(-) diff --git a/README.md b/README.md index 8dbc599..7bd626d 100644 --- a/README.md +++ b/README.md @@ -1,31 +1,32 @@ + + +[![Build Status](https://travis-ci.org/talgalili/heatmaply.png?branch=master)](https://travis-ci.org/talgalili/heatmaply) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/heatmaply)](https://cran.r-project.org/package=heatmaply) -[![Build Status](https://travis-ci.org/talgalili/heatmaply.png?branch=master)](https://travis-ci.org/talgalili/heatmaply) -[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/heatmaply)](https://cran.r-project.org/package=heatmaply) -![](http://cranlogs.r-pkg.org/badges/heatmaply?color=yellow) -![](http://cranlogs.r-pkg.org/badges/grand-total/heatmaply?color=yellowgreen) +![](http://cranlogs.r-pkg.org/badges/heatmaply?color=yellow) ![](http://cranlogs.r-pkg.org/badges/grand-total/heatmaply?color=yellowgreen) -# heatmaply +heatmaply +========= **Table of contents:** -* [Introduction](#introduction) -* [Installation](#installation) -* [Usage](#usage) -* [Credit](#credit) -* [Contact](#contact) +- [Introduction](#introduction) +- [Installation](#installation) +- [Usage](#usage) +- [Credit](#credit) +- [Contact](#contact) - -## Please submit features requests +Please submit features requests +------------------------------- This package is still under active development. If you have features you would like to have added, please submit your suggestions (and bug-reports) at: -## Screenshot demo +Screenshot demo +--------------- ![](http://i.imgur.com/qdUCKlg.gif) - - -## Introduction +Introduction +------------ A heatmap is a popular graphical method for visualizing high-dimensional data, in which a table of numbers are encoded as a grid of colored cells. The rows and columns of the matrix are ordered to highlight patterns and are often accompanied by dendrograms. Heatmaps are used in many fields for visualizing observations, correlations, missing values patterns, and more. @@ -33,18 +34,18 @@ Interactive heatmaps allow the inspection of specific value by hovering the mous This work is based on the ggplot2 and plotly.js engine. It produces similar heatmaps as d3heatmap, with the advatange of speed (plotly.js is able to handle larger size matrix), and the ability to zoom from the dendrogram. - -## Installation +Installation +------------ To install the stable version on CRAN: -```r +``` r install.packages('heatmaply') ``` To install the latest ("cutting-edge") GitHub version run: -```R +``` r # good packages to install for this to work smoothly: @@ -64,46 +65,54 @@ devtools::install_github('talgalili/heatmaply') And then you may load the package using: -```R +``` r library("heatmaply") ``` -## Usage +Usage +----- Quick example: -```r +``` r library(heatmaply) heatmaply(mtcars, k_row = 3, k_col = 2) +#> Warning: No trace type specified and no positional attributes specified +#> No trace type specified: +#> Based on info supplied, a 'scatter' trace seems appropriate. +#> Read more about this trace type -> https://plot.ly/r/reference/#scatter +#> No scatter mode specifed: +#> Setting the mode to markers +#> Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode +#> Warning: Can only have one: config ``` -**For more (interactive) examples see the [online vignette on CRAN](https://CRAN.R-project.org/package=heatmaply/vignettes/heatmaply.html)** - + + + +**For more (interactive) examples see the [online vignette on CRAN](https://CRAN.R-project.org/package=heatmaply/vignettes/heatmaply.html)** -## Credit +Credit +------ This package is thanks to the amazing work done by MANY people in the open source community. Beyond the many people working on the pipeline of R, thanks should go to the plotly team, and especially to Carson Sievert and others working on the R package of plotly. Also, many of the design elements were inspired by the work done on heatmap, heatmap.2 and d3heatmap, so special thanks goes to the R core team, Gregory R. Warnes, and Joe Cheng from RStudio. The dendrogram side of the package is based on the work in dendextend, in which special thanks should go to Andrie de Vries for his original work on bringing dendrograms to ggplot2 (which evolved into the richer ggdend objects, as implemented in dendextend). - -## Contact +Contact +------- You are welcome to: -* submit suggestions and bug-reports at: -* send a pull request on: -* compose a friendly e-mail to: - +- submit suggestions and bug-reports at: +- send a pull request on: +- compose a friendly e-mail to: -## Latest news +Latest news +----------- You can see the most recent changes to the package in the [NEWS.md file](https://github.com/talgalili/heatmaply/blob/master/NEWS.md) - - - - -## Code of conduct +Code of conduct +--------------- Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms. - From 81227ee2dbe1abf866872408579cf44c63ac519d Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 21:48:14 +0000 Subject: [PATCH 12/46] Add tests and change sidecolour interface --- .gitignore | 2 + .travis.yml | 4 +- DESCRIPTION | 7 +- NAMESPACE | 2 + R/heatmaply.R | 68 ++++++------ R/heatmapr.R | 38 +++---- R/percentize.R | 1 - README.md | 87 +++++++-------- man/heatmaply.Rd | 16 +-- man/heatmapr.Rd | 4 +- tests/testthat.R | 4 + tests/testthat/test_heatmaply.R | 186 ++++++++++++++++++++++++++++++++ tests/testthat/test_heatmapr.R | 20 ++++ tests/testthat/test_misc.R | 6 ++ 14 files changed, 333 insertions(+), 112 deletions(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test_heatmaply.R create mode 100644 tests/testthat/test_heatmapr.R create mode 100644 tests/testthat/test_misc.R diff --git a/.gitignore b/.gitignore index 54fb7f9..e40ca94 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ .Rhistory .RData TODO.txt +lib +*.html diff --git a/.travis.yml b/.travis.yml index 17a70b0..3f1d783 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ sudo: required warnings_are_errors: true after_success: - - Rscript -e 'library(covr);codecov()' + - Rscript -e 'library(covr); codecov()' r_github_packages: - - hadley/testthat # for skip_if_not_installed \ No newline at end of file + - hadley/testthat # for skip_if_not_installed diff --git a/DESCRIPTION b/DESCRIPTION index 53f84f2..7004fa9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,12 +36,15 @@ Imports: stats, colorspace, GGally, - htmlwidgets + htmlwidgets, + ggdendro Suggests: knitr, + covr, rmarkdown, gplots, - RColorBrewer + RColorBrewer, + testthat VignetteBuilder: knitr License: GPL-2 | GPL-3 URL: https://cran.r-project.org/package=heatmaply, diff --git a/NAMESPACE b/NAMESPACE index 7bcdfbf..464c460 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ export(percentize) export(side_color_plot) import(dendextend) import(ggplot2) +importFrom(assertthat,assert_that) importFrom(dendextend,color_branches) importFrom(dendextend,find_k) importFrom(dendextend,is.dendrogram) @@ -25,6 +26,7 @@ importFrom(dendextend,is.hclust) importFrom(dendextend,rotate) importFrom(dendextend,seriate_dendrogram) importFrom(dendextend,set) +importFrom(ggdendro,dendro_data) importFrom(htmlwidgets,saveWidget) importFrom(plotly,add_segments) importFrom(plotly,ggplotly) diff --git a/R/heatmaply.R b/R/heatmaply.R index f2ab0f4..178d463 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -221,6 +221,7 @@ #' #' } #' @importFrom plotly plot_ly add_segments +#' @importFrom assertthat assert_that heatmaply <- function(x, ...) { UseMethod("heatmaply") @@ -240,8 +241,8 @@ heatmaply.default <- function(x, subplot_margin = 0, ## dendrogram control - Rowv = TRUE, - Colv = if (symm) "Rowv" else TRUE, + Rowv, + Colv, distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", "column", "none"), @@ -267,12 +268,12 @@ heatmaply.default <- function(x, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, - row_side_colors = NULL, + row_side_colors, row_side_palette, - col_side_colors = NULL, + col_side_colors, col_side_palette, - ColSideColors = NULL, - RowSideColors = NULL, + ColSideColors, + RowSideColors, heatmap_layers = NULL, branches_lwd = 0.6, plot_method = c("ggplot", "plotly"), @@ -289,10 +290,10 @@ heatmaply.default <- function(x, if(!missing(srtRow)) row_text_angle <- srtRow if(!missing(srtCol)) column_text_angle <- srtCol - if (!is.null(ColSideColors)) { + if (!missing(ColSideColors)) { col_side_colors <- ColSideColors } - if (!is.null(RowSideColors)) { + if (!missing(RowSideColors)) { row_side_colors <- RowSideColors } @@ -312,7 +313,7 @@ heatmaply.default <- function(x, # 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)) { + row_side_colors <- if (missing(row_side_colors)) { data.frame(x[, !ss_c_numeric, drop= FALSE]) } else { data.frame(row_side_colors, x[, !ss_c_numeric, drop= FALSE]) @@ -343,7 +344,7 @@ heatmaply.default <- function(x, revC = revC, ...) - hmly <- heatmaply.heatmapr(hm, # colors = colors, limits = limits, + hmly <- heatmaply.heatmapr(hm, colors = colors, limits = limits, scale_fill_gradient_fun = scale_fill_gradient_fun, grid_color = grid_color, row_text_angle = row_text_angle, @@ -399,12 +400,10 @@ ggplot_heatmap <- function(xx, panel.border = element_blank(), panel.background = element_blank()) # heatmap - # xx <- x$matrix$data if(!is.data.frame(df)) df <- as.data.frame(xx) - # colnames(df) <- x$matrix$cols - df$row <- if(!is.null(rownames(xx))) - {rownames(xx)} else - {1:nrow(xx)} + + if(!is.null(rownames(xx))) df$row <- rownames(xx) else df$row <- 1:nrow(xx) + df$row <- with(df, factor(row, levels=row, ordered=TRUE)) mdf <- reshape2::melt(df, id.vars="row") colnames(mdf)[2] <- "column" # rename "variable" @@ -603,13 +602,13 @@ heatmaply.heatmapr <- function(x, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, - row_side_colors = NULL, + row_side_colors, row_side_palette, - col_side_colors = NULL, + col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), - ColSideColors = NULL, - RowSideColors = NULL, + ColSideColors, + RowSideColors, heatmap_layers = NULL, branches_lwd = 0.6 ) { @@ -622,9 +621,10 @@ heatmaply.heatmapr <- function(x, r <- range(x) l <- sort(limits) + ## Warn for broken heatmap colors - if (r[1] < l[1]) warning("Lower limit is not below lowest value in x, colors will be broken!") - if (r[2] > l[2]) warning("Upper limit is not above highest value in x, colors will be broken!") + if (l[1] > r[1]) warning("Lower limit is not <= lowest value in x, colors will be broken!") + if (l[2] < r[2]) warning("Upper limit is not >= highest value in x, colors will be broken!") } if(!missing(srtRow)) row_text_angle <- srtRow if(!missing(srtCol)) column_text_angle <- srtCol @@ -707,26 +707,32 @@ heatmaply.heatmapr <- function(x, if(return_ppxpy) { return(list(p=p, px=px, py=py)) } - if (is.null(row_side_colors)) { + if (missing(row_side_colors)) { pr <- NULL } else { - pr <- side_color_plot(x[["row_side_colors"]], type = "row", - palette = row_side_palette, is_colors = !is.null(RowSideColors)) + side_color_df <- x[["row_side_colors"]] + assert_that( + nrow(side_color_df) == nrow(data_mat), + is.data.frame(side_color_df) + ) + pr <- side_color_plot(side_color_df, type = "row", + palette = row_side_palette, is_colors = !missing(RowSideColors)) } - if (is.null(col_side_colors)) { + if (missing(col_side_colors)) { pc <- NULL } else { - warning("The hover text for col_side_colors is currently not implemented (due to an issue in plotly). We hope this would get resolved in future releases.") - ## Have to transpose, otherwise it is the wrong orientation - side_color_df <- data.frame(t(x[["col_side_colors"]])) - + side_color_df <- x[["col_side_colors"]] + assert_that( + nrow(side_color_df) == ncol(data_mat), + is.data.frame(side_color_df) + ) ## Just make sure it's character first side_color_df[] <- lapply(side_color_df, as.character) pc <- side_color_plot(side_color_df, type = "column", - palette = col_side_palette, is_colors = !is.null(ColSideColors)) + palette = col_side_palette, is_colors = !missing(ColSideColors)) } ## plotly: @@ -786,7 +792,7 @@ heatmaply.heatmapr <- function(x, l } -#' @importFrom dendextend dendro_data +#' @importFrom ggdendro dendro_data plotly_dend_row <- function(dend, flip = FALSE) { dend_data <- dendro_data(dend) segs <- dend_data$segment diff --git a/R/heatmapr.R b/R/heatmapr.R index d81f4c0..e43b874 100644 --- a/R/heatmapr.R +++ b/R/heatmapr.R @@ -103,8 +103,8 @@ heatmapr <- function(x, ## dendrogram control - Rowv = TRUE, - Colv = if (symm) "Rowv" else TRUE, + Rowv, + Colv, distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", "column", "none"), @@ -142,8 +142,8 @@ heatmapr <- function(x, brush_color = "#0000FF", show_grid = TRUE, anim_duration = 500, - row_side_colors = NULL, - col_side_colors = NULL, + row_side_colors, + col_side_colors, seriate = c("OLO", "mean", "none", "GW"), ... ) { @@ -195,10 +195,13 @@ heatmapr <- function(x, Rowv <- dendrogram %in% c("both", "row") } if (missing(Colv)) { - Colv <- dendrogram %in% c("both", "column") + if (dendrogram %in% c("both", "column")) { + Colv <- if (symm) "Rowv" else TRUE + } else { + Colv <- FALSE + } } - # switch("c", # "a" = 4, # "b" = 5, @@ -326,22 +329,20 @@ heatmapr <- function(x, cellnote <- cellnote[rowInd, colInd, drop = FALSE] - if (!is.null(row_side_colors)) { + 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) } - if (dim(row_side_colors)[1] != dim(x)[1]) - stop("row_side_colors and x have different numbers of rows") + assert_that(nrow(row_side_colors) == nrow(x)) row_side_colors <- row_side_colors[rowInd, , drop = FALSE] } - if (!is.null(col_side_colors)) { + if (!missing(col_side_colors)) { if( !(is.data.frame(col_side_colors) | is.matrix(col_side_colors)) ) { - col_side_colors <- matrix(col_side_colors, nrow = 1) - rownames(col_side_colors) <- "col_side_colors" + col_side_colors <- data.frame(col_side_colors) + colnames(col_side_colors) <- "col_side_colors" } - if (dim(col_side_colors)[2] != dim(x)[2]) - stop("col_side_colors and x have different numbers of columns") - col_side_colors <- col_side_colors[, colInd, drop = FALSE] + assert_that(nrow(col_side_colors) == ncol(x)) + col_side_colors <- col_side_colors[colInd, , drop = FALSE] } ## Dendrograms - Update the labels and change to dendToTree @@ -447,9 +448,10 @@ heatmapr <- function(x, } heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, # image = imgUri, - theme = theme, options = options, - row_side_colors = row_side_colors, - col_side_colors = col_side_colors) + theme = theme, options = options) + + if (!missing(row_side_colors)) heatmapr[["row_side_colors"]] <- row_side_colors + if (!missing(col_side_colors)) heatmapr[["col_side_colors"]] <- col_side_colors class(heatmapr) <- "heatmapr" diff --git a/R/percentize.R b/R/percentize.R index 94d72b8..9900207 100644 --- a/R/percentize.R +++ b/R/percentize.R @@ -5,7 +5,6 @@ percentize_predict <- function(x, ecdf_fun = ecdf, ...) { # x must be a data.frame ss_numeric <- sapply(x, is.numeric) - # ecdf_fun <- kCDF_fun # ecdf ecdf_list <- list() diff --git a/README.md b/README.md index 7bd626d..8dbc599 100644 --- a/README.md +++ b/README.md @@ -1,32 +1,31 @@ - - -[![Build Status](https://travis-ci.org/talgalili/heatmaply.png?branch=master)](https://travis-ci.org/talgalili/heatmaply) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/heatmaply)](https://cran.r-project.org/package=heatmaply) -![](http://cranlogs.r-pkg.org/badges/heatmaply?color=yellow) ![](http://cranlogs.r-pkg.org/badges/grand-total/heatmaply?color=yellowgreen) +[![Build Status](https://travis-ci.org/talgalili/heatmaply.png?branch=master)](https://travis-ci.org/talgalili/heatmaply) +[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/heatmaply)](https://cran.r-project.org/package=heatmaply) +![](http://cranlogs.r-pkg.org/badges/heatmaply?color=yellow) +![](http://cranlogs.r-pkg.org/badges/grand-total/heatmaply?color=yellowgreen) -heatmaply -========= +# heatmaply **Table of contents:** -- [Introduction](#introduction) -- [Installation](#installation) -- [Usage](#usage) -- [Credit](#credit) -- [Contact](#contact) +* [Introduction](#introduction) +* [Installation](#installation) +* [Usage](#usage) +* [Credit](#credit) +* [Contact](#contact) -Please submit features requests -------------------------------- + +## Please submit features requests This package is still under active development. If you have features you would like to have added, please submit your suggestions (and bug-reports) at: -Screenshot demo ---------------- +## Screenshot demo ![](http://i.imgur.com/qdUCKlg.gif) -Introduction ------------- + + +## Introduction A heatmap is a popular graphical method for visualizing high-dimensional data, in which a table of numbers are encoded as a grid of colored cells. The rows and columns of the matrix are ordered to highlight patterns and are often accompanied by dendrograms. Heatmaps are used in many fields for visualizing observations, correlations, missing values patterns, and more. @@ -34,18 +33,18 @@ Interactive heatmaps allow the inspection of specific value by hovering the mous This work is based on the ggplot2 and plotly.js engine. It produces similar heatmaps as d3heatmap, with the advatange of speed (plotly.js is able to handle larger size matrix), and the ability to zoom from the dendrogram. -Installation ------------- + +## Installation To install the stable version on CRAN: -``` r +```r install.packages('heatmaply') ``` To install the latest ("cutting-edge") GitHub version run: -``` r +```R # good packages to install for this to work smoothly: @@ -65,54 +64,46 @@ devtools::install_github('talgalili/heatmaply') And then you may load the package using: -``` r +```R library("heatmaply") ``` -Usage ------ +## Usage Quick example: -``` r +```r library(heatmaply) heatmaply(mtcars, k_row = 3, k_col = 2) -#> Warning: No trace type specified and no positional attributes specified -#> No trace type specified: -#> Based on info supplied, a 'scatter' trace seems appropriate. -#> Read more about this trace type -> https://plot.ly/r/reference/#scatter -#> No scatter mode specifed: -#> Setting the mode to markers -#> Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode -#> Warning: Can only have one: config ``` - - - - **For more (interactive) examples see the [online vignette on CRAN](https://CRAN.R-project.org/package=heatmaply/vignettes/heatmaply.html)** -Credit ------- + + +## Credit This package is thanks to the amazing work done by MANY people in the open source community. Beyond the many people working on the pipeline of R, thanks should go to the plotly team, and especially to Carson Sievert and others working on the R package of plotly. Also, many of the design elements were inspired by the work done on heatmap, heatmap.2 and d3heatmap, so special thanks goes to the R core team, Gregory R. Warnes, and Joe Cheng from RStudio. The dendrogram side of the package is based on the work in dendextend, in which special thanks should go to Andrie de Vries for his original work on bringing dendrograms to ggplot2 (which evolved into the richer ggdend objects, as implemented in dendextend). -Contact -------- + +## Contact You are welcome to: -- submit suggestions and bug-reports at: -- send a pull request on: -- compose a friendly e-mail to: +* submit suggestions and bug-reports at: +* send a pull request on: +* compose a friendly e-mail to: + -Latest news ------------ +## Latest news You can see the most recent changes to the package in the [NEWS.md file](https://github.com/talgalili/heatmaply/blob/master/NEWS.md) -Code of conduct ---------------- + + + + +## Code of conduct Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms. + diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 0888243..914aa6b 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -19,10 +19,10 @@ heatmaply(x, ...) (is.function(colors)) colors(256) else colors, na.value = na.value, limits = limits), grid_color = NA, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, - key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, - row_side_palette, col_side_colors = NULL, col_side_palette, - ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6, plot_method = c("ggplot", "plotly"), file) + key.title = NULL, return_ppxpy = FALSE, row_side_colors, row_side_palette, + col_side_colors, col_side_palette, ColSideColors, RowSideColors, + heatmap_layers = NULL, branches_lwd = 0.6, plot_method = c("ggplot", + "plotly"), file) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -32,10 +32,10 @@ heatmaply(x, ...) (is.function(colors)) colors(256) else colors, na.value = na.value, limits = limits), grid_color = NA, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, - key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, - row_side_palette, col_side_colors = NULL, col_side_palette, - plot_method = c("ggplot", "plotly"), ColSideColors = NULL, - RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6) + key.title = NULL, return_ppxpy = FALSE, row_side_colors, row_side_palette, + col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), + ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, + branches_lwd = 0.6) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index d55906e..96e88b9 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -15,8 +15,8 @@ heatmapr(x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, cellnote, cellnote_scale = TRUE, theme = NULL, colors = "RdYlBu", width = NULL, height = NULL, xaxis_height = 80, yaxis_width = 120, xaxis_font_size = NULL, yaxis_font_size = NULL, brush_color = "#0000FF", - show_grid = TRUE, anim_duration = 500, row_side_colors = NULL, - col_side_colors = NULL, seriate = c("OLO", "mean", "none", "GW"), ...) + show_grid = TRUE, anim_duration = 500, row_side_colors, col_side_colors, + seriate = c("OLO", "mean", "none", "GW"), ...) } \arguments{ \item{x}{A numeric matrix diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..bb209dd --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(heatmaply) + +test_check("heatmaply") diff --git a/tests/testthat/test_heatmaply.R b/tests/testthat/test_heatmaply.R new file mode 100644 index 0000000..b6914a3 --- /dev/null +++ b/tests/testthat/test_heatmaply.R @@ -0,0 +1,186 @@ +for (plot_method in c("ggplot", "plotly")) { + for (bool in c(TRUE, FALSE)) { + + context(paste0(plot_method, ", row_dend_left=", bool)) + + test_that("heatmaply mtcars (both dend)", { + h <- heatmaply(mtcars, row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + + }) + + test_that("heatmaply mtcars (no dend)", { + h <- heatmaply(mtcars, dendrogram = "none", row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (coldend only)", { + h <- heatmaply(mtcars, dendrogram = "col", row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rowdend only)", { + h <- heatmaply(mtcars, dendrogram = "row", row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + + test_that("heatmaply mtcars (rscols, both dend)", { + h <- heatmaply(mtcars, + row_side_colors = mtcars[, 1:2], row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + + test_that("heatmaply mtcars (rscols, row dend)", { + h <- heatmaply(mtcars, dendrogram = "none", + row_side_colors = mtcars[, 1:2], + row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rscols, row dend)", { + h <- heatmaply(mtcars, dendrogram = "col", + row_side_colors = mtcars[, 1:2], + row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rscols, no dends)", { + h <- heatmaply(mtcars, dendrogram = "none", + row_side_colors = mtcars[, 1:2], row_dend_left = bool, + plot_method = plot_method) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (cscols, both dend)", { + expect_warning(h <- heatmaply(mtcars, + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (cscols, col dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "col", + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (cscols, row dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "row", + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (cscols, no dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "none", + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rcscols, both dend)", { + expect_warning(h <- heatmaply(mtcars, + row_side_colors = mtcars[, 1:2], + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rcscols, col dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "col", + row_side_colors = mtcars[, 1:2], + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rcscols, row dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "row", + row_side_colors = mtcars[, 1:2], + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + + test_that("heatmaply mtcars (rcscols, no dend)", { + expect_warning(h <- heatmaply(mtcars, dendrogram = "none", + row_side_colors = mtcars[, 1:2], + col_side_colors = data.frame(t(mtcars[1:2, ])), + row_dend_left = bool, + plot_method = plot_method)) + expect_is(h, "plotly") + }) + } +} + + +context("heatmaply misc") + + +test_that("non-numerics moved to row_side_colors", { + mtcars[, ncol(mtcars) + 1] <- "a" + h <- heatmaply(mtcars, row_side_colors = mtcars[, 1:2]) + expect_is(h, "plotly") + h <- heatmaply(mtcars) + expect_is(h, "plotly") +}) + + +test_that("heatmaply on matrix, and cexRow/Col", { + mtcars <- as.matrix(mtcars) + rownames(mtcars) <- NULL + h <- heatmaply(mtcars, cexRow = 5, cexCol = 5) + expect_warning(heatmaply(mtcars, cexRow = "b", cexCol = "a")) + + expect_is(h, "plotly") +}) + + +test_that("grid_color and hide_colorbar", { + h <- heatmaply(mtcars, grid_color = "black", hide_colorbar = TRUE) + expect_is(h, "plotly") +}) + +test_that("return plots", { + h <- heatmaply(mtcars, return_ppxpy = TRUE) + sapply(h, function(el) expect_true(is.null(el) | inherits(el, "gg"))) +}) + +test_that("SideColors", { + rs <- mtcars[, 1] + rscolors <- colorRampPalette(c("red", "blue"))(length(unique(rs))) + rs <- rscolors[as.character(rs)] + h <- heatmaply(mtcars, RowSideColors = rs) + expect_is(h, "plotly") + expect_warning(h <- heatmaply(t(mtcars), ColSideColors = rs)) + expect_is(h, "plotly") +}) + +test_that("limits", { + h <- heatmaply(t(mtcars), limits = range(as.matrix(mtcars))) + expect_is(h, "plotly") + expect_warning(h <- heatmaply(t(mtcars), limits = c(0, 0))) + expect_is(h, "plotly") + expect_warning(h <- heatmaply(t(mtcars), limits = c(0, max(mtcars) + 1))) + expect_is(h, "plotly") + expect_error(heatmaply(t(mtcars), limits = c("a", "b"))) + expect_error(heatmaply(t(mtcars), limits = 1)) +}) + diff --git a/tests/testthat/test_heatmapr.R b/tests/testthat/test_heatmapr.R new file mode 100644 index 0000000..8e0dc1e --- /dev/null +++ b/tests/testthat/test_heatmapr.R @@ -0,0 +1,20 @@ +context("heatmapr") + +test_that("seriate", { + expect_is(heatmapr(mtcars, seriate = "GW"), "heatmapr") +}) + + +test_that("Rowv, Colv", { + expect_is(heatmapr(mtcars, Colv = 1:ncol(mtcars), Rowv = 1:ncol(mtcars)), + "heatmapr") +}) + +test_that("symm, revc", { + expect_is(heatmapr(cor(mtcars), revC = TRUE), "heatmapr") +}) + +test_that("scale", { + expect_is(h1 <- heatmapr(cor(mtcars), scale = "row", symm=TRUE), "heatmapr") + expect_is(h2 <- heatmapr(cor(mtcars), scale = "col", symm=TRUE), "heatmapr") +}) diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R new file mode 100644 index 0000000..ab0b91f --- /dev/null +++ b/tests/testthat/test_misc.R @@ -0,0 +1,6 @@ +context("misc") + +testthat("is.na10", { + tf <- rep(c(TRUE, FALSE), length.out = 10) + expect_equal(is.na10(tf), tf) +}) From 35a2fadf50a884185ccc29aefa6879975a7017e3 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 22:09:03 +0000 Subject: [PATCH 13/46] Add matrix support --- R/heatmaply.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/heatmaply.R b/R/heatmaply.R index 178d463..f815612 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -711,6 +711,7 @@ heatmaply.heatmapr <- function(x, 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) @@ -725,6 +726,7 @@ heatmaply.heatmapr <- function(x, warning("The hover text for col_side_colors is currently not implemented (due to an issue in plotly). We hope this would get resolved in future releases.") 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) From 98979aea0d97f329db96f47c7c263d413649dcff Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 22:26:09 +0000 Subject: [PATCH 14/46] Add import --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7004fa9..3c15710 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,8 @@ Imports: colorspace, GGally, htmlwidgets, - ggdendro + ggdendro, + assertthat Suggests: knitr, covr, From 894f84353ed8a9c450131df032935013120c322f Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 23:02:04 +0000 Subject: [PATCH 15/46] Update docs --- man/heatmaply.Rd | 14 ++++++-------- man/heatmapr.Rd | 14 +++++++------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 914aa6b..a575781 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -10,12 +10,11 @@ heatmaply(x, ...) \method{heatmaply}{default}(x, 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, - Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, distfun = dist, - hclustfun = hclust, dendrogram = c("both", "row", "column", "none"), - reorderfun = function(d, w) reorder(d, w), k_row, k_col, symm = FALSE, - revC, row_dend_left = FALSE, margins = c(50, 50, NA, 0), ..., - scale_fill_gradient_fun = scale_fill_gradientn(colors = if + row_text_angle = 0, column_text_angle = 45, subplot_margin = 0, Rowv, + Colv, distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", + "column", "none"), reorderfun = function(d, w) reorder(d, w), k_row, k_col, + symm = FALSE, revC, row_dend_left = FALSE, margins = c(50, 50, NA, 0), + ..., 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, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, @@ -34,8 +33,7 @@ heatmaply(x, ...) main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, row_side_colors, row_side_palette, col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), - ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6) + ColSideColors, RowSideColors, heatmap_layers = NULL, branches_lwd = 0.6) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index 96e88b9..92beaab 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -7,13 +7,13 @@ The interface was designed based on \link{heatmap}, \link[gplots]{heatmap.2}, and \link[d3heatmap]{d3heatmap}. } \usage{ -heatmapr(x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, - distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", - "column", "none"), reorderfun = function(d, w) reorder(d, w), k_row, k_col, - symm = FALSE, revC, scale = c("none", "row", "column"), na.rm = TRUE, - labRow = rownames(x), labCol = colnames(x), cexRow, cexCol, digits = 3L, - cellnote, cellnote_scale = TRUE, theme = NULL, colors = "RdYlBu", - width = NULL, height = NULL, xaxis_height = 80, yaxis_width = 120, +heatmapr(x, Rowv, Colv, distfun = dist, hclustfun = hclust, + dendrogram = c("both", "row", "column", "none"), reorderfun = function(d, + w) reorder(d, w), k_row, k_col, symm = FALSE, revC, scale = c("none", + "row", "column"), na.rm = TRUE, labRow = rownames(x), + labCol = colnames(x), cexRow, cexCol, digits = 3L, cellnote, + cellnote_scale = TRUE, theme = NULL, colors = "RdYlBu", width = NULL, + height = NULL, xaxis_height = 80, yaxis_width = 120, xaxis_font_size = NULL, yaxis_font_size = NULL, brush_color = "#0000FF", show_grid = TRUE, anim_duration = 500, row_side_colors, col_side_colors, seriate = c("OLO", "mean", "none", "GW"), ...) From e07656045df2fcc90d526c505df175aac32caf39 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Feb 2017 23:25:21 +0000 Subject: [PATCH 16/46] Stupid typo --- tests/testthat/test_misc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R index ab0b91f..a60090c 100644 --- a/tests/testthat/test_misc.R +++ b/tests/testthat/test_misc.R @@ -1,6 +1,6 @@ context("misc") -testthat("is.na10", { +test_that("is.na10", { tf <- rep(c(TRUE, FALSE), length.out = 10) expect_equal(is.na10(tf), tf) }) From 80798a8f9d838b2773510a2a961373ed2a5b476a Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Thu, 23 Feb 2017 00:00:40 +0000 Subject: [PATCH 17/46] Bugfix and fix tests --- R/heatmaply.R | 2 +- tests/testthat/test_heatmaply.R | 2 -- tests/testthat/test_misc.R | 4 ++-- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index f815612..452b4d7 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -619,7 +619,7 @@ heatmaply.heatmapr <- function(x, 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(x) + r <- range(as.matrix(x$matrix$data)) l <- sort(limits) ## Warn for broken heatmap colors diff --git a/tests/testthat/test_heatmaply.R b/tests/testthat/test_heatmaply.R index b6914a3..20bb967 100644 --- a/tests/testthat/test_heatmaply.R +++ b/tests/testthat/test_heatmaply.R @@ -178,8 +178,6 @@ test_that("limits", { expect_is(h, "plotly") expect_warning(h <- heatmaply(t(mtcars), limits = c(0, 0))) expect_is(h, "plotly") - expect_warning(h <- heatmaply(t(mtcars), limits = c(0, max(mtcars) + 1))) - expect_is(h, "plotly") expect_error(heatmaply(t(mtcars), limits = c("a", "b"))) expect_error(heatmaply(t(mtcars), limits = 1)) }) diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R index a60090c..9b48345 100644 --- a/tests/testthat/test_misc.R +++ b/tests/testthat/test_misc.R @@ -1,6 +1,6 @@ context("misc") test_that("is.na10", { - tf <- rep(c(TRUE, FALSE), length.out = 10) - expect_equal(is.na10(tf), tf) + tf <- rep(c(NA, FALSE), length.out = 10) + expect_equal(is.na10(tf), as.integer(is.na(tf))) }) From f786627d0228eb08597534ae0c3dc7c657f66a72 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sun, 26 Feb 2017 15:38:40 +0000 Subject: [PATCH 18/46] Update vignette --- vignettes/.build.timestamp | 0 vignettes/heatmaply.R | 30 +++++++++++ vignettes/heatmaply.md | 106 +++++++++++++++++++++++++++++++++++++ 3 files changed, 136 insertions(+) create mode 100644 vignettes/.build.timestamp create mode 100644 vignettes/heatmaply.R create mode 100644 vignettes/heatmaply.md diff --git a/vignettes/.build.timestamp b/vignettes/.build.timestamp new file mode 100644 index 0000000..e69de29 diff --git a/vignettes/heatmaply.R b/vignettes/heatmaply.R new file mode 100644 index 0000000..7b64ddb --- /dev/null +++ b/vignettes/heatmaply.R @@ -0,0 +1,30 @@ +## ---- echo = FALSE, message = FALSE-------------------------------------- +library(heatmaply) +library(knitr) +knitr::opts_chunk$set( + # cache = TRUE, + dpi = 60, + comment = "#>", + tidy = FALSE) + +# http://stackoverflow.com/questions/24091735/why-pandoc-does-not-retrieve-the-image-file +# < ! -- rmarkdown v1 --> + + +## ---- eval = FALSE------------------------------------------------------- +# install.packages('heatmaply') + +## ---- eval = FALSE------------------------------------------------------- +# # You'll need devtools +# install.packages.2 <- function (pkg) if (!require(pkg)) install.packages(pkg); +# install.packages.2('devtools') +# # make sure you have Rtools installed first! if not, then run: +# #install.packages('installr'); install.Rtools() +# +# devtools::install_github("ropensci/plotly") +# devtools::install_github('talgalili/heatmaply') +# + +## ------------------------------------------------------------------------ +library("heatmaply") + diff --git a/vignettes/heatmaply.md b/vignettes/heatmaply.md new file mode 100644 index 0000000..8ed898a --- /dev/null +++ b/vignettes/heatmaply.md @@ -0,0 +1,106 @@ +--- +title: "Introduction to heatmaply" +date: "2017-02-22" +author: "Tal Galili" +output: + html_document: + self_contained: yes + toc: true +--- + + + + + + +**Author**: [Tal Galili](http://www.r-statistics.com/) ( Tal.Galili@gmail.com ) + + + +Introduction +============ + +A heatmap is a popular graphical method for visualizing high-dimensional data, in which a table of numbers are encoded as a grid of colored cells. The rows and columns of the matrix are ordered to highlight patterns and are often accompanied by dendrograms. Heatmaps are used in many fields for visualizing observations, correlations, missing values patterns, and more. + +Interactive heatmaps allow the inspection of specific value by hovering the mouse over a cell, as well as zooming into a region of the heatmap by draging a rectangle around the relevant area. + +This work is based on the ggplot2 and plotly.js engine. It produces similar heatmaps as d3heatmap, with the advantage of speed (plotly.js is able to handle larger size matrix), and the ability to zoom from the dendrogram. + + +Installation +============ + +To install the stable version on CRAN: + + +```r +install.packages('heatmaply') +``` + +To install the GitHub version: + + +```r +# You'll need devtools +install.packages.2 <- function (pkg) if (!require(pkg)) install.packages(pkg); +install.packages.2('devtools') +# make sure you have Rtools installed first! if not, then run: +#install.packages('installr'); install.Rtools() + +devtools::install_github("ropensci/plotly") +devtools::install_github('talgalili/heatmaply') +``` + + +And then you may load the package using: + + +```r +library("heatmaply") +``` + +Usage +====== + + +Default +------------- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 2332b820c5d21d9639e3dcd0785004bef2e3e505 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 8 Mar 2017 01:38:58 +0000 Subject: [PATCH 19/46] Begin to fix legend issue --- R/heatmaply.R | 59 +++++++++++++++++++++------------------------------ 1 file changed, 24 insertions(+), 35 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 452b4d7..c23c71f 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -691,7 +691,7 @@ heatmaply.heatmapr <- function(x, row_dend_left = row_dend_left) } else { p <- plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), - type = "heatmap") %>% + type = "heatmap", showlegend = FALSE) %>% layout( xaxis = list( tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), @@ -701,12 +701,9 @@ heatmaply.heatmapr <- function(x, tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), showticklabels = TRUE ) - ) + ) %>% colorbar(len=0.2, y = 3) } - if(return_ppxpy) { - return(list(p=p, px=px, py=py)) - } if (missing(row_side_colors)) { pr <- NULL } else { @@ -737,11 +734,22 @@ heatmaply.heatmapr <- function(x, palette = col_side_palette, is_colors = !missing(ColSideColors)) } + if(return_ppxpy) { + return(list(p=p, px=px, py=py, pr=pr, pc=pc)) + } + ## plotly: # turn p, px, and py to plotly objects if necessary if (!inherits(p, "plotly")) p <- ggplotly(p) - if(!is.null(px) && !inherits(px, "plotly")) px <- ggplotly(px, tooltip = "y") - if(!is.null(py) && !inherits(py, "plotly")) py <- ggplotly(py, tooltip = "y") + if(!is.null(px) && !inherits(px, "plotly")) { + px <- ggplotly(px, tooltip = "y") %>% + layout(showlegend=FALSE) + } + if(!is.null(py) && !inherits(py, "plotly")) { + py <- ggplotly(py, tooltip = "y") %>% + layout(showlegend=FALSE) + } + # https://plot.ly/r/reference/#Layout_and_layout_style_objects p <- layout(p, # all of layout's properties: /r/reference/#layout @@ -757,30 +765,9 @@ heatmaply.heatmapr <- function(x, p <- hide_colorbar(p) # px <- hide_colorbar(px) # py <- hide_colorbar(py) - } - # TODO: this doesn't work because of the allignment. But using this might - # speedup the code to deal with MUCH larger matrices. - # p <- plot_ly(z = xx, type = "heatmap") - # p <- plot_ly(z = xx, type = "heatmap") - # ggplotly(p) # works great - # source for: theme(axis.text.x = element_text(angle = column_text_angle, hjust = 1)) - # http://stackoverflow.com/questions/1330989/rotating-and-spacing-axis-labels-in-ggplot2 - # if(row_dend_left) p <- p + scale_y_reverse() - # # hide axis ticks and grid lines - # eaxis <- list( - # showticklabels = FALSE, - # showgrid = FALSE, - # zeroline = FALSE - # ) - # p_empty <- plot_ly() %>% - # # note that margin applies to entire plot, so we can - # # add it here to make tick labels more readable - # layout(margin = list(l = 200), - # xaxis = eaxis, - # yaxis = eaxis) + } + top_corner <- plotly_empty() - # top_corner <- ggplotly(qplot(as.numeric(xx), geom="histogram")) - # create the subplot # Adjust top based on whether main is empty or not. if(is.na(margins[3])) margins[3] <- ifelse(main == "", 0, 30) @@ -788,9 +775,11 @@ heatmaply.heatmapr <- function(x, heatmap_subplot <- heatmap_subplot_from_ggplotly(p = p, px = px, py = py, row_dend_left = row_dend_left, subplot_margin = subplot_margin, titleX = titleX, titleY = titleY, pr = pr, pc = pc, plot_method = plot_method) - l <- layout(heatmap_subplot, showlegend = FALSE) %>% - layout(margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4])) - # print(l) + l <- layout(heatmap_subplot) %>% + layout( + margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4]), + legend = list(y=0, yanchor="bottom")) + l } @@ -800,7 +789,7 @@ plotly_dend_row <- function(dend, flip = FALSE) { segs <- dend_data$segment p <- plot_ly(segs) %>% add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, - line=list(color = '#000000')) %>% + line=list(color = '#000000'), showlegend = FALSE) %>% layout( xaxis = list( title = "", @@ -827,7 +816,7 @@ plotly_dend_col <- function(dend, flip = FALSE) { plot_ly(segs) %>% add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, - line = list(color='#000000')) %>% + line = list(color='#000000'), showlegend = FALSE) %>% layout( xaxis = list( title = "", From d270494ed653fde9d6e1176069d02bb876ab51f8 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 15 Mar 2017 14:14:45 +0000 Subject: [PATCH 20/46] Several bugfixes and functionality adds re: native plotly --- R/heatmaply.R | 57 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 46 insertions(+), 11 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index c23c71f..6dff566 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -689,9 +689,13 @@ heatmaply.heatmapr <- function(x, key.title = key.title, layers = heatmap_layers, row_dend_left = row_dend_left) - } else { + } else if (plot_method == "plotly") { + if (is.null(limits)) { + + } p <- plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), - type = "heatmap", showlegend = FALSE) %>% + type = "heatmap", showlegend = FALSE, colors=colors, + zmin = limits[1], zmax = limits[2]) %>% layout( xaxis = list( tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), @@ -701,7 +705,8 @@ heatmaply.heatmapr <- function(x, tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), showticklabels = TRUE ) - ) %>% colorbar(len=0.2, y = 3) + ) %>% colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) + } if (missing(row_side_colors)) { @@ -740,7 +745,7 @@ heatmaply.heatmapr <- function(x, ## plotly: # turn p, px, and py to plotly objects if necessary - if (!inherits(p, "plotly")) p <- ggplotly(p) + if (!inherits(p, "plotly")) p <- ggplotly(p) %>% layout(showlegend=FALSE) if(!is.null(px) && !inherits(px, "plotly")) { px <- ggplotly(px, tooltip = "y") %>% layout(showlegend=FALSE) @@ -750,7 +755,6 @@ heatmaply.heatmapr <- function(x, 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 @@ -775,22 +779,52 @@ heatmaply.heatmapr <- function(x, heatmap_subplot <- heatmap_subplot_from_ggplotly(p = p, px = px, py = py, row_dend_left = row_dend_left, subplot_margin = subplot_margin, titleX = titleX, titleY = titleY, pr = pr, pc = pc, plot_method = plot_method) - l <- layout(heatmap_subplot) %>% - layout( - margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4]), - legend = list(y=0, yanchor="bottom")) + l <- layout(heatmap_subplot, + margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4]), + legend = list(y=1, yanchor="top") + ) l } + +make_colorscale <- function(colors) { + seq <- seq(0, 1, by = 1/length(colors)) + scale <- lapply(seq_along(colors), + function(i) { + # eg + # list(c(0, "rgb(255, 0, 0)"), c(1, "rgb(0, 255, 0)")), + if (i == 1) { + list(0, col2plotlyrgb(colors[i])) + } else if (i == length(colors)) { + list(1, col2plotlyrgb(colors[i])) + } else { + list(seq[i], col2plotlyrgb(colors[i])) + } + } + ) + scale +} + +col2plotlyrgb <- function(col) { + rgb <- col2rgb(col) + paste0( + "rgb(", + rgb["red", ], ",", + rgb["green", ], ",", + rgb["blue", ], ")" + ) +} + #' @importFrom ggdendro dendro_data plotly_dend_row <- function(dend, flip = FALSE) { dend_data <- dendro_data(dend) segs <- dend_data$segment p <- plot_ly(segs) %>% add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, - line=list(color = '#000000'), showlegend = FALSE) %>% + line=list(color = '#000000'), showlegend = FALSE, hoverinfo = "none") %>% layout( + hovermode = "closest", xaxis = list( title = "", linecolor = "#ffffff", @@ -816,8 +850,9 @@ plotly_dend_col <- function(dend, flip = FALSE) { plot_ly(segs) %>% add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, - line = list(color='#000000'), showlegend = FALSE) %>% + line = list(color='#000000'), showlegend = FALSE, hoverinfo = "none") %>% layout( + hovermode = "closest", xaxis = list( title = "", range = c(0, max(segs$x) + 1), From 4a7e4f4c368919e15878e2cfd3b565b03276ba97 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Tue, 21 Mar 2017 18:31:51 +0000 Subject: [PATCH 21/46] Retain dimnames names for matrix input --- R/heatmaply.R | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index a16b727..ae0760a 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -426,18 +426,31 @@ ggplot_heatmap <- function(xx, panel.background = element_blank()) # heatmap # xx <- x$matrix$data - if(!is.data.frame(df)) df <- as.data.frame(xx) + if(!is.data.frame(xx)) df <- as.data.frame(xx) + + if (is.null(dim_names <- names(dimnames(xx)))) { + dim_names <- c("row", "column") + } + # colnames(df) <- x$matrix$cols - df$row <- if(!is.null(rownames(xx))) - {rownames(xx)} else - {1:nrow(xx)} - df$row <- with(df, factor(row, levels=row, ordered=TRUE)) - mdf <- reshape2::melt(df, id.vars="row") - colnames(mdf)[2] <- "column" # rename "variable" + if(!is.null(rownames(xx))) { + df[[dim_names[[1]]]] <- rownames(xx) + } else { + df[[dim_names[[1]]]] <- 1:nrow(xx) + } + + df[[dim_names[[1]]]] <- factor( + df[[dim_names[[1]]]], + levels=df[[dim_names[[1]]]], + ordered=TRUE + ) + + mdf <- reshape2::melt(df, id.vars=dim_names[[1]]) + colnames(mdf)[2] <- dim_names[[2]] # rename "variable" # TODO: # http://stackoverflow.com/questions/15921799/draw-lines-around-specific-areas-in-geom-tile # https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html - p <- ggplot(mdf, aes_string(x = "column", y = "row")) + + p <- ggplot(mdf, aes_string(x = dim_names[[2]], y = dim_names[[1]])) + geom_tile(aes_string(fill = "value"), color = grid_color, size = grid_size) + # scale_linetype_identity() + # scale_fill_viridis() + From f281048c3b527bb236eea1a66aae6b43d692e117 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 19:22:41 +0000 Subject: [PATCH 22/46] Add long_data support --- .gitignore | 2 ++ DESCRIPTION | 3 ++- NAMESPACE | 1 + R/heatmaply.R | 31 ++++++++++++++++++++----------- man/heatmaply.Rd | 7 ++++++- 5 files changed, 31 insertions(+), 13 deletions(-) diff --git a/.gitignore b/.gitignore index 54fb7f9..e40ca94 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ .Rhistory .RData TODO.txt +lib +*.html diff --git a/DESCRIPTION b/DESCRIPTION index be2f9ab..7cd2d95 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,8 @@ Imports: colorspace, RColorBrewer, GGally, - htmlwidgets + htmlwidgets, + assertthat Suggests: knitr, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index c533ffc..86c94ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ export(percentize) export(side_color_plot) import(dendextend) import(ggplot2) +importFrom(assertthat,assert_that) importFrom(dendextend,color_branches) importFrom(dendextend,find_k) importFrom(dendextend,is.dendrogram) diff --git a/R/heatmaply.R b/R/heatmaply.R index ae0760a..9176a35 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -132,6 +132,11 @@ #' You can relocate the file once it is created, or use \link{setwd} first. #' This is based on \link[htmlwidgets]{saveWidget}. #' +#' @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" +#' inthe data. +#' #' #' @export #' @examples @@ -237,6 +242,7 @@ heatmaply <- function(x, ...) { #' @export #' @rdname heatmaply +#' @importFrom assertthat assert_that heatmaply.default <- function(x, # elements for scale_fill_gradientn colors = viridis(n=256, alpha = 1, begin = 0, @@ -291,8 +297,19 @@ heatmaply.default <- function(x, RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6, - file + file, + long_data ) { + if (!missing(long_data)) { + if (!missing(x)) warning("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 + } ## Suppress creation of new graphcis device, but on exit replace it. old_dev <- options()[["device"]] on.exit(options(device = old_dev)) @@ -772,18 +789,10 @@ heatmaply.heatmapr <- function(x, titleX = titleX, titleY = titleY, pr = pr, pc = pc) l <- layout(heatmap_subplot, showlegend = FALSE) %>% layout(margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4])) - # print(l) - - - - # clean the modeBarButtons from irrelevent icons - # l$x$config$modeBarButtonsToRemove <- list("sendDataToCloud", "select2d", "lasso2d","autoScale2d", "hoverCompareCartesian", "sendDataToCloud") - # l <- config(l, displaylogo = FALSE, collaborate = FALSE) # , - # #modeBarButtonsToRemove = list("sendDataToCloud", "select2d", "lasso2d","autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "sendDataToCloud")) + l <- config(l, displaylogo = FALSE, collaborate = FALSE, modeBarButtonsToRemove = c("sendDataToCloud", "select2d", "lasso2d","autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "sendDataToCloud")) - l } @@ -872,7 +881,7 @@ side_color_plot <- function(df, palette, row_text_angle, column_text_angle, is_colors) { if (is.matrix(df)) df <- as.data.frame(df) - stopifnot(is.data.frame(df)) + assert_that(is.data.frame(df)) ## TODO: Find out why names are dropped when dim(df)[2] == 1 original_dim <- dim(df) diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 1930663..1837d4a 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -24,7 +24,7 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, row_side_palette, col_side_colors = NULL, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6, file) + branches_lwd = 0.6, file, long_data) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -168,6 +168,11 @@ For example: heatmaply(x, file = "heatmaply_plot.html"). This should not include a directory, only the name of the file. You can relocate the file once it is created, or use \link{setwd} first. This is based on \link[htmlwidgets]{saveWidget}.} + +\item{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" +inthe data.} } \description{ An object of class heatmapr includes all the needed information From 398ab6f80d32e712ad82b42478d9ef527018f645 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 20:03:02 +0000 Subject: [PATCH 23/46] Add label names to side_color_plot and tidy up --- R/heatmaply.R | 79 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 49 insertions(+), 30 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 9176a35..a4fef13 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -298,7 +298,8 @@ heatmaply.default <- function(x, heatmap_layers = NULL, branches_lwd = 0.6, file, - long_data + long_data, + label_names = c("row", "column", "value") ) { if (!missing(long_data)) { if (!missing(x)) warning("x and long_data should not be used together") @@ -408,7 +409,8 @@ heatmaply.default <- function(x, ColSideColors = ColSideColors, RowSideColors = RowSideColors, heatmap_layers = heatmap_layers, - branches_lwd = branches_lwd + branches_lwd = branches_lwd, + label_names = label_names ) # TODO: think more on what should be passed in "..." if(!missing(file)) hmly %>% saveWidget(file = file, selfcontained = TRUE) @@ -435,6 +437,7 @@ ggplot_heatmap <- function(xx, key.title = NULL, layers, row_dend_left = FALSE, + label_names, ...) { theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), panel.grid.major = element_blank(), @@ -445,30 +448,38 @@ ggplot_heatmap <- function(xx, # xx <- x$matrix$data if(!is.data.frame(xx)) df <- as.data.frame(xx) - if (is.null(dim_names <- names(dimnames(xx)))) { - dim_names <- c("row", "column") + if (missing(label_names)) { + if (is.null(dim_names <- names(dimnames(xx)))) { + label_names <- c("row", "column", "value") + } + } else { + assert_that(length(label_names) == 3) } + row <- label_names[[1]] + col <- label_names[[2]] + val <- label_names[[3]] # colnames(df) <- x$matrix$cols if(!is.null(rownames(xx))) { - df[[dim_names[[1]]]] <- rownames(xx) + df[[row]] <- rownames(xx) } else { - df[[dim_names[[1]]]] <- 1:nrow(xx) + df[[row]] <- 1:nrow(xx) } - df[[dim_names[[1]]]] <- factor( - df[[dim_names[[1]]]], - levels=df[[dim_names[[1]]]], + df[[row]] <- factor( + df[[row]], + levels=df[[row]], ordered=TRUE ) - mdf <- reshape2::melt(df, id.vars=dim_names[[1]]) - colnames(mdf)[2] <- dim_names[[2]] # rename "variable" + mdf <- reshape2::melt(df, id.vars=row) + colnames(mdf)[2:3] <- c(col, val) # rename "variable" and "value" + # TODO: # http://stackoverflow.com/questions/15921799/draw-lines-around-specific-areas-in-geom-tile # https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html - p <- ggplot(mdf, aes_string(x = dim_names[[2]], y = dim_names[[1]])) + - geom_tile(aes_string(fill = "value"), color = grid_color, size = grid_size) + + p <- ggplot(mdf, aes_string(x = col, y = row)) + + geom_tile(aes_string(fill = val), color = grid_color, size = grid_size) + # scale_linetype_identity() + # scale_fill_viridis() + coord_cartesian(expand = FALSE) + @@ -644,7 +655,8 @@ heatmaply.heatmapr <- function(x, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6 + branches_lwd = 0.6, + label_names ) { # informative errors for mis-specified limits if(!is.null(limits)) { @@ -709,14 +721,16 @@ heatmaply.heatmapr <- function(x, grid_color, key.title = key.title, layers = heatmap_layers, - row_dend_left = row_dend_left) + row_dend_left = row_dend_left, + label_names = label_names) if(return_ppxpy) { return(list(p=p, px=px, py=py)) } if (is.null(row_side_colors)) pr <- NULL else { - pr <- side_color_plot(x[["row_side_colors"]], type = "row", - palette = row_side_palette, is_colors = !is.null(RowSideColors)) + pr <- side_color_plot(x[["row_side_colors"]], type = "row", + text_angle = row_text_angle, palette = row_side_palette, + is_colors = !is.null(RowSideColors), label_name = label_names[[1]]) } if (is.null(col_side_colors)) pc <- NULL else { @@ -729,7 +743,10 @@ heatmaply.heatmapr <- function(x, ## Just make sure it's character first side_color_df[] <- lapply(side_color_df, as.character) pc <- side_color_plot(side_color_df, type = "column", - palette = col_side_palette, is_colors = !is.null(ColSideColors)) + text_angle = column_text_angle, palette = col_side_palette, + is_colors = !is.null(ColSideColors), + label_name = label_names[[2]] + ) } ## plotly: @@ -869,28 +886,29 @@ if(FALSE) { #' plot #' @param scale_title Title of the color scale. Not currently used. #' @param type Horizontal or vertical plot? Valid values are "column" and "row" -#' @param row_text_angle,column_text_angle the angle of the text of the rows/columns. +#' @param text_angle the angle of the text of the rows/columns. #' @param is_colors Use if the values in df are valid colours and should not be mapped #' to a color scheme, and instead should be plotted directly. #' #' @return A ggplot geom_tile object -#' -#' @export side_color_plot <- function(df, palette, scale_title = paste(type, "side colors"), type = c("column", "row"), - row_text_angle, column_text_angle, is_colors) { + text_angle, is_colors, label_name) { if (is.matrix(df)) df <- as.data.frame(df) assert_that(is.data.frame(df)) + ## Cooerce to character + df[] <- lapply(df, as.character) + ## TODO: Find out why names are dropped when dim(df)[2] == 1 original_dim <- dim(df) - if (missing(column_text_angle)) column_text_angle <- 0 - if (missing(row_text_angle)) row_text_angle <- 45 if (missing(palette)) palette <- colorspace::rainbow_hcl type <- match.arg(type) + ## Custom label + if (!missing(label_name)) type <- label_name if (type %in% colnames(df)) stop("Having", type, "in the colnames of the side_color df will drop data!") @@ -898,13 +916,14 @@ side_color_plot <- function(df, palette, df[[type]] <- factor(df[[type]], levels = df[[type]], ordered = TRUE) df <- reshape2::melt(df, id.vars = type) - df[["value"]] <- factor(df[["value"]]) + df[[label_name]] <- factor(df[[label_name]]) id_var <- colnames(df)[1] + if (type == "column") { - mapping <- aes_string(x = id_var, y = 'variable', fill = 'value') + mapping <- aes_string(x = id_var, y = "variable", fill = "value") if(original_dim[2] > 1) { - text_element <- element_text(angle = column_text_angle) + text_element <- element_text(angle = text_angle) } else text_element <- element_blank() theme <- theme( @@ -914,10 +933,10 @@ side_color_plot <- function(df, palette, axis.ticks = element_blank()) } else { if(original_dim[2] > 1) { - text_element <- element_text(angle = row_text_angle) + text_element <- element_text(angle = text_angle) } else text_element <- element_blank() - mapping <- aes_string(x = 'variable', y = id_var, fill = 'value') + mapping <- aes_string(x = "variable", y = id_var, fill = "value") theme <- theme( panel.background = element_blank(), axis.text.x = text_element, @@ -927,7 +946,7 @@ side_color_plot <- function(df, palette, color_vals <- if (is_colors) levels(df[["value"]]) else palette(length(unique(df[["value"]]))) - + g <- ggplot(df, mapping = mapping) + geom_raster() + xlab("") + From 83c3566e1817239668f49d81723e0b006861af8f Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 20:46:20 +0000 Subject: [PATCH 24/46] Bugfix --- R/heatmaply.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index a4fef13..e375009 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -916,7 +916,7 @@ side_color_plot <- function(df, palette, df[[type]] <- factor(df[[type]], levels = df[[type]], ordered = TRUE) df <- reshape2::melt(df, id.vars = type) - df[[label_name]] <- factor(df[[label_name]]) + df[["value"]] <- factor(df[["value"]]) id_var <- colnames(df)[1] @@ -945,8 +945,8 @@ side_color_plot <- function(df, palette, } color_vals <- if (is_colors) levels(df[["value"]]) - else palette(length(unique(df[["value"]]))) - + else palette(nlevels(df[["value"]])) + g <- ggplot(df, mapping = mapping) + geom_raster() + xlab("") + From 2f392592556a41c58822c4db4c80a31249a2f624 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 21:05:20 +0000 Subject: [PATCH 25/46] Move plots to file --- NAMESPACE | 2 +- R/ggheatmap.R | 85 ------ R/heatmaply.R | 351 +----------------------- R/plots.R | 331 ++++++++++++++++++++++ man/{ggheatmap.Rd => ggplot_heatmap.Rd} | 16 +- man/side_color_plot.Rd | 2 +- 6 files changed, 345 insertions(+), 442 deletions(-) delete mode 100644 R/ggheatmap.R create mode 100644 R/plots.R rename man/{ggheatmap.Rd => ggplot_heatmap.Rd} (62%) diff --git a/NAMESPACE b/NAMESPACE index 464c460..5317441 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,7 +8,7 @@ S3method(normalize,matrix) S3method(percentize,data.frame) S3method(percentize,default) S3method(percentize,matrix) -export(ggheatmap) +export(ggplot_heatmap) export(heatmaply) export(heatmapr) export(is.heatmapr) diff --git a/R/ggheatmap.R b/R/ggheatmap.R deleted file mode 100644 index 497b208..0000000 --- a/R/ggheatmap.R +++ /dev/null @@ -1,85 +0,0 @@ -# -# # source: http://www.peterhaschke.com/r/2013/04/24/MultiPlot.html -# # http://rstudio-pubs-static.s3.amazonaws.com/2852_379274d7c5734f979e106dcf019ec46c.html -# multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) { -# # library(grid) -# -# plots <- c(list(...), plotlist) -# -# numPlots = length(plots) -# -# if (is.null(layout)) { -# layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), -# ncol = cols, nrow = ceiling(numPlots/cols)) -# } -# -# if (numPlots == 1) { -# print(plots[[1]]) -# -# } else { -# grid.newpage() -# pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) -# -# for (i in 1:numPlots) { -# matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) -# -# print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, -# layout.pos.col = matchidx$col)) -# } -# } -# } - -# grid, -# gridExtra - -#' @title Creates a ggplot2 heatmap -#' -#' @description -#' An object of class heatmapr includes all the needed information -#' for producing a heatmap. The goal is to seperate the pre-processing of the -#' heatmap elements from the graphical rendaring of the object, which could be done -#' -#' @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 ... other parameters passed to \link{heatmapr} (currently, various parameters may be ignored. -#' -#' @export -#' @examples -#' \dontrun{ -#' -#' library(heatmaply) -#' x <- heatmapr(iris[,-5], scale = "column", colors = "Blues") -#' ggheatmap(x) -#' -#' -#' } -ggheatmap <- function(x, ...) { - if(!is.heatmapr(x)) { - x <- heatmapr(x, ...) - } - ppxpy <- heatmaply(x, return_ppxpy = TRUE) - ggempty <- ggplot() + geom_blank() + theme_bw() - gg_list <- list(ppxpy$py, ggempty, ppxpy$p, ppxpy$px) - # gg_list <- list(ppxpy$py, ppxpy$p, ggempty, ppxpy$px) - # sapply(ppxpy, class) - # lapply(gg_list, class) - GGally::ggmatrix(gg_list, nrow = 2, ncol = 2) # in this we can't control the relative widths - # multiplot(ppxpy$py, ggempty, ppxpy$p, ppxpy$px, - - # pp <- ppxpy$p + guides(fill=FALSE) + - # theme(axis.title.x=element_blank(), - # axis.text.x=element_blank(), - # axis.ticks.x=element_blank(), - # axis.title.y=element_blank(), - # axis.text.y=element_blank(), - # axis.ticks.y=element_blank()) - # multiplot(ppxpy$py, pp , ggempty, ppxpy$px, - # layout = matrix(c(1,2,2,1,2,2,3,4,4), nrow = 3) , - # cols = 2, main = "Main title") - - # ppxpy$p + guides(fill=FALSE) - -} - - diff --git a/R/heatmaply.R b/R/heatmaply.R index 6dff566..fb265d1 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -1,12 +1,10 @@ ## TODO: roxygen documentation of all functions - # devtools::install_github("ropensci/plotly", ref = "fix/subplot") # reference: https://plot.ly/ggplot2/ggdendro-dendrograms/ # to answer later: http://stackoverflow.com/questions/34733829/questions-about-a-tutorial-regarding-interactive-heatmaps-with-plotly # to check: https://plot.ly/r/heatmaps/ - #' @title Cluster heatmap based on plotly #' @name heatmaply #' @@ -227,7 +225,6 @@ heatmaply <- function(x, ...) { UseMethod("heatmaply") } - #' @export #' @rdname heatmaply heatmaply.default <- function(x, @@ -280,7 +277,7 @@ heatmaply.default <- function(x, file ) { plot_method <- match.arg(plot_method) - ## Suppress creation of new graphcis device, but on exit replace it. + ## Suppress creation of new x11 device, but on exit replace it. old_dev <- options()[["device"]] on.exit(options(device = old_dev)) options(device = names(capabilities()[which(capabilities())])[1]) @@ -321,10 +318,6 @@ heatmaply.default <- function(x, x <- x[, ss_c_numeric] } - - - - hm <- heatmapr(x, row_side_colors = row_side_colors, col_side_colors = col_side_colors, @@ -376,100 +369,6 @@ heatmaply.default <- function(x, - - - - -# xx is a data matrix -ggplot_heatmap <- function(xx, - row_text_angle = 0, - column_text_angle = 45, - scale_fill_gradient_fun = - scale_fill_gradientn(colors = viridis(n=256, alpha = 1, begin = 0, - end = 1, option = "viridis"), - na.value = "grey50", limits = NULL), - grid_color = NA, - grid_size = 0.1, - key.title = NULL, - layers, - row_dend_left = FALSE, - ...) { - theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - panel.background = element_blank()) - # heatmap - if(!is.data.frame(df)) df <- as.data.frame(xx) - - if(!is.null(rownames(xx))) df$row <- rownames(xx) else df$row <- 1:nrow(xx) - - df$row <- with(df, factor(row, levels=row, ordered=TRUE)) - mdf <- reshape2::melt(df, id.vars="row") - colnames(mdf)[2] <- "column" # rename "variable" - # TODO: - # http://stackoverflow.com/questions/15921799/draw-lines-around-specific-areas-in-geom-tile - # https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html - p <- ggplot(mdf, aes_string(x = "column", y = "row")) + - geom_tile(aes_string(fill = "value"), color = grid_color, size = grid_size) + - # scale_linetype_identity() + - # scale_fill_viridis() + - coord_cartesian(expand = FALSE) + - scale_fill_gradient_fun + - theme_bw()+ theme_clear_grid_heatmap + - theme(axis.text.x = element_text(angle = column_text_angle, hjust = 1), - axis.text.y = element_text(angle = row_text_angle, hjust = 1) - ) - - if(!missing(layers)) p <- p + layers - ## Passed in to allow users to alter (courtesy of GenVisR) - - # p <- p + scale_x_discrete(limits = unique(mdf)) - # http://stats.stackexchange.com/questions/5007/how-can-i-change-the-title-of-a-legend-in-ggplot2 - p <- p + labs(fill=key.title) - - # until this bug is fixed: https://github.com/ropensci/plotly/issues/699 - # we are forced to use geom_hline and geom_vline - if(!is.na(grid_color)) { - p <- p + geom_hline(yintercept =c(0:nrow(xx))+.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly - p <- p + geom_vline(xintercept =c(0:ncol(xx))+.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly - - } - - if(row_dend_left) p <- p + scale_y_discrete(position = "right") # possible as of ggplot 2.1.0 ! - - p -} - - - - - - - - -# -# library(ggplot2) -# library(plotly) -# # library(heatmaply) -# ggplot_heatmap <- heatmaply:::ggplot_heatmap -# class_to <- function(x, new_class) { -# class(x) <- new_class -# x -# } -# na_mat <- function(x) { -# x %>% is.na %>% class_to("numeric") -# } -# -# p <- heatmaply:::ggplot_heatmap(na_mat(airquality), -# scale_fill_gradient_fun = scale_fill_gradientn(colors= c("white","black")) , -# grid_color = "grey", grid_size = 1) -# plot(p) -# ggplotly(p) -# p <- ggplot_heatmap(mtcars, -# grid_color = white") -# p -# heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, row_dend_left, subplot_margin = 0, titleX = TRUE, titleY = TRUE, @@ -568,14 +467,6 @@ heatmap_subplot_from_ggplotly <- function(p, px, py, pr, pc, return(s) } - - - - - - - - #' @export #' @rdname heatmaply heatmaply.heatmapr <- function(x, @@ -632,8 +523,6 @@ heatmaply.heatmapr <- function(x, # x is a heatmapr object. # heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, image = imgUri, # theme = theme, options = options) - # TODO: we assume the creation of dendrograms. Other defaults should be made when the user - # chooses to not work with dendrograms. # 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(), @@ -690,23 +579,7 @@ heatmaply.heatmapr <- function(x, layers = heatmap_layers, row_dend_left = row_dend_left) } else if (plot_method == "plotly") { - if (is.null(limits)) { - - } - p <- plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), - type = "heatmap", showlegend = FALSE, colors=colors, - zmin = limits[1], zmax = limits[2]) %>% - layout( - xaxis = list( - tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), - showticklabels = TRUE - ), - yaxis = list( - tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), - showticklabels = TRUE - ) - ) %>% colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) - + p <- plotly_heatmap(data_mat, limits = limits, colors = colors) } if (missing(row_side_colors)) { @@ -786,223 +659,3 @@ heatmaply.heatmapr <- function(x, l } - - -make_colorscale <- function(colors) { - seq <- seq(0, 1, by = 1/length(colors)) - scale <- lapply(seq_along(colors), - function(i) { - # eg - # list(c(0, "rgb(255, 0, 0)"), c(1, "rgb(0, 255, 0)")), - if (i == 1) { - list(0, col2plotlyrgb(colors[i])) - } else if (i == length(colors)) { - list(1, col2plotlyrgb(colors[i])) - } else { - list(seq[i], col2plotlyrgb(colors[i])) - } - } - ) - scale -} - -col2plotlyrgb <- function(col) { - rgb <- col2rgb(col) - paste0( - "rgb(", - rgb["red", ], ",", - rgb["green", ], ",", - rgb["blue", ], ")" - ) -} - -#' @importFrom ggdendro dendro_data -plotly_dend_row <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) - segs <- dend_data$segment - p <- plot_ly(segs) %>% - add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, - line=list(color = '#000000'), showlegend = FALSE, hoverinfo = "none") %>% - layout( - hovermode = "closest", - xaxis = list( - title = "", - linecolor = "#ffffff", - showgrid = FALSE - ), - yaxis = list( - title = "", - range = c(0, max(segs$x) + 1), - linecolor = "#ffffff", - showgrid = FALSE - ) - ) - - if (flip) { - p <- layout(p, xaxis = list(autorange = "reversed")) - } - p -} - -plotly_dend_col <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) - segs <- dend_data$segment - - plot_ly(segs) %>% - add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, - line = list(color='#000000'), showlegend = FALSE, hoverinfo = "none") %>% - layout( - hovermode = "closest", - xaxis = list( - title = "", - range = c(0, max(segs$x) + 1), - linecolor = "#ffffff", - showgrid = FALSE - ), - yaxis = list( - title = "", - linecolor = "#ffffff", - showgrid = FALSE - ) - ) -} - - - - - - -# theme_set(theme_cowplot()) -# library(cowplot) -# require2(cowplot) -# -if(FALSE) { - # devtools::install_github("ropensci/plotly", ref = "fix/subplot") - # devtools::install_github('talgalili/heatmaply') - library(ggplot2) - library(dendextend) - library(plotly) - library(viridis) - #dendogram data - x <- as.matrix(scale(mtcars)) - dd.col <- as.dendrogram(hclust(dist(x))) - dd.row <- as.dendrogram(hclust(dist(t(x)))) - dd.col <- color_branches(dd.col, k = 3) - dd.row <- color_branches(dd.row, k = 2) - px <- ggplot(dd.row, labels = FALSE) + theme_bw() - py <- ggplot(dd.col, labels = FALSE) + coord_flip()+ theme_bw() - # heatmap - col.ord <- order.dendrogram(dd.col) - row.ord <- order.dendrogram(dd.row) - xx <- scale(mtcars)[col.ord, row.ord] - xx_names <- attr(xx, "dimnames") - df <- as.data.frame(xx) - colnames(df) <- xx_names[[2]] - df$car <- xx_names[[1]] - df$car <- with(df, factor(car, levels=car, ordered=TRUE)) - mdf <- reshape2::melt(df, id.vars="car") - # https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html - p <- ggplot(mdf, aes(x = variable, y = car)) + geom_tile(aes(fill = value)) + - scale_fill_viridis() + theme_bw() + - theme(axis.text.x = element_text(angle = column_text_angle, hjust = 1)) - # p <- plot_ly(z = xx, type = "heatmap") - # ggplotly(p) # works great - # ggplotly(p, tooltip = "none") - # ggplotly(px, tooltip = "") - # - # # hide axis ticks and grid lines - # eaxis <- list( - # showticklabels = FALSE, - # showgrid = FALSE, - # zeroline = FALSE - # ) - # p_empty <- plot_ly() %>% - # # note that margin applies to entire plot, so we can - # # add it here to make tick labels more readable - # layout(margin = list(l = 200), - # xaxis = eaxis, - # yaxis = eaxis) - s <- subplot(px, plotly_empty(), p, py, nrows = 2, widths = c(.8,.2), heights = c(.2,.8), margin = 0, - shareX = TRUE, shareY = TRUE, titleX = titleX, titleY = titleY) - layout(s, showlegend = FALSE) -} - - -#' -#' geom_tile for side color plots -#' -#' @param df A "molten" data.frame as produced by (eg) reshape2::melt -#' @param palette A function which can return colors to be used in the sidebar -#' plot -#' @param scale_title Title of the color scale. Not currently used. -#' @param type Horizontal or vertical plot? Valid values are "column" and "row" -#' @param row_text_angle,column_text_angle the angle of the text of the rows/columns. -#' @param is_colors Use if the values in df are valid colours and should not be mapped -#' to a color scheme, and instead should be plotted directly. -#' -#' @return A ggplot geom_tile object -#' -#' @export -side_color_plot <- function(df, palette, - scale_title = paste(type, "side colors"), type = c("column", "row"), - row_text_angle, column_text_angle, is_colors) { - - if (is.matrix(df)) df <- as.data.frame(df) - stopifnot(is.data.frame(df)) - - ## TODO: Find out why names are dropped when dim(df)[2] == 1 - original_dim <- dim(df) - - if (missing(column_text_angle)) column_text_angle <- 0 - if (missing(row_text_angle)) row_text_angle <- 45 - if (missing(palette)) palette <- colorspace::rainbow_hcl - - type <- match.arg(type) - if (type %in% colnames(df)) - stop("Having", type, "in the colnames of the side_color df will drop data!") - - df[[type]] <- if(!is.null(rownames(df))) rownames(df) else 1:nrow(df) - - df[[type]] <- factor(df[[type]], levels = df[[type]], ordered = TRUE) - df <- reshape2::melt(df, id.vars = type) - df[["value"]] <- factor(df[["value"]]) - - id_var <- colnames(df)[1] - if (type == "column") { - mapping <- aes_string(x = id_var, y = 'variable', fill = 'value') - if(original_dim[2] > 1) { - text_element <- element_text(angle = column_text_angle) - } else text_element <- element_blank() - - theme <- theme( - panel.background = element_blank(), - axis.text.x = element_blank(), - axis.text.y = text_element, - axis.ticks = element_blank()) - } else { - if(original_dim[2] > 1) { - text_element <- element_text(angle = row_text_angle) - } else text_element <- element_blank() - - mapping <- aes_string(x = 'variable', y = id_var, fill = 'value') - theme <- theme( - panel.background = element_blank(), - axis.text.x = text_element, - axis.text.y = element_blank(), - axis.ticks = element_blank()) - } - - color_vals <- if (is_colors) levels(df[["value"]]) - else palette(length(unique(df[["value"]]))) - - g <- ggplot(df, mapping = mapping) + - geom_raster() + - xlab("") + - ylab("") + - scale_fill_manual( - name = NULL, - breaks = levels(df[["value"]]), - values = color_vals) + - theme - return(g) -} diff --git a/R/plots.R b/R/plots.R new file mode 100644 index 0000000..8303c03 --- /dev/null +++ b/R/plots.R @@ -0,0 +1,331 @@ +# +# # source: http://www.peterhaschke.com/r/2013/04/24/MultiPlot.html +# # http://rstudio-pubs-static.s3.amazonaws.com/2852_379274d7c5734f979e106dcf019ec46c.html +# multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) { +# # library(grid) +# +# plots <- c(list(...), plotlist) +# +# numPlots = length(plots) +# +# if (is.null(layout)) { +# layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), +# ncol = cols, nrow = ceiling(numPlots/cols)) +# } +# +# if (numPlots == 1) { +# print(plots[[1]]) +# +# } else { +# grid.newpage() +# pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) +# +# for (i in 1:numPlots) { +# matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) +# +# print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, +# layout.pos.col = matchidx$col)) +# } +# } +# } + +# grid, +# gridExtra + +#' @title Creates a ggplot2 heatmap +#' +#' @description +#' An object of class heatmapr includes all the needed information +#' for producing a heatmap. The goal is to seperate the pre-processing of the +#' heatmap elements from the graphical rendaring of the object, which could be done +#' +#' @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 ... other parameters passed to \link{heatmapr} (currently, various parameters may be ignored. +#' +#' @export +#' @examples +#' \dontrun{ +#' +#' library(heatmaply) +#' x <- heatmapr(iris[,-5], scale = "column", colors = "Blues") +#' ggheatmap(x) +#' +#' +#' } +# ggheatmap <- function(x, ...) { +# if(!is.heatmapr(x)) { +# x <- heatmapr(x, ...) +# } +# ppxpy <- heatmaply(x, return_ppxpy = TRUE) +# ggempty <- ggplot() + geom_blank() + theme_bw() +# gg_list <- list(ppxpy$py, ggempty, ppxpy$p, ppxpy$px) +# # gg_list <- list(ppxpy$py, ppxpy$p, ggempty, ppxpy$px) +# # sapply(ppxpy, class) +# # lapply(gg_list, class) +# GGally::ggmatrix(gg_list, nrow = 2, ncol = 2) # in this we can't control the relative widths +# # multiplot(ppxpy$py, ggempty, ppxpy$p, ppxpy$px, + +# # pp <- ppxpy$p + guides(fill=FALSE) + +# # theme(axis.title.x=element_blank(), +# # axis.text.x=element_blank(), +# # axis.ticks.x=element_blank(), +# # axis.title.y=element_blank(), +# # axis.text.y=element_blank(), +# # axis.ticks.y=element_blank()) +# # multiplot(ppxpy$py, pp , ggempty, ppxpy$px, +# # layout = matrix(c(1,2,2,1,2,2,3,4,4), nrow = 3) , +# # cols = 2, main = "Main title") + +# # ppxpy$p + guides(fill=FALSE) + +# } + + + + + +# xx is a data matrix +ggplot_heatmap <- function(xx, + row_text_angle = 0, + column_text_angle = 45, + scale_fill_gradient_fun = + scale_fill_gradientn(colors = viridis(n=256, alpha = 1, begin = 0, + end = 1, option = "viridis"), + na.value = "grey50", limits = NULL), + grid_color = NA, + grid_size = 0.1, + key.title = NULL, + layers, + row_dend_left = FALSE, + ...) { + theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + panel.background = element_blank()) + # heatmap + if(!is.data.frame(df)) df <- as.data.frame(xx) + + if(!is.null(rownames(xx))) df$row <- rownames(xx) else df$row <- 1:nrow(xx) + + df$row <- with(df, factor(row, levels=row, ordered=TRUE)) + mdf <- reshape2::melt(df, id.vars="row") + colnames(mdf)[2] <- "column" # rename "variable" + # TODO: + # http://stackoverflow.com/questions/15921799/draw-lines-around-specific-areas-in-geom-tile + # https://cran.r-project.org/web/packages/viridis/vignettes/intro-to-viridis.html + p <- ggplot(mdf, aes_string(x = "column", y = "row")) + + geom_tile(aes_string(fill = "value"), color = grid_color, size = grid_size) + + # scale_linetype_identity() + + # scale_fill_viridis() + + coord_cartesian(expand = FALSE) + + scale_fill_gradient_fun + + theme_bw()+ theme_clear_grid_heatmap + + theme(axis.text.x = element_text(angle = column_text_angle, hjust = 1), + axis.text.y = element_text(angle = row_text_angle, hjust = 1) + ) + + if(!missing(layers)) p <- p + layers + ## Passed in to allow users to alter (courtesy of GenVisR) + + # p <- p + scale_x_discrete(limits = unique(mdf)) + # http://stats.stackexchange.com/questions/5007/how-can-i-change-the-title-of-a-legend-in-ggplot2 + p <- p + labs(fill=key.title) + + # until this bug is fixed: https://github.com/ropensci/plotly/issues/699 + # we are forced to use geom_hline and geom_vline + if(!is.na(grid_color)) { + p <- p + geom_hline(yintercept =c(0:nrow(xx))+.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly + p <- p + geom_vline(xintercept =c(0:ncol(xx))+.5, color = grid_color) # , size = grid_size # not implemented since it doesn't work with plotly + + } + + if(row_dend_left) p <- p + scale_y_discrete(position = "right") # possible as of ggplot 2.1.0 ! + + p +} + + +plotly_heatmap <- function(x, limits = range(x), colors, + row_text_angle=0, column_text_angle=45, grid.color, grid.size, key.title, + row_dend_left) { + + plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), + type = "heatmap", showlegend = FALSE, colors=colors, + zmin = limits[1], zmax = limits[2]) %>% + layout( + xaxis = list( + tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), + showticklabels = TRUE + ), + yaxis = list( + tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), + showticklabels = TRUE + ) + ) %>% colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) +} + + + +make_colorscale <- function(colors) { + seq <- seq(0, 1, by = 1/length(colors)) + scale <- lapply(seq_along(colors), + function(i) { + # eg + # list(c(0, "rgb(255, 0, 0)"), c(1, "rgb(0, 255, 0)")), + if (i == 1) { + list(0, col2plotlyrgb(colors[i])) + } else if (i == length(colors)) { + list(1, col2plotlyrgb(colors[i])) + } else { + list(seq[i], col2plotlyrgb(colors[i])) + } + } + ) + scale +} + +col2plotlyrgb <- function(col) { + rgb <- col2rgb(col) + paste0( + "rgb(", + rgb["red", ], ",", + rgb["green", ], ",", + rgb["blue", ], ")" + ) +} + +#' @importFrom ggdendro dendro_data +plotly_dend_row <- function(dend, flip = FALSE) { + dend_data <- dendro_data(dend) + segs <- dend_data$segment + p <- plot_ly(segs) %>% + add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, + line=list(color = '#000000'), showlegend = FALSE, hoverinfo = "none") %>% + layout( + hovermode = "closest", + xaxis = list( + title = "", + linecolor = "#ffffff", + showgrid = FALSE + ), + yaxis = list( + title = "", + range = c(0, max(segs$x) + 1), + linecolor = "#ffffff", + showgrid = FALSE + ) + ) + + if (flip) { + p <- layout(p, xaxis = list(autorange = "reversed")) + } + p +} + +plotly_dend_col <- function(dend, flip = FALSE) { + dend_data <- dendro_data(dend) + segs <- dend_data$segment + + plot_ly(segs) %>% + add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, + line = list(color='#000000'), showlegend = FALSE, hoverinfo = "none") %>% + layout( + hovermode = "closest", + xaxis = list( + title = "", + range = c(0, max(segs$x) + 1), + linecolor = "#ffffff", + showgrid = FALSE + ), + yaxis = list( + title = "", + linecolor = "#ffffff", + showgrid = FALSE + ) + ) +} + + + +#' +#' geom_tile for side color plots +#' +#' @param df A "molten" data.frame as produced by (eg) reshape2::melt +#' @param palette A function which can return colors to be used in the sidebar +#' plot +#' @param scale_title Title of the color scale. Not currently used. +#' @param type Horizontal or vertical plot? Valid values are "column" and "row" +#' @param row_text_angle,column_text_angle the angle of the text of the rows/columns. +#' @param is_colors Use if the values in df are valid colours and should not be mapped +#' to a color scheme, and instead should be plotted directly. +#' +#' @return A ggplot geom_tile object +#' +#' @export +side_color_plot <- function(df, palette, + scale_title = paste(type, "side colors"), type = c("column", "row"), + row_text_angle, column_text_angle, is_colors) { + + if (is.matrix(df)) df <- as.data.frame(df) + stopifnot(is.data.frame(df)) + + ## TODO: Find out why names are dropped when dim(df)[2] == 1 + original_dim <- dim(df) + + if (missing(column_text_angle)) column_text_angle <- 0 + if (missing(row_text_angle)) row_text_angle <- 45 + if (missing(palette)) palette <- colorspace::rainbow_hcl + + type <- match.arg(type) + if (type %in% colnames(df)) + stop("Having", type, "in the colnames of the side_color df will drop data!") + + df[[type]] <- if(!is.null(rownames(df))) rownames(df) else 1:nrow(df) + + df[[type]] <- factor(df[[type]], levels = df[[type]], ordered = TRUE) + df <- reshape2::melt(df, id.vars = type) + df[["value"]] <- factor(df[["value"]]) + + id_var <- colnames(df)[1] + if (type == "column") { + mapping <- aes_string(x = id_var, y = 'variable', fill = 'value') + if(original_dim[2] > 1) { + text_element <- element_text(angle = column_text_angle) + } else text_element <- element_blank() + + theme <- theme( + panel.background = element_blank(), + axis.text.x = element_blank(), + axis.text.y = text_element, + axis.ticks = element_blank()) + } else { + if(original_dim[2] > 1) { + text_element <- element_text(angle = row_text_angle) + } else text_element <- element_blank() + + mapping <- aes_string(x = 'variable', y = id_var, fill = 'value') + theme <- theme( + panel.background = element_blank(), + axis.text.x = text_element, + axis.text.y = element_blank(), + axis.ticks = element_blank()) + } + + color_vals <- if (is_colors) levels(df[["value"]]) + else palette(length(unique(df[["value"]]))) + + g <- ggplot(df, mapping = mapping) + + geom_raster() + + xlab("") + + ylab("") + + scale_fill_manual( + name = NULL, + breaks = levels(df[["value"]]), + values = color_vals) + + theme + return(g) +} + diff --git a/man/ggheatmap.Rd b/man/ggplot_heatmap.Rd similarity index 62% rename from man/ggheatmap.Rd rename to man/ggplot_heatmap.Rd index 1c5c3bd..3afba12 100644 --- a/man/ggheatmap.Rd +++ b/man/ggplot_heatmap.Rd @@ -1,16 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggheatmap.R -\name{ggheatmap} -\alias{ggheatmap} +% Please edit documentation in R/plots.R +\name{ggplot_heatmap} +\alias{ggplot_heatmap} \title{Creates a ggplot2 heatmap} \usage{ -ggheatmap(x, ...) +ggplot_heatmap(xx, row_text_angle = 0, column_text_angle = 45, + scale_fill_gradient_fun = scale_fill_gradientn(colors = viridis(n = 256, + alpha = 1, begin = 0, end = 1, option = "viridis"), na.value = "grey50", + limits = NULL), grid_color = NA, grid_size = 0.1, key.title = NULL, + layers, row_dend_left = FALSE, ...) } \arguments{ +\item{...}{other parameters passed to \link{heatmapr} (currently, various parameters may be ignored.} + \item{x}{can either be a heatmapr object, or a numeric matrix Defaults to \code{TRUE} unless \code{x} contains any \code{NA}s.} - -\item{...}{other parameters passed to \link{heatmapr} (currently, various parameters may be ignored.} } \description{ An object of class heatmapr includes all the needed information diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index 975c850..c9a7b1c 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/heatmaply.R +% Please edit documentation in R/plots.R \name{side_color_plot} \alias{side_color_plot} \title{geom_tile for side color plots} From 905078becd1047b031ee0608b9ece0c69f5756e3 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 21:31:01 +0000 Subject: [PATCH 26/46] Bugfix --- R/plots.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/plots.R b/R/plots.R index 8303c03..a8c1d5d 100644 --- a/R/plots.R +++ b/R/plots.R @@ -152,16 +152,16 @@ plotly_heatmap <- function(x, limits = range(x), colors, row_text_angle=0, column_text_angle=45, grid.color, grid.size, key.title, row_dend_left) { - plot_ly(z = data_mat, x = 1:ncol(data_mat), y = 1:nrow(data_mat), + plot_ly(z = x, x = 1:ncol(x), y = 1:nrow(x), type = "heatmap", showlegend = FALSE, colors=colors, zmin = limits[1], zmax = limits[2]) %>% layout( xaxis = list( - tickvals = 1:ncol(data_mat), ticktext = colnames(data_mat), + tickvals = 1:ncol(x), ticktext = colnames(x), showticklabels = TRUE ), yaxis = list( - tickvals = 1:nrow(data_mat), ticktext = rownames(data_mat), + tickvals = 1:nrow(x), ticktext = rownames(x), showticklabels = TRUE ) ) %>% colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) From 557dfa8f06b9ffcb63b9f0a21ef46e7b362bc6e6 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 21:36:34 +0000 Subject: [PATCH 27/46] Add text angle --- R/heatmaply.R | 3 ++- R/plots.R | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 305e0f9..2e79f89 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -581,7 +581,8 @@ heatmaply.heatmapr <- function(x, layers = heatmap_layers, row_dend_left = row_dend_left) } else if (plot_method == "plotly") { - p <- plotly_heatmap(data_mat, limits = limits, colors = colors) + p <- plotly_heatmap(data_mat, limits = limits, colors = colors, + row_text_angle = row_text_angle, column_text_angle = column_text_angle) } if (missing(row_side_colors)) { diff --git a/R/plots.R b/R/plots.R index a8c1d5d..d421b88 100644 --- a/R/plots.R +++ b/R/plots.R @@ -157,10 +157,12 @@ plotly_heatmap <- function(x, limits = range(x), colors, zmin = limits[1], zmax = limits[2]) %>% layout( xaxis = list( + tickangle = row_text_angle, tickvals = 1:ncol(x), ticktext = colnames(x), showticklabels = TRUE ), yaxis = list( + tickangle = column_text_angle, tickvals = 1:nrow(x), ticktext = rownames(x), showticklabels = TRUE ) From c8a679e8690aaec7262511735a4445716d246e30 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 21:58:24 +0000 Subject: [PATCH 28/46] Remove class assignment --- R/heatmaply.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 2e79f89..8a6a208 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -659,6 +659,5 @@ heatmaply.heatmapr <- function(x, margin = list(l = margins[2], b = margins[1], t = margins[3], r = margins[4]), legend = list(y=1, yanchor="top") ) - class(l) <- c("heatmaply", class(l)) l } From 54b7221cec48cee3c1807b6c2260aed1a3191848 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 22:17:26 +0000 Subject: [PATCH 29/46] Remove guff --- R/plots.R | 88 ------------------------------------------------------- 1 file changed, 88 deletions(-) diff --git a/R/plots.R b/R/plots.R index d421b88..76e5399 100644 --- a/R/plots.R +++ b/R/plots.R @@ -1,91 +1,3 @@ -# -# # source: http://www.peterhaschke.com/r/2013/04/24/MultiPlot.html -# # http://rstudio-pubs-static.s3.amazonaws.com/2852_379274d7c5734f979e106dcf019ec46c.html -# multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) { -# # library(grid) -# -# plots <- c(list(...), plotlist) -# -# numPlots = length(plots) -# -# if (is.null(layout)) { -# layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), -# ncol = cols, nrow = ceiling(numPlots/cols)) -# } -# -# if (numPlots == 1) { -# print(plots[[1]]) -# -# } else { -# grid.newpage() -# pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) -# -# for (i in 1:numPlots) { -# matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) -# -# print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, -# layout.pos.col = matchidx$col)) -# } -# } -# } - -# grid, -# gridExtra - -#' @title Creates a ggplot2 heatmap -#' -#' @description -#' An object of class heatmapr includes all the needed information -#' for producing a heatmap. The goal is to seperate the pre-processing of the -#' heatmap elements from the graphical rendaring of the object, which could be done -#' -#' @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 ... other parameters passed to \link{heatmapr} (currently, various parameters may be ignored. -#' -#' @export -#' @examples -#' \dontrun{ -#' -#' library(heatmaply) -#' x <- heatmapr(iris[,-5], scale = "column", colors = "Blues") -#' ggheatmap(x) -#' -#' -#' } -# ggheatmap <- function(x, ...) { -# if(!is.heatmapr(x)) { -# x <- heatmapr(x, ...) -# } -# ppxpy <- heatmaply(x, return_ppxpy = TRUE) -# ggempty <- ggplot() + geom_blank() + theme_bw() -# gg_list <- list(ppxpy$py, ggempty, ppxpy$p, ppxpy$px) -# # gg_list <- list(ppxpy$py, ppxpy$p, ggempty, ppxpy$px) -# # sapply(ppxpy, class) -# # lapply(gg_list, class) -# GGally::ggmatrix(gg_list, nrow = 2, ncol = 2) # in this we can't control the relative widths -# # multiplot(ppxpy$py, ggempty, ppxpy$p, ppxpy$px, - -# # pp <- ppxpy$p + guides(fill=FALSE) + -# # theme(axis.title.x=element_blank(), -# # axis.text.x=element_blank(), -# # axis.ticks.x=element_blank(), -# # axis.title.y=element_blank(), -# # axis.text.y=element_blank(), -# # axis.ticks.y=element_blank()) -# # multiplot(ppxpy$py, pp , ggempty, ppxpy$px, -# # layout = matrix(c(1,2,2,1,2,2,3,4,4), nrow = 3) , -# # cols = 2, main = "Main title") - -# # ppxpy$p + guides(fill=FALSE) - -# } - - - - - # xx is a data matrix ggplot_heatmap <- function(xx, row_text_angle = 0, From 11245b2a23876bab32bc79efbf03436bd2f91e31 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 22:19:01 +0000 Subject: [PATCH 30/46] Explicit import --- R/plots.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/plots.R b/R/plots.R index 76e5399..f06e0b1 100644 --- a/R/plots.R +++ b/R/plots.R @@ -78,7 +78,7 @@ plotly_heatmap <- function(x, limits = range(x), colors, tickvals = 1:nrow(x), ticktext = rownames(x), showticklabels = TRUE ) - ) %>% colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) + ) %>% plotly::colorbar(lenmode = "fraction", y = 0, yanchor="bottom", len=0.3) } @@ -102,7 +102,7 @@ make_colorscale <- function(colors) { } col2plotlyrgb <- function(col) { - rgb <- col2rgb(col) + rgb <- grDevices::col2rgb(col) paste0( "rgb(", rgb["red", ], ",", From d4f204f6f879e4384ae152de126828881f55ac6c Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 22:35:13 +0000 Subject: [PATCH 31/46] Fix errors --- NAMESPACE | 1 - man/ggplot_heatmap.Rd | 34 ---------------------------------- tests/test_heatmaply_default.R | 1 - 3 files changed, 36 deletions(-) delete mode 100644 man/ggplot_heatmap.Rd delete mode 100644 tests/test_heatmaply_default.R diff --git a/NAMESPACE b/NAMESPACE index 5317441..b1b7e4e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,7 +8,6 @@ S3method(normalize,matrix) S3method(percentize,data.frame) S3method(percentize,default) S3method(percentize,matrix) -export(ggplot_heatmap) export(heatmaply) export(heatmapr) export(is.heatmapr) diff --git a/man/ggplot_heatmap.Rd b/man/ggplot_heatmap.Rd deleted file mode 100644 index 3afba12..0000000 --- a/man/ggplot_heatmap.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plots.R -\name{ggplot_heatmap} -\alias{ggplot_heatmap} -\title{Creates a ggplot2 heatmap} -\usage{ -ggplot_heatmap(xx, row_text_angle = 0, column_text_angle = 45, - scale_fill_gradient_fun = scale_fill_gradientn(colors = viridis(n = 256, - alpha = 1, begin = 0, end = 1, option = "viridis"), na.value = "grey50", - limits = NULL), grid_color = NA, grid_size = 0.1, key.title = NULL, - layers, row_dend_left = FALSE, ...) -} -\arguments{ -\item{...}{other parameters passed to \link{heatmapr} (currently, various parameters may be ignored.} - -\item{x}{can either be a heatmapr object, or a numeric matrix -Defaults to \code{TRUE} unless \code{x} contains any \code{NA}s.} -} -\description{ -An object of class heatmapr includes all the needed information -for producing a heatmap. The goal is to seperate the pre-processing of the -heatmap elements from the graphical rendaring of the object, which could be done -} -\examples{ -\dontrun{ - -library(heatmaply) -x <- heatmapr(iris[,-5], scale = "column", colors = "Blues") -ggheatmap(x) - - -} -} - diff --git a/tests/test_heatmaply_default.R b/tests/test_heatmaply_default.R deleted file mode 100644 index b303338..0000000 --- a/tests/test_heatmaply_default.R +++ /dev/null @@ -1 +0,0 @@ -heatmaply.default \ No newline at end of file From 5d156ea3dc6c878c0f63eb8102cbd2f530fc4c2b Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 23:06:24 +0000 Subject: [PATCH 32/46] Remove unused test files --- tests/test_heatmap_subplot_from_ggplotly.R | 1 - tests/test_heatmaply.R | 1 - tests/test_heatmaply_heatmapr.R | 1 - tests/test_heatmapr.R | 1 - tests/test_sidecolorplot.R | 4 ---- 5 files changed, 8 deletions(-) delete mode 100644 tests/test_heatmap_subplot_from_ggplotly.R delete mode 100644 tests/test_heatmaply.R delete mode 100644 tests/test_heatmaply_heatmapr.R delete mode 100644 tests/test_heatmapr.R delete mode 100644 tests/test_sidecolorplot.R diff --git a/tests/test_heatmap_subplot_from_ggplotly.R b/tests/test_heatmap_subplot_from_ggplotly.R deleted file mode 100644 index 8b13789..0000000 --- a/tests/test_heatmap_subplot_from_ggplotly.R +++ /dev/null @@ -1 +0,0 @@ - diff --git a/tests/test_heatmaply.R b/tests/test_heatmaply.R deleted file mode 100644 index 51b0e21..0000000 --- a/tests/test_heatmaply.R +++ /dev/null @@ -1 +0,0 @@ -expect_that(heatmaply(mtcars), is_a("heatmaply")) diff --git a/tests/test_heatmaply_heatmapr.R b/tests/test_heatmaply_heatmapr.R deleted file mode 100644 index 5482108..0000000 --- a/tests/test_heatmaply_heatmapr.R +++ /dev/null @@ -1 +0,0 @@ -expect_that(heatmaply.heatmapr(mtcars), is_a("plotly")) \ No newline at end of file diff --git a/tests/test_heatmapr.R b/tests/test_heatmapr.R deleted file mode 100644 index 814b68a..0000000 --- a/tests/test_heatmapr.R +++ /dev/null @@ -1 +0,0 @@ -expect_that(heatmapr(mtcars), is_a("heatmapr")) \ No newline at end of file diff --git a/tests/test_sidecolorplot.R b/tests/test_sidecolorplot.R deleted file mode 100644 index 4adfc92..0000000 --- a/tests/test_sidecolorplot.R +++ /dev/null @@ -1,4 +0,0 @@ -## Normal -expect_that(side_color_plot(mtcars[,1:2]), ) -## Error -expect_that(side_color_plot(mtcars[, 1]), ) From 1d8fed529efc9b80b9e09e1921f420eee4763154 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Wed, 22 Mar 2017 23:07:00 +0000 Subject: [PATCH 33/46] Fix description --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 92d3ae5..3c15710 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,7 +44,6 @@ Suggests: covr, rmarkdown, gplots, - htmlwidgets, RColorBrewer, testthat VignetteBuilder: knitr From 3bcbe2a1bb5d45941d71ae2c455a50d412a4a9d5 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Thu, 23 Mar 2017 22:21:46 +0000 Subject: [PATCH 34/46] Add test for percentize --- R/percentize.R | 5 +---- tests/testthat/test_misc.R | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/R/percentize.R b/R/percentize.R index 9900207..b205ee7 100644 --- a/R/percentize.R +++ b/R/percentize.R @@ -165,10 +165,7 @@ normalize.data.frame <- function(x, ...) { ss_numeric <- sapply(x, is.numeric) normalize - - for(i in which(ss_numeric)) { - x[, i] <- normalize(x[, i]) - } + x[, ss_numeric] <- lapply(x[, ss_numeric], normalize) x } diff --git a/tests/testthat/test_misc.R b/tests/testthat/test_misc.R index 9b48345..a858421 100644 --- a/tests/testthat/test_misc.R +++ b/tests/testthat/test_misc.R @@ -4,3 +4,18 @@ test_that("is.na10", { tf <- rep(c(NA, FALSE), length.out = 10) expect_equal(is.na10(tf), as.integer(is.na(tf))) }) + +test_that("normalize", { + a <- seq(0,1, by=0.01) + expect_equal(normalize(a), a) + b <- 1:1000000 + expect_true(all(normalize(b) <= 1 && all(normalize(b) >= 0))) + + d <- data.frame(a=a[1:101], b=b[1:101], c="c") + dn <- normalize(d) + expect_equal(normalize(d[, 1:2]), normalize(as.matrix(d[, 1:2]))) + expect_equal(dn[, 1], a) + expect_true(all(dn[[3]] == "c")) +}) + + From 246a62814f9f73803d11871e59e30c4b4d59599e Mon Sep 17 00:00:00 2001 From: Alanocallaghan Date: Thu, 30 Mar 2017 18:27:57 +0100 Subject: [PATCH 35/46] Update heatmaply.Rmd --- vignettes/heatmaply.Rmd | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/vignettes/heatmaply.Rmd b/vignettes/heatmaply.Rmd index 0091e87..69c3d4d 100644 --- a/vignettes/heatmaply.Rmd +++ b/vignettes/heatmaply.Rmd @@ -81,16 +81,16 @@ Default ```{r} library(heatmaply) -heatmaply(mtcars) +heatmaply(scale(mtcars)) ``` -Because the labels are somewhat long, we need to manually fix the margins (hopefully this will be fixed in future versions of plot.ly). This also allows the inclusion of xlab/ylab/main texts. +Because the labels are somewhat long, we need to manually fix the margins (hopefully this will be fixed in future versions of plotly). This also allows the inclusion of xlab/ylab/main texts. ```{r} -heatmaply(mtcars, xlab = "Features", ylab = "Cars", +heatmaply(scale(mtcars), xlab = "Features", ylab = "Cars", main = "An example of title and xlab/ylab", margins = c(60,100,40,20) ) -# heatmaply(mtcars) %>% layout(margin = list(l = 130, b = 40)) +# heatmaply(mtcars) %>% layout(margin = list(l = 130, b = 40), xaxis=list(tickfont=5)) ``` We can use this with correlation. Notice the use of limits to set the range of the colors, and how we color the branches: @@ -102,32 +102,34 @@ heatmaply(cor(mtcars), margins = c(40, 40), ``` -Various setiation options +Various seriation options ------------------- -heatmaply uses the `seriation` package to find optimal ordering of rows and columns. Optimal means to optimze the Hamiltonian path length that is restricted by the dendrogram structure. Which, in other words, means to rotate the branches so that the sum of distances between each adjacent leaf (label) will be minimized. This is related to a restricted version of the travel salesman problem. The default options is "OLO" (Optimal leaf ordering) which optimizes the above mention critirion (it works in O(n^4)). Another option is "GW" (Gruvaeus and Wainer) which aims for the same goal but uses a (faster?) heuristic. The option "mean" gives the output we would get by default from heatmap functions in other packages such as `gplots::heatmap.2`. The option "none" gives us the dendrograms without any rotation. +heatmaply uses the `seriation` package to find an optimal ordering of rows and columns. Optimal means to optimze the Hamiltonian path length that is restricted by the dendrogram structure. This, in other words, means to rotate the branches so that the sum of distances between each adjacent leaf (label) will be minimized. This is related to a restricted version of the travelling salesman problem. + +The default options is "OLO" (Optimal leaf ordering) which optimizes the above criterion (in O(n^4)). Another option is "GW" ([Gruvaeus and Wainer](https://www.researchgate.net/publication/230266994_Two_additions_to_hierarchical_cluster_analysis)) which aims for the same goal but uses a potentially faster heuristic. The option "mean" gives the output we would get by default from heatmap functions in other packages such as `gplots::heatmap.2`. The option "none" gives us the dendrograms without any rotation. ```{r} # The default of heatmaply: -heatmaply(mtcars[1:10,], margins = c(40, 130), +heatmaply(scale(mtcars[1:10,]), margins = c(40, 130), seriate = "OLO") ``` ```{r} # Similar to OLO but less optimal (since it is a heuristic) -heatmaply(mtcars[1:10,], margin = c(40, 130), +heatmaply(scale(mtcars[1:10,]), margin = c(40, 130), seriate = "GW") ``` ```{r} # the default by gplots::heatmaply.2 -heatmaply(mtcars[1:10,], margins = c(40, 130), +heatmaply(scale(mtcars[1:10,]), margins = c(40, 130), seriate = "mean") ``` ```{r} # the default output from hclust -heatmaply(mtcars[1:10,], margins = c(40, 130), +heatmaply(scale(mtcars[1:10,](, margins = c(40, 130), seriate = "none") ``` @@ -165,7 +167,7 @@ heatmaply(x, Rowv = row_dend, Colv = col_dend) Changing color palettes ------------------- -We can use different colors than the default `viridis`. For example, we may want to use other color pallates in order to get divergent colors for the correlations (these will sadly be less friendly for color blind people): +We can use colors other than the default `viridis`. For example, we may want to use other color palettes in order to get divergent colors for the correlations (these will, sadly, be less useful for colorblind people): ```{r} # divergent_viridis_magma <- c(rev(viridis(100, begin = 0.3)), magma(100, begin = 0.3)) @@ -235,7 +237,7 @@ x <- as.matrix(datasets::mtcars) gplots::heatmap.2(x, trace = "none", col = viridis(100), key = FALSE) ``` -And heatmaply (the only difference is the side of the row dendrogram. This might be possible to modify in future versions of ggplot/plotly/heatmaply): +With heatmaply, the only difference is the side of the row dendrogram. This might be possible to modify in future versions of heatmaply: ```{r} heatmaply::heatmaply(x, seriate = "mean") From 2c271614b639a6539250094f4d82e3ed88091dd9 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 12:12:33 +0100 Subject: [PATCH 36/46] Update docs and namespace --- NAMESPACE | 1 - man/heatmaply.Rd | 5 +++-- man/side_color_plot.Rd | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 86c94ae..536f56e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,7 +42,6 @@ export(is.heatmapr) export(is.na10) export(normalize) export(percentize) -export(side_color_plot) import(dendextend) import(ggplot2) importFrom(assertthat,assert_that) diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 1837d4a..35744f5 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -24,7 +24,8 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, row_side_palette, col_side_colors = NULL, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6, file, long_data) + branches_lwd = 0.6, file, long_data, label_names = c("row", "column", + "value")) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -37,7 +38,7 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, row_side_colors = NULL, row_side_palette, col_side_colors = NULL, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, - branches_lwd = 0.6) + branches_lwd = 0.6, label_names) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index 975c850..74c1efa 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -5,7 +5,7 @@ \title{geom_tile for side color plots} \usage{ side_color_plot(df, palette, scale_title = paste(type, "side colors"), - type = c("column", "row"), row_text_angle, column_text_angle, is_colors) + type = c("column", "row"), text_angle, is_colors, label_name) } \arguments{ \item{df}{A "molten" data.frame as produced by (eg) reshape2::melt} @@ -17,7 +17,7 @@ plot} \item{type}{Horizontal or vertical plot? Valid values are "column" and "row"} -\item{row_text_angle, column_text_angle}{the angle of the text of the rows/columns.} +\item{text_angle}{the angle of the text of the rows/columns.} \item{is_colors}{Use if the values in df are valid colours and should not be mapped to a color scheme, and instead should be plotted directly.} From 81aafe41b2b60a2b7ecedb1607b91dd50937101c Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 14:49:08 +0100 Subject: [PATCH 37/46] Cellnote implementation --- NAMESPACE | 3 +- R/heatmaply.R | 27 ++++++++---- R/heatmapr.R | 50 +++++++++------------- R/plots.R | 75 +++++++++++++++++++++++---------- man/heatmaply.Rd | 27 +++++++----- man/heatmapr.Rd | 7 +-- man/side_color_plot.Rd | 5 ++- tests/testthat/test_heatmaply.R | 4 +- 8 files changed, 118 insertions(+), 80 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 947eb03..9b3fbc2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,10 +41,10 @@ export(is.heatmapr) export(is.na10) export(normalize) export(percentize) -export(side_color_plot) import(dendextend) import(ggplot2) importFrom(assertthat,assert_that) +importFrom(dendextend,as.ggdend) importFrom(dendextend,color_branches) importFrom(dendextend,find_k) importFrom(dendextend,is.dendrogram) @@ -52,7 +52,6 @@ importFrom(dendextend,is.hclust) importFrom(dendextend,rotate) importFrom(dendextend,seriate_dendrogram) importFrom(dendextend,set) -importFrom(ggdendro,dendro_data) importFrom(htmlwidgets,saveWidget) importFrom(plotly,add_segments) importFrom(plotly,config) diff --git a/R/heatmaply.R b/R/heatmaply.R index bda7e97..b915280 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -35,6 +35,11 @@ #' 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 Mouseover values for the data. Useful if applying scaling. +#' @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 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. @@ -255,6 +260,8 @@ heatmaply.default <- function(x, row_text_angle = 0, column_text_angle = 45, subplot_margin = 0, + cellnote = NULL, + draw_cellnote = !is.null(cellnote), ## dendrogram control Rowv, @@ -296,8 +303,8 @@ heatmaply.default <- function(x, row_side_palette, col_side_colors, col_side_palette, - ColSideColors, - RowSideColors, + ColSideColors = NULL, + RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6, file, @@ -324,10 +331,10 @@ heatmaply.default <- function(x, if(!missing(srtRow)) row_text_angle <- srtRow if(!missing(srtCol)) column_text_angle <- srtCol - if (!missing(ColSideColors)) { + if (!is.null(ColSideColors)) { col_side_colors <- ColSideColors } - if (!missing(RowSideColors)) { + if (!is.null(RowSideColors)) { row_side_colors <- RowSideColors } @@ -365,6 +372,8 @@ heatmaply.default <- function(x, row_side_colors = row_side_colors, col_side_colors = col_side_colors, + cellnote = cellnote, + ## dendrogram control Rowv = Rowv, Colv = Colv, @@ -394,7 +403,6 @@ heatmaply.default <- function(x, 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, @@ -409,10 +417,10 @@ heatmaply.default <- function(x, heatmap_layers = heatmap_layers, ColSideColors = ColSideColors, RowSideColors = RowSideColors, - heatmap_layers = heatmap_layers, branches_lwd = branches_lwd, label_names = label_names, - plot_method = plot_method + plot_method = plot_method, + draw_cellnote = draw_cellnote ) # TODO: think more on what should be passed in "..." if(!missing(file)) hmly %>% saveWidget(file = file, selfcontained = TRUE) @@ -553,6 +561,7 @@ heatmaply.heatmapr <- function(x, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, + draw_cellnote = FALSE, row_side_colors, row_side_palette, col_side_colors, @@ -630,12 +639,14 @@ heatmaply.heatmapr <- function(x, # create the heatmap data_mat <- x$matrix$data - if (plot_method == "ggplot") { + if (plot_method == "ggplot") { p <- ggplot_heatmap(data_mat, row_text_angle, column_text_angle, scale_fill_gradient_fun, grid_color, + cellnote = x$matrix$cellnote, + draw_cellnote = draw_cellnote, key.title = key.title, layers = heatmap_layers, row_dend_left = row_dend_left, diff --git a/R/heatmapr.R b/R/heatmapr.R index df6d2cf..a2c331a 100644 --- a/R/heatmapr.R +++ b/R/heatmapr.R @@ -76,8 +76,6 @@ #' @param digits integer indicating the number of decimal places to be used by \link{round} for 'label'. #' @param cellnote (optional) matrix of the same dimensions as \code{x} that has the human-readable version of each value, for displaying to the user on hover. If \code{NULL}, then \code{x} will be coerced using \code{\link{as.character}}. #' If missing, it will use \code{x}, after rounding it based on the \code{digits} parameter. -#' @param cellnote_scale logical (default is TRUE). IF cellnote is missing and x is used, -#' should cellnote be scaled if x is also scaled? #' #' @param cexRow positive numbers. If not missing, it will override \code{xaxis_font_size} #' and will give it a value cexRow*14 @@ -120,9 +118,8 @@ heatmapr <- function(x, Colv, distfun = dist, hclustfun = hclust, - dist_method = NULL, - hclust_method = NULL, - + dist_method = NULL, + hclust_method = NULL, distfun_row, hclustfun_row, @@ -151,7 +148,6 @@ heatmapr <- function(x, ## value formatting digits = 3L, cellnote, - cellnote_scale = TRUE, ##TODO: decide later which names/conventions to keep theme = NULL, @@ -367,9 +363,11 @@ heatmapr <- function(x, ## reorder x (and others) ##======================= x <- x[rowInd, colInd, drop = FALSE] - if (!missing(cellnote)) + if (is.null(cellnote)) { + cellnote <- x + } else { cellnote <- cellnote[rowInd, colInd, drop = FALSE] - + } if (!missing(row_side_colors)) { if(!(is.data.frame(row_side_colors) | is.matrix(row_side_colors))) { @@ -408,13 +406,10 @@ heatmapr <- function(x, rowDend <- if(is.dendrogram(Rowv)) Rowv else NULL colDend <- if(is.dendrogram(Colv)) Colv else NULL - ## Scale the data? ##==================== scale <- match.arg(scale) - if(!cellnote_scale) x_unscaled <- x #keeps a backup for cellnote - if(scale == "row") { x <- sweep(x, 1, rowMeans(x, na.rm = na.rm)) x <- sweep(x, 1, apply(x, 1, sd, na.rm = na.rm), "/") @@ -427,30 +422,27 @@ heatmapr <- function(x, ## cellnote ##==================== - if(missing(cellnote)) { - if(cellnote_scale) { - cellnote <- round(x, digits = digits) - } else { # default - cellnote <- round(x_unscaled, digits = digits) - } - } + cellnote <- round(x, digits = digits) + # Check that cellnote is o.k.: - if (is.null(dim(cellnote))) { - if (length(cellnote) != nr*nc) { - stop("Incorrect number of cellnote values") + if (!is.null(cellnote)) { + if (is.null(dim(cellnote))) { + if (length(cellnote) != nr*nc) { + stop("Incorrect number of cellnote values") + } + dim(cellnote) <- dim(x) + } + if (!identical(dim(x), dim(cellnote))) { + stop("cellnote matrix must have same dimensions as x") } - dim(cellnote) <- dim(x) - } - if (!identical(dim(x), dim(cellnote))) { - stop("cellnote matrix must have same dimensions as x") } - ## Final touches before exporting the object ##======================= - mtx <- list(data = as.matrix(cellnote), + mtx <- list(data = as.matrix(x), + cellnote = cellnote, dim = dim(x), rows = rownames(x), cols = colnames(x) @@ -489,8 +481,8 @@ heatmapr <- function(x, c(options, list(xclust_height = 0)) } - heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, # image = imgUri, - theme = theme, options = options) + heatmapr <- list(rows = rowDend, cols = colDend, matrix = mtx, + theme = theme, options = options, cellnote = cellnote) if (!missing(row_side_colors)) heatmapr[["row_side_colors"]] <- row_side_colors if (!missing(col_side_colors)) heatmapr[["col_side_colors"]] <- col_side_colors diff --git a/R/plots.R b/R/plots.R index 807a1d1..3a834fa 100644 --- a/R/plots.R +++ b/R/plots.R @@ -13,6 +13,8 @@ ggplot_heatmap <- function(xx, key.title = NULL, layers, row_dend_left = FALSE, + cellnote = NULL, + draw_cellnote = FALSE, label_names, ...) { theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), @@ -41,13 +43,31 @@ ggplot_heatmap <- function(xx, } else { df[[row]] <- 1:nrow(xx) } - + df[[row]] <- factor( df[[row]], - levels=df[[row]], - ordered=TRUE + levels = df[[row]], + ordered = TRUE ) + if (!is.null(cellnote)) { + cellnote <- as.data.frame(cellnote) + # colnames(df) <- x$matrix$cols + if(!is.null(rownames(cellnote))) { + cellnote[[row]] <- rownames(cellnote) + } else { + cellnote[[row]] <- 1:nrow(cellnote) + } + cellnote[[row]] <- factor( + cellnote[[row]], + levels = cellnote[[row]], + ordered = TRUE + ) + mdf_c <- reshape2::melt(cellnote, id.vars=row) + mdf_c[, 3] <- as.factor(mdf_c[, 3]) + colnames(mdf_c)[2:3] <- c(col, val) + } + mdf <- reshape2::melt(df, id.vars=row) colnames(mdf)[2:3] <- c(col, val) # rename "variable" and "value" @@ -65,6 +85,12 @@ ggplot_heatmap <- function(xx, axis.text.y = element_text(angle = row_text_angle, hjust = 1) ) + if (!is.null(cellnote) && draw_cellnote) { + p <- p + geom_text( + data = mdf_c, + mapping = aes_string(x = col, y = row, label = val)) + } + if(!missing(layers)) p <- p + layers ## Passed in to allow users to alter (courtesy of GenVisR) @@ -86,7 +112,6 @@ ggplot_heatmap <- function(xx, } - plotly_heatmap <- function(x, limits = range(x), colors, row_text_angle=0, column_text_angle=45, grid.color, grid.size, key.title, row_dend_left) { @@ -138,10 +163,10 @@ col2plotlyrgb <- function(col) { ) } -#' @importFrom ggdendro dendro_data +#' @importFrom dendextend as.ggdend plotly_dend_row <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) - segs <- dend_data$segment + dend_data <- as.ggdend(dend) + segs <- dend_data$segments p <- plot_ly(segs) %>% add_segments(x = ~y, xend = ~yend, y = ~x, yend = ~xend, line=list(color = '#000000'), showlegend = FALSE, hoverinfo = "none") %>% @@ -166,9 +191,10 @@ plotly_dend_row <- function(dend, flip = FALSE) { p } + plotly_dend_col <- function(dend, flip = FALSE) { - dend_data <- dendro_data(dend) - segs <- dend_data$segment + dend_data <- as.ggdend(dend) + segs <- dend_data$segments plot_ly(segs) %>% add_segments(x = ~x, xend = ~xend, y = ~y, yend = ~yend, @@ -191,6 +217,7 @@ plotly_dend_col <- function(dend, flip = FALSE) { + #' #' geom_tile for side color plots #' @@ -199,28 +226,30 @@ plotly_dend_col <- function(dend, flip = FALSE) { #' plot #' @param scale_title Title of the color scale. Not currently used. #' @param type Horizontal or vertical plot? Valid values are "column" and "row" -#' @param row_text_angle,column_text_angle the angle of the text of the rows/columns. +#' @param text_angle the angle of the text of the rows/columns. #' @param is_colors Use if the values in df are valid colours and should not be mapped #' to a color scheme, and instead should be plotted directly. #' #' @return A ggplot geom_tile object -#' -#' @export side_color_plot <- function(df, palette, scale_title = paste(type, "side colors"), type = c("column", "row"), - row_text_angle, column_text_angle, is_colors) { + text_angle = if (type == "row") 0 else 90, is_colors = FALSE, + label_name = type) { if (is.matrix(df)) df <- as.data.frame(df) - stopifnot(is.data.frame(df)) + assert_that(is.data.frame(df)) + + ## Cooerce to character + df[] <- lapply(df, as.character) ## TODO: Find out why names are dropped when dim(df)[2] == 1 original_dim <- dim(df) - if (missing(column_text_angle)) column_text_angle <- 0 - if (missing(row_text_angle)) row_text_angle <- 45 if (missing(palette)) palette <- colorspace::rainbow_hcl type <- match.arg(type) + ## Custom label + if (!missing(label_name)) type <- label_name if (type %in% colnames(df)) stop("Having", type, "in the colnames of the side_color df will drop data!") @@ -231,10 +260,11 @@ side_color_plot <- function(df, palette, df[["value"]] <- factor(df[["value"]]) id_var <- colnames(df)[1] + if (type == "column") { - mapping <- aes_string(x = id_var, y = 'variable', fill = 'value') + mapping <- aes_string(x = id_var, y = "variable", fill = "value") if(original_dim[2] > 1) { - text_element <- element_text(angle = column_text_angle) + text_element <- element_text(angle = text_angle) } else text_element <- element_blank() theme <- theme( @@ -244,10 +274,10 @@ side_color_plot <- function(df, palette, axis.ticks = element_blank()) } else { if(original_dim[2] > 1) { - text_element <- element_text(angle = row_text_angle) + text_element <- element_text(angle = text_angle) } else text_element <- element_blank() - mapping <- aes_string(x = 'variable', y = id_var, fill = 'value') + mapping <- aes_string(x = "variable", y = id_var, fill = "value") theme <- theme( panel.background = element_blank(), axis.text.x = text_element, @@ -256,7 +286,7 @@ side_color_plot <- function(df, palette, } color_vals <- if (is_colors) levels(df[["value"]]) - else palette(length(unique(df[["value"]]))) + else palette(nlevels(df[["value"]])) g <- ggplot(df, mapping = mapping) + geom_raster() + @@ -268,5 +298,4 @@ side_color_plot <- function(df, palette, values = color_vals) + theme return(g) -} - +} \ No newline at end of file diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index e720280..b920442 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -10,8 +10,9 @@ heatmaply(x, ...) \method{heatmaply}{default}(x, 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, Rowv, - Colv, distfun = dist, hclustfun = hclust, dist_method = NULL, + row_text_angle = 0, column_text_angle = 45, subplot_margin = 0, + cellnote = NULL, draw_cellnote = !is.null(cellnote), Rowv, Colv, + distfun = dist, hclustfun = hclust, dist_method = NULL, hclust_method = NULL, distfun_row, hclustfun_row, distfun_col, hclustfun_col, dendrogram = c("both", "row", "column", "none"), reorderfun = function(d, w) reorder(d, w), k_row, k_col, symm = FALSE, @@ -21,10 +22,10 @@ heatmaply(x, ...) limits), grid_color = NA, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, key.title = NULL, return_ppxpy = FALSE, row_side_colors, row_side_palette, - col_side_colors, col_side_palette, ColSideColors, RowSideColors, - heatmap_layers = NULL, branches_lwd = 0.6, file, long_data, - plot_method = c("ggplot", "plotly"), label_names = c("row", "column", - "value")) + col_side_colors, col_side_palette, ColSideColors = NULL, + RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6, file, + long_data, plot_method = c("ggplot", "plotly"), label_names = c("row", + "column", "value")) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -34,10 +35,10 @@ heatmaply(x, ...) (is.function(colors)) colors(256) else colors, na.value = na.value, limits = limits), grid_color = NA, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, - key.title = NULL, return_ppxpy = FALSE, row_side_colors, row_side_palette, - col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), - ColSideColors, RowSideColors, heatmap_layers = NULL, branches_lwd = 0.6, - label_names) + key.title = NULL, return_ppxpy = FALSE, draw_cellnote = FALSE, + row_side_colors, row_side_palette, col_side_colors, col_side_palette, + plot_method = c("ggplot", "plotly"), ColSideColors, RowSideColors, + heatmap_layers = NULL, branches_lwd = 0.6, label_names) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix @@ -65,6 +66,12 @@ 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.} +\item{cellnote}{Mouseover values for the data. Useful if applying scaling.} + +\item{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.} + \item{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.} \item{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.} diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index c0b10c9..8ac625f 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -13,8 +13,8 @@ heatmapr(x, Rowv, Colv, distfun = dist, hclustfun = hclust, reorderfun = function(d, w) reorder(d, w), k_row, k_col, symm = FALSE, revC, scale = c("none", "row", "column"), na.rm = TRUE, labRow = rownames(x), labCol = colnames(x), cexRow, cexCol, digits = 3L, - cellnote, cellnote_scale = TRUE, theme = NULL, colors = "RdYlBu", - width = NULL, height = NULL, xaxis_height = 80, yaxis_width = 120, + cellnote, theme = NULL, colors = "RdYlBu", width = NULL, + height = NULL, xaxis_height = 80, yaxis_width = 120, xaxis_font_size = NULL, yaxis_font_size = NULL, brush_color = "#0000FF", show_grid = TRUE, anim_duration = 500, row_side_colors, col_side_colors, seriate = c("OLO", "mean", "none", "GW"), ...) @@ -82,9 +82,6 @@ and will give it a value cexCol*14} \item{cellnote}{(optional) matrix of the same dimensions as \code{x} that has the human-readable version of each value, for displaying to the user on hover. If \code{NULL}, then \code{x} will be coerced using \code{\link{as.character}}. If missing, it will use \code{x}, after rounding it based on the \code{digits} parameter.} -\item{cellnote_scale}{logical (default is TRUE). IF cellnote is missing and x is used, -should cellnote be scaled if x is also scaled?} - \item{theme}{A custom CSS theme to use. Currently the only valid values are \code{""} and \code{"dark"}. \code{"dark"} is primarily intended for standalone visualizations, not R Markdown or Shiny.} diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index c9a7b1c..cd7f85e 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -5,7 +5,8 @@ \title{geom_tile for side color plots} \usage{ side_color_plot(df, palette, scale_title = paste(type, "side colors"), - type = c("column", "row"), row_text_angle, column_text_angle, is_colors) + type = c("column", "row"), text_angle = if (type == "row") 0 else 90, + is_colors = FALSE, label_name = type) } \arguments{ \item{df}{A "molten" data.frame as produced by (eg) reshape2::melt} @@ -17,7 +18,7 @@ plot} \item{type}{Horizontal or vertical plot? Valid values are "column" and "row"} -\item{row_text_angle, column_text_angle}{the angle of the text of the rows/columns.} +\item{text_angle}{the angle of the text of the rows/columns.} \item{is_colors}{Use if the values in df are valid colours and should not be mapped to a color scheme, and instead should be plotted directly.} diff --git a/tests/testthat/test_heatmaply.R b/tests/testthat/test_heatmaply.R index 20bb967..d10a1e4 100644 --- a/tests/testthat/test_heatmaply.R +++ b/tests/testthat/test_heatmaply.R @@ -1,4 +1,6 @@ -for (plot_method in c("ggplot", "plotly")) { +for (plot_method in c( + # "ggplot", + "plotly")) { for (bool in c(TRUE, FALSE)) { context(paste0(plot_method, ", row_dend_left=", bool)) From 23926ad52dc642662c9a36f31b9517751f150201 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 15:55:17 +0100 Subject: [PATCH 38/46] Update vignette --- vignettes/heatmaply.Rmd | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/vignettes/heatmaply.Rmd b/vignettes/heatmaply.Rmd index 915fc3c..a842429 100644 --- a/vignettes/heatmaply.Rmd +++ b/vignettes/heatmaply.Rmd @@ -84,11 +84,14 @@ library(heatmaply) heatmaply(scale(mtcars)) ``` +It is probably more useful to use scaling. heatmaply supports column +and row scaling using the "scale" parameter. Because the labels are somewhat long, we need to manually fix the margins (hopefully this will be fixed in future versions of plotly). This also allows the inclusion of xlab/ylab/main texts. ```{r} -heatmaply(scale(mtcars), xlab = "Features", ylab = "Cars", +heatmaply(mtcars, xlab = "Features", ylab = "Cars", main = "An example of title and xlab/ylab", + scale = "column", margins = c(60,100,40,20) ) # heatmaply(mtcars) %>% layout(margin = list(l = 130, b = 40), xaxis=list(tickfont=5)) ``` @@ -111,26 +114,26 @@ The default options is "OLO" (Optimal leaf ordering) which optimizes the above c ```{r} # The default of heatmaply: -heatmaply(scale(mtcars[1:10,]), margins = c(40, 130), - seriate = "OLO") +heatmaply(mtcars[1:10,], margins = c(40, 130), + seriate = "OLO", scale = "column") ``` ```{r} # Similar to OLO but less optimal (since it is a heuristic) -heatmaply(scale(mtcars[1:10,]), margin = c(40, 130), - seriate = "GW") +heatmaply(mtcars[1:10,], margin = c(40, 130), + seriate = "GW", scale = "column") ``` ```{r} # the default by gplots::heatmaply.2 -heatmaply(scale(mtcars[1:10,]), margins = c(40, 130), - seriate = "mean") +heatmaply(mtcars[1:10,], margins = c(40, 130), + seriate = "mean", scale = "column") ``` ```{r} # the default output from hclust -heatmaply(scale(mtcars[1:10,](, margins = c(40, 130), - seriate = "none") +heatmaply(mtcars[1:10,], margins = c(40, 130), + seriate = "none", scale = "column") ``` This works heavily relies on the seriation package (their [vignette](https://CRAN.R-project.org/package=seriation/vignettes/seriation.pdf) is well worth the read), and also lightly on the dendextend package (see [vignette](https://CRAN.R-project.org/package=dendextend/vignettes/introduction.html) ) @@ -157,7 +160,7 @@ col_dend <- x %>% t %>% dist %>% hclust %>% as.dendrogram %>% ladderize # rotate_DendSer(ser_weight = dist(t(x))) -heatmaply(x, Rowv = row_dend, Colv = col_dend) +heatmaply(x, Rowv = row_dend, Colv = col_dend, scale = "column") ``` @@ -190,13 +193,13 @@ Another example for using colors: ```{r} heatmaply(mtcars, margins = c(40, 130), - colors = heat.colors(100)) + colors = heat.colors(100), scale = "column") ``` Or even more customized colors using `scale_fill_gradient_fun`: ```{r} -heatmaply(mtcars, margins = c(40, 130), +heatmaply(mtcars, margins = c(40, 130), scale = "column", scale_fill_gradient_fun = ggplot2::scale_fill_gradient2(low = "blue", high = "red", midpoint = 200, limits = c(0, 500))) ``` @@ -214,7 +217,7 @@ library(heatmaply) airquality[1:10,] %>% is.na10 %>% heatmaply(color = c("white","black"), grid_color = "grey", k_col =3, k_row = 3, - margins = c(40, 50)) + margins = c(40, 50), scale = "column") # airquality %>% is.na10 %>% # heatmaply(color = c("grey80", "grey20"), # grid_color = "grey", From 8d538f89b1ec60906eda9879ab41c397036c1301 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 16:19:59 +0100 Subject: [PATCH 39/46] Update docs and default for cellnote --- R/heatmapr.R | 2 +- R/plots.R | 1 + man/heatmapr.Rd | 2 +- man/side_color_plot.Rd | 2 ++ 4 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/heatmapr.R b/R/heatmapr.R index a2c331a..57b88b8 100644 --- a/R/heatmapr.R +++ b/R/heatmapr.R @@ -147,7 +147,7 @@ heatmapr <- function(x, ## value formatting digits = 3L, - cellnote, + cellnote = NULL, ##TODO: decide later which names/conventions to keep theme = NULL, diff --git a/R/plots.R b/R/plots.R index 3a834fa..81ff966 100644 --- a/R/plots.R +++ b/R/plots.R @@ -229,6 +229,7 @@ plotly_dend_col <- function(dend, flip = FALSE) { #' @param text_angle the angle of the text of the rows/columns. #' @param is_colors Use if the values in df are valid colours and should not be mapped #' to a color scheme, and instead should be plotted directly. +#' @param label_name Name for the mouseover label, usually "row" or "column" #' #' @return A ggplot geom_tile object side_color_plot <- function(df, palette, diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index 8ac625f..4dbe288 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -13,7 +13,7 @@ heatmapr(x, Rowv, Colv, distfun = dist, hclustfun = hclust, reorderfun = function(d, w) reorder(d, w), k_row, k_col, symm = FALSE, revC, scale = c("none", "row", "column"), na.rm = TRUE, labRow = rownames(x), labCol = colnames(x), cexRow, cexCol, digits = 3L, - cellnote, theme = NULL, colors = "RdYlBu", width = NULL, + cellnote = NULL, theme = NULL, colors = "RdYlBu", width = NULL, height = NULL, xaxis_height = 80, yaxis_width = 120, xaxis_font_size = NULL, yaxis_font_size = NULL, brush_color = "#0000FF", show_grid = TRUE, anim_duration = 500, row_side_colors, col_side_colors, diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index cd7f85e..da1ae97 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -22,6 +22,8 @@ plot} \item{is_colors}{Use if the values in df are valid colours and should not be mapped to a color scheme, and instead should be plotted directly.} + +\item{label_name}{Name for the mouseover label, usually "row" or "column"} } \value{ A ggplot geom_tile object From 46ac6be2111f851c2b19d0345ba49f46023d3d7a Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 16:35:05 +0100 Subject: [PATCH 40/46] Update docs --- DESCRIPTION | 1 - R/heatmaply.R | 1 + man/heatmaply.Rd | 2 ++ 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 31bd955..12c789e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,6 @@ Suggests: covr, rmarkdown, gplots, - RColorBrewer, testthat VignetteBuilder: knitr License: GPL-2 | GPL-3 diff --git a/R/heatmaply.R b/R/heatmaply.R index b915280..c5ebd42 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -143,6 +143,7 @@ #' column you can simply use a sequence of numbers from 1 to the number of "rows" #' inthe data. #' +#' @param label_names Names for labells of x, y and value/fill mouseover. #' #' @export #' @examples diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index b920442..38d9b37 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -183,6 +183,8 @@ inthe data.} \item{plot_method}{Use "ggplot" or "plotly" to choose which library produces heatmap and dendrogram plots} + +\item{label_names}{Names for labells of x, y and value/fill mouseover.} } \description{ An object of class heatmapr includes all the needed information From ccf496c5a453d617fc939ddd247444cf6a4340c6 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sat, 1 Apr 2017 17:19:23 +0100 Subject: [PATCH 41/46] Update docs --- DESCRIPTION | 32 +++++++++++++++++--------------- man/RColorBrewer_colors.Rd | 23 ++++++++++++----------- man/ggheatmap.Rd | 29 ----------------------------- man/heatmaply.Rd | 14 +++----------- man/heatmapr.Rd | 1 + man/is.heatmapr.Rd | 1 + man/is.na10.Rd | 1 + man/normalize.Rd | 3 ++- man/percentize.Rd | 3 ++- man/side_color_plot.Rd | 1 + tests/testthat/test_heatmaply.R | 4 +--- 11 files changed, 41 insertions(+), 71 deletions(-) delete mode 100644 man/ggheatmap.Rd diff --git a/DESCRIPTION b/DESCRIPTION index dfcc9fe..e846db4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,20 +8,22 @@ Authors@R: c(person("Tal", "Galili", role = c("aut", "cre", "cph"), email = person("Jonathan", "Sidi", email = "yonis@metrumrg.com", comment = "https://github.com/yonicd",role = "ctb"), person("Alan", "O'Callaghan", comment = "https://github.com/Alanocallaghan",role = "ctb"), person("Yoav", "Benjamini", email = "ybenja@tau.ac.il",role = "ths")) -Description: Create interactive cluster 'heatmaps' that can be saved as a stand-alone HTML - file, embedded in 'R Markdown' documents or in a 'Shiny' apps, and available in the 'RStudio' viewer pane, . - Hover the mouse pointer over a cell to show details or drag a rectangle to - zoom. A 'heatmap' is a popular graphical method for visualizing high-dimensional - data, in which a table of numbers are encoded as a grid of colored cells. The - rows and columns of the matrix are ordered to highlight patterns and are often - accompanied by 'dendrograms'. 'Heatmaps' are used in many fields for visualizing - observations, correlations, missing values patterns, and more. Interactive - 'heatmaps' allow the inspection of specific value by hovering the mouse over a - cell, as well as zooming into a region of the 'heatmap' by dragging a rectangle - around the relevant area. This work is based on the 'ggplot2' and 'plotly.js' - engine. It produces similar 'heatmaps' as 'heatmap.2' or 'd3heatmap', with the advantage of speed - ('plotly.js' is able to handle larger size matrix), the ability to zoom from the 'dendrogram' panes, - and the placing of factor variables in the sides of the 'heatmap'. +Description: Create interactive cluster 'heatmaps' that can be saved as a stand- + alone HTML file, embedded in 'R Markdown' documents or in a 'Shiny' apps, and + available in the 'RStudio' viewer pane, . Hover the mouse pointer over a cell + to show details or drag a rectangle to zoom. A 'heatmap' is a popular graphical + method for visualizing high-dimensional data, in which a table of numbers + are encoded as a grid of colored cells. The rows and columns of the matrix + are ordered to highlight patterns and are often accompanied by 'dendrograms'. + 'Heatmaps' are used in many fields for visualizing observations, correlations, + missing values patterns, and more. Interactive 'heatmaps' allow the inspection + of specific value by hovering the mouse over a cell, as well as zooming into + a region of the 'heatmap' by dragging a rectangle around the relevant area. + This work is based on the 'ggplot2' and 'plotly.js' engine. It produces + similar 'heatmaps' as 'heatmap.2' or 'd3heatmap', with the advantage of speed + ('plotly.js' is able to handle larger size matrix), the ability to zoom from + the 'dendrogram' panes, and the placing of factor variables in the sides of the + 'heatmap'. Depends: R (>= 3.0.0), plotly (>= 4.5.2), @@ -54,4 +56,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: 5.0.1 diff --git a/man/RColorBrewer_colors.Rd b/man/RColorBrewer_colors.Rd index b001290..6678847 100644 --- a/man/RColorBrewer_colors.Rd +++ b/man/RColorBrewer_colors.Rd @@ -1,30 +1,30 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/RColorBrewer.R \name{RColorBrewer_colors} -\alias{RColorBrewer_colors} -\alias{BrBG} -\alias{PiYG} -\alias{PRGn} -\alias{PuOr} -\alias{RdBu} -\alias{RdGy} -\alias{RdYlBu} -\alias{RdYlGn} -\alias{Spectral} \alias{Blues} +\alias{BrBG} \alias{BuGn} \alias{BuPu} \alias{GnBu} \alias{Greens} \alias{Greys} -\alias{Oranges} \alias{OrRd} +\alias{Oranges} +\alias{PRGn} +\alias{PiYG} \alias{PuBu} \alias{PuBuGn} +\alias{PuOr} \alias{PuRd} \alias{Purples} +\alias{RColorBrewer_colors} +\alias{RdBu} +\alias{RdGy} \alias{RdPu} +\alias{RdYlBu} +\alias{RdYlGn} \alias{Reds} +\alias{Spectral} \alias{YlGn} \alias{YlGnBu} \alias{YlOrBr} @@ -116,3 +116,4 @@ heatmaply(cor(mtcars), colors = RdBu, limits = c(-1,1)) } } + diff --git a/man/ggheatmap.Rd b/man/ggheatmap.Rd deleted file mode 100644 index 58577bd..0000000 --- a/man/ggheatmap.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggheatmap.R -\name{ggheatmap} -\alias{ggheatmap} -\title{Creates a ggplot2 heatmap} -\usage{ -ggheatmap(x, ...) -} -\arguments{ -\item{x}{can either be a heatmapr object, or a numeric matrix -Defaults to \code{TRUE} unless \code{x} contains any \code{NA}s.} - -\item{...}{other parameters passed to \link{heatmapr} (currently, various parameters may be ignored.} -} -\description{ -An object of class heatmapr includes all the needed information -for producing a heatmap. The goal is to seperate the pre-processing of the -heatmap elements from the graphical rendaring of the object, which could be done -} -\examples{ -\dontrun{ - -library(heatmaply) -x <- heatmapr(iris[,-5], scale = "column", colors = "Blues") -ggheatmap(x) - - -} -} diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index e3b4796..d412c66 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -11,23 +11,14 @@ heatmaply(x, ...) \method{heatmaply}{default}(x, 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, -<<<<<<< HEAD cellnote = NULL, draw_cellnote = !is.null(cellnote), Rowv, Colv, distfun = dist, hclustfun = hclust, dist_method = NULL, hclust_method = NULL, distfun_row, hclustfun_row, distfun_col, hclustfun_col, dendrogram = c("both", "row", "column", "none"), reorderfun = function(d, w) reorder(d, w), k_row, k_col, symm = FALSE, - revC, row_dend_left = FALSE, margins = c(50, 50, NA, 0), ..., + revC, scale = c("none", "row", "column"), na.rm = TRUE, + row_dend_left = FALSE, margins = c(50, 50, NA, 0), ..., scale_fill_gradient_fun = scale_fill_gradientn(colors = if -======= - Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, distfun = dist, - hclustfun = hclust, dist_method = NULL, hclust_method = NULL, - distfun_row, hclustfun_row, distfun_col, hclustfun_col, - dendrogram = c("both", "row", "column", "none"), reorderfun = function(d, - w) reorder(d, w), k_row, k_col, symm = FALSE, revC, scale = c("none", - "row", "column"), na.rm = TRUE, row_dend_left = FALSE, margins = c(50, - 50, NA, 0), ..., scale_fill_gradient_fun = scale_fill_gradientn(colors = if ->>>>>>> 041a81fd8d0be779e513e32cf4902e1386ba9e48 (is.function(colors)) colors(256) else colors, na.value = na.value, limits = limits), grid_color = NA, srtRow, srtCol, xlab = "", ylab = "", main = "", titleX = TRUE, titleY = TRUE, hide_colorbar = FALSE, @@ -304,3 +295,4 @@ heatmaply(x, Rowv = row_dend, Colv = col_dend) } } + diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index 98be93f..4dbe288 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -143,3 +143,4 @@ heatmaply(hm) \seealso{ \link{heatmap}, \link[gplots]{heatmap.2}, \link[d3heatmap]{d3heatmap} } + diff --git a/man/is.heatmapr.Rd b/man/is.heatmapr.Rd index bdee5a8..1e0f339 100644 --- a/man/is.heatmapr.Rd +++ b/man/is.heatmapr.Rd @@ -15,3 +15,4 @@ logical - is the object of class heatmapr. \description{ Is the object of class heatmapr. } + diff --git a/man/is.na10.Rd b/man/is.na10.Rd index 964e8ad..e9c25da 100644 --- a/man/is.na10.Rd +++ b/man/is.na10.Rd @@ -41,3 +41,4 @@ x \%>\% is.na10 \%>\% heatmaply( colors = c("grey80", "grey20"), k_col = 2, k_ro \seealso{ \link{is.na} } + diff --git a/man/normalize.Rd b/man/normalize.Rd index 9f1fd8f..789adbc 100644 --- a/man/normalize.Rd +++ b/man/normalize.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/percentize.R \name{normalize} \alias{normalize} -\alias{normalize.default} \alias{normalize.data.frame} +\alias{normalize.default} \alias{normalize.matrix} \title{Normalization transformation (0-1)} \usage{ @@ -39,3 +39,4 @@ percentize(x[,1]) } } + diff --git a/man/percentize.Rd b/man/percentize.Rd index 1c02525..5bd8113 100644 --- a/man/percentize.Rd +++ b/man/percentize.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/percentize.R \name{percentize} \alias{percentize} -\alias{percentize.default} \alias{percentize.data.frame} +\alias{percentize.default} \alias{percentize.matrix} \title{Empirical Percentile Transformation} \usage{ @@ -41,3 +41,4 @@ percentize(x[,1]) } } + diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index 6aaafb7..da1ae97 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -31,3 +31,4 @@ A ggplot geom_tile object \description{ geom_tile for side color plots } + diff --git a/tests/testthat/test_heatmaply.R b/tests/testthat/test_heatmaply.R index d10a1e4..20bb967 100644 --- a/tests/testthat/test_heatmaply.R +++ b/tests/testthat/test_heatmaply.R @@ -1,6 +1,4 @@ -for (plot_method in c( - # "ggplot", - "plotly")) { +for (plot_method in c("ggplot", "plotly")) { for (bool in c(TRUE, FALSE)) { context(paste0(plot_method, ", row_dend_left=", bool)) From b3810572b1515cf77cfa34269aa282a03db546b2 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Mon, 3 Apr 2017 19:04:03 +0100 Subject: [PATCH 42/46] Add font size parameter --- R/heatmaply.R | 18 +++++++++++++----- R/plots.R | 18 +++++++++++------- 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 920d0fd..3739b76 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -318,7 +318,9 @@ heatmaply.default <- function(x, file, long_data, plot_method = c("ggplot", "plotly"), - label_names = c("row", "column", "value") + label_names = c("row", "column", "value"), + cex_row = 10, + cex_col = 10 ) { if (!missing(long_data)) { if (!missing(x)) warning("x and long_data should not be used together") @@ -432,7 +434,9 @@ heatmaply.default <- function(x, branches_lwd = branches_lwd, label_names = label_names, plot_method = plot_method, - draw_cellnote = draw_cellnote + draw_cellnote = draw_cellnote, + cex_row = cex_row, + cex_col = cex_col ) # TODO: think more on what should be passed in "..." if(!missing(file)) hmly %>% saveWidget(file = file, selfcontained = TRUE) @@ -576,7 +580,9 @@ heatmaply.heatmapr <- function(x, RowSideColors, heatmap_layers = NULL, branches_lwd = 0.6, - label_names + label_names, + cex_row, + cex_col ) { plot_method <- match.arg(plot_method) @@ -655,10 +661,12 @@ heatmaply.heatmapr <- function(x, key.title = key.title, layers = heatmap_layers, row_dend_left = row_dend_left, - label_names = label_names) + label_names = label_names, + cex_row = cex_row, cex_col = cex_col) } else if (plot_method == "plotly") { p <- plotly_heatmap(data_mat, limits = limits, colors = colors, - row_text_angle = row_text_angle, column_text_angle = column_text_angle) + row_text_angle = row_text_angle, column_text_angle = column_text_angle, + cex_row = cex_row, cex_col = cex_col) } # TODO: Add native plotly sidecolor function. diff --git a/R/plots.R b/R/plots.R index 81ff966..e2292b2 100644 --- a/R/plots.R +++ b/R/plots.R @@ -1,5 +1,3 @@ - - # xx is a data matrix ggplot_heatmap <- function(xx, row_text_angle = 0, @@ -16,6 +14,8 @@ ggplot_heatmap <- function(xx, cellnote = NULL, draw_cellnote = FALSE, label_names, + cex_row = 10, + cex_col = 10, ...) { theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), panel.grid.major = element_blank(), @@ -81,8 +81,10 @@ ggplot_heatmap <- function(xx, coord_cartesian(expand = FALSE) + scale_fill_gradient_fun + theme_bw()+ theme_clear_grid_heatmap + - theme(axis.text.x = element_text(angle = column_text_angle, hjust = 1), - axis.text.y = element_text(angle = row_text_angle, hjust = 1) + theme(axis.text.x = element_text(angle = column_text_angle, + size = cex_col, hjust = 1), + axis.text.y = element_text(angle = row_text_angle, + size = cex_row, hjust = 1) ) if (!is.null(cellnote) && draw_cellnote) { @@ -114,19 +116,21 @@ ggplot_heatmap <- function(xx, plotly_heatmap <- function(x, limits = range(x), colors, row_text_angle=0, column_text_angle=45, grid.color, grid.size, key.title, - row_dend_left) { + row_dend_left, cex_row = 10, cex_col = 10) { plot_ly(z = x, x = 1:ncol(x), y = 1:nrow(x), type = "heatmap", showlegend = FALSE, colors=colors, zmin = limits[1], zmax = limits[2]) %>% layout( xaxis = list( - tickangle = row_text_angle, + tickfont = list(size = cex_col), + tickangle = column_text_angle, tickvals = 1:ncol(x), ticktext = colnames(x), showticklabels = TRUE ), yaxis = list( - tickangle = column_text_angle, + tickfont = list(size = cex_row), + tickangle = row_text_angle, tickvals = 1:nrow(x), ticktext = rownames(x), showticklabels = TRUE ) From 4129029f76fac8b3b97fd6e4b65fd695a9a3ea49 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Mon, 3 Apr 2017 20:00:20 +0100 Subject: [PATCH 43/46] Update docs --- R/heatmaply.R | 5 +++-- man/heatmaply.Rd | 7 +++++-- vignettes/heatmaply.Rmd | 5 ++--- vignettes/heatmaply.md | 2 +- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 3739b76..9e5a215 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -147,6 +147,7 @@ #' inthe data. #' #' @param label_names Names for labells of x, y and value/fill mouseover. +#' @param cex_row,cex_col Font size for row and column labels. #' #' @export #' @examples @@ -581,8 +582,8 @@ heatmaply.heatmapr <- function(x, heatmap_layers = NULL, branches_lwd = 0.6, label_names, - cex_row, - cex_col + cex_row = 10, + cex_col = 10 ) { plot_method <- match.arg(plot_method) diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index d412c66..4145853 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -26,7 +26,7 @@ heatmaply(x, ...) col_side_colors, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6, file, long_data, plot_method = c("ggplot", "plotly"), label_names = c("row", - "column", "value")) + "column", "value"), cex_row = 10, cex_col = 10) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -39,7 +39,8 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, draw_cellnote = FALSE, row_side_colors, row_side_palette, col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), ColSideColors, RowSideColors, - heatmap_layers = NULL, branches_lwd = 0.6, label_names) + heatmap_layers = NULL, branches_lwd = 0.6, label_names, cex_row = 10, + cex_col = 10) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix @@ -190,6 +191,8 @@ inthe data.} and dendrogram plots} \item{label_names}{Names for labells of x, y and value/fill mouseover.} + +\item{cex_row, cex_col}{Font size for row and column labels.} } \description{ An object of class heatmapr includes all the needed information diff --git a/vignettes/heatmaply.Rmd b/vignettes/heatmaply.Rmd index a842429..cfdfb5b 100644 --- a/vignettes/heatmaply.Rmd +++ b/vignettes/heatmaply.Rmd @@ -81,7 +81,7 @@ Default ```{r} library(heatmaply) -heatmaply(scale(mtcars)) +heatmaply(mtcars) ``` It is probably more useful to use scaling. heatmaply supports column @@ -92,8 +92,7 @@ Because the labels are somewhat long, we need to manually fix the margins (hopef heatmaply(mtcars, xlab = "Features", ylab = "Cars", main = "An example of title and xlab/ylab", scale = "column", - margins = c(60,100,40,20) ) -# heatmaply(mtcars) %>% layout(margin = list(l = 130, b = 40), xaxis=list(tickfont=5)) + margins = c(60,100,40,20)) ``` We can use this with correlation. Notice the use of limits to set the range of the colors, and how we color the branches: diff --git a/vignettes/heatmaply.md b/vignettes/heatmaply.md index 8ed898a..4233449 100644 --- a/vignettes/heatmaply.md +++ b/vignettes/heatmaply.md @@ -1,6 +1,6 @@ --- title: "Introduction to heatmaply" -date: "2017-02-22" +date: "2017-04-03" author: "Tal Galili" output: html_document: From b41b2bda9acce8a0d4324de6341fa9cb50b39dec Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sun, 9 Apr 2017 12:17:24 +0100 Subject: [PATCH 44/46] Minor param name changes --- DESCRIPTION | 2 +- R/heatmaply.R | 21 ++++++++++++--------- man/RColorBrewer_colors.Rd | 23 +++++++++++------------ man/heatmaply.Rd | 9 ++++----- man/heatmapr.Rd | 1 - man/is.heatmapr.Rd | 1 - man/is.na10.Rd | 1 - man/normalize.Rd | 3 +-- man/percentize.Rd | 3 +-- man/side_color_plot.Rd | 1 - 10 files changed, 30 insertions(+), 35 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e846db4..0abe6a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,4 +56,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: 5.0.1 +RoxygenNote: 6.0.1 diff --git a/R/heatmaply.R b/R/heatmaply.R index 9e5a215..6bcbaee 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -147,7 +147,7 @@ #' inthe data. #' #' @param label_names Names for labells of x, y and value/fill mouseover. -#' @param cex_row,cex_col Font size for row and column labels. +#' @param fontsize_row,fontsize_col,cexRow,cexCol Font size for row and column labels. #' #' @export #' @examples @@ -320,8 +320,9 @@ heatmaply.default <- function(x, long_data, plot_method = c("ggplot", "plotly"), label_names = c("row", "column", "value"), - cex_row = 10, - cex_col = 10 + fontsize_row = 10, + fontsize_col = 10, + cexRow, cexCol ) { if (!missing(long_data)) { if (!missing(x)) warning("x and long_data should not be used together") @@ -349,6 +350,8 @@ heatmaply.default <- function(x, row_side_colors <- RowSideColors } + if (!missing(cexRow)) fontsize_row <- cexRow + if (!missing(cexCol)) fontsize_col <- cexCol # TODO: maybe create heatmaply.data.frame heatmaply.matrix instead. # But right now I am not sure this would be needed. @@ -436,8 +439,8 @@ heatmaply.default <- function(x, label_names = label_names, plot_method = plot_method, draw_cellnote = draw_cellnote, - cex_row = cex_row, - cex_col = cex_col + fontsize_row = fontsize_row, + fontsize_col = fontsize_col ) # TODO: think more on what should be passed in "..." if(!missing(file)) hmly %>% saveWidget(file = file, selfcontained = TRUE) @@ -582,8 +585,8 @@ heatmaply.heatmapr <- function(x, heatmap_layers = NULL, branches_lwd = 0.6, label_names, - cex_row = 10, - cex_col = 10 + fontsize_row = 10, + fontsize_col = 10 ) { plot_method <- match.arg(plot_method) @@ -663,11 +666,11 @@ heatmaply.heatmapr <- function(x, layers = heatmap_layers, row_dend_left = row_dend_left, label_names = label_names, - cex_row = cex_row, cex_col = cex_col) + fontsize_row = fontsize_row, fontsize_col = fontsize_col) } else if (plot_method == "plotly") { p <- plotly_heatmap(data_mat, limits = limits, colors = colors, row_text_angle = row_text_angle, column_text_angle = column_text_angle, - cex_row = cex_row, cex_col = cex_col) + fontsize_row = fontsize_row, fontsize_col = fontsize_col) } # TODO: Add native plotly sidecolor function. diff --git a/man/RColorBrewer_colors.Rd b/man/RColorBrewer_colors.Rd index 6678847..b001290 100644 --- a/man/RColorBrewer_colors.Rd +++ b/man/RColorBrewer_colors.Rd @@ -1,30 +1,30 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/RColorBrewer.R \name{RColorBrewer_colors} -\alias{Blues} +\alias{RColorBrewer_colors} \alias{BrBG} +\alias{PiYG} +\alias{PRGn} +\alias{PuOr} +\alias{RdBu} +\alias{RdGy} +\alias{RdYlBu} +\alias{RdYlGn} +\alias{Spectral} +\alias{Blues} \alias{BuGn} \alias{BuPu} \alias{GnBu} \alias{Greens} \alias{Greys} -\alias{OrRd} \alias{Oranges} -\alias{PRGn} -\alias{PiYG} +\alias{OrRd} \alias{PuBu} \alias{PuBuGn} -\alias{PuOr} \alias{PuRd} \alias{Purples} -\alias{RColorBrewer_colors} -\alias{RdBu} -\alias{RdGy} \alias{RdPu} -\alias{RdYlBu} -\alias{RdYlGn} \alias{Reds} -\alias{Spectral} \alias{YlGn} \alias{YlGnBu} \alias{YlOrBr} @@ -116,4 +116,3 @@ heatmaply(cor(mtcars), colors = RdBu, limits = c(-1,1)) } } - diff --git a/man/heatmaply.Rd b/man/heatmaply.Rd index 4145853..40d8d96 100644 --- a/man/heatmaply.Rd +++ b/man/heatmaply.Rd @@ -26,7 +26,7 @@ heatmaply(x, ...) col_side_colors, col_side_palette, ColSideColors = NULL, RowSideColors = NULL, heatmap_layers = NULL, branches_lwd = 0.6, file, long_data, plot_method = c("ggplot", "plotly"), label_names = c("row", - "column", "value"), cex_row = 10, cex_col = 10) + "column", "value"), fontsize_row = 10, fontsize_col = 10, cexRow, cexCol) \method{heatmaply}{heatmapr}(x, colors = viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"), limits = NULL, na.value = "grey50", @@ -39,8 +39,8 @@ heatmaply(x, ...) key.title = NULL, return_ppxpy = FALSE, draw_cellnote = FALSE, row_side_colors, row_side_palette, col_side_colors, col_side_palette, plot_method = c("ggplot", "plotly"), ColSideColors, RowSideColors, - heatmap_layers = NULL, branches_lwd = 0.6, label_names, cex_row = 10, - cex_col = 10) + heatmap_layers = NULL, branches_lwd = 0.6, label_names, + fontsize_row = 10, fontsize_col = 10) } \arguments{ \item{x}{can either be a heatmapr object, or a numeric matrix @@ -192,7 +192,7 @@ and dendrogram plots} \item{label_names}{Names for labells of x, y and value/fill mouseover.} -\item{cex_row, cex_col}{Font size for row and column labels.} +\item{fontsize_row, fontsize_col, cexRow, cexCol}{Font size for row and column labels.} } \description{ An object of class heatmapr includes all the needed information @@ -298,4 +298,3 @@ heatmaply(x, Rowv = row_dend, Colv = col_dend) } } - diff --git a/man/heatmapr.Rd b/man/heatmapr.Rd index 4dbe288..98be93f 100644 --- a/man/heatmapr.Rd +++ b/man/heatmapr.Rd @@ -143,4 +143,3 @@ heatmaply(hm) \seealso{ \link{heatmap}, \link[gplots]{heatmap.2}, \link[d3heatmap]{d3heatmap} } - diff --git a/man/is.heatmapr.Rd b/man/is.heatmapr.Rd index 1e0f339..bdee5a8 100644 --- a/man/is.heatmapr.Rd +++ b/man/is.heatmapr.Rd @@ -15,4 +15,3 @@ logical - is the object of class heatmapr. \description{ Is the object of class heatmapr. } - diff --git a/man/is.na10.Rd b/man/is.na10.Rd index e9c25da..964e8ad 100644 --- a/man/is.na10.Rd +++ b/man/is.na10.Rd @@ -41,4 +41,3 @@ x \%>\% is.na10 \%>\% heatmaply( colors = c("grey80", "grey20"), k_col = 2, k_ro \seealso{ \link{is.na} } - diff --git a/man/normalize.Rd b/man/normalize.Rd index 789adbc..9f1fd8f 100644 --- a/man/normalize.Rd +++ b/man/normalize.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/percentize.R \name{normalize} \alias{normalize} -\alias{normalize.data.frame} \alias{normalize.default} +\alias{normalize.data.frame} \alias{normalize.matrix} \title{Normalization transformation (0-1)} \usage{ @@ -39,4 +39,3 @@ percentize(x[,1]) } } - diff --git a/man/percentize.Rd b/man/percentize.Rd index 5bd8113..1c02525 100644 --- a/man/percentize.Rd +++ b/man/percentize.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/percentize.R \name{percentize} \alias{percentize} -\alias{percentize.data.frame} \alias{percentize.default} +\alias{percentize.data.frame} \alias{percentize.matrix} \title{Empirical Percentile Transformation} \usage{ @@ -41,4 +41,3 @@ percentize(x[,1]) } } - diff --git a/man/side_color_plot.Rd b/man/side_color_plot.Rd index da1ae97..6aaafb7 100644 --- a/man/side_color_plot.Rd +++ b/man/side_color_plot.Rd @@ -31,4 +31,3 @@ A ggplot geom_tile object \description{ geom_tile for side color plots } - From 7333fcecacd91ed4bd04f3bc79116fb238584b08 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sun, 9 Apr 2017 12:36:56 +0100 Subject: [PATCH 45/46] Fix dupe --- R/heatmaply.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/heatmaply.R b/R/heatmaply.R index 207e59c..60c6c90 100644 --- a/R/heatmaply.R +++ b/R/heatmaply.R @@ -456,8 +456,6 @@ heatmaply.default <- function(x, draw_cellnote = draw_cellnote, fontsize_row = fontsize_row, fontsize_col = fontsize_col, - heatmap_layers = heatmap_layers, - branches_lwd = branches_lwd, subplot_widths = subplot_widths, subplot_heights = subplot_heights) From bf724328fc9bf35c414604d46c3c1c52d45a7b76 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Sun, 9 Apr 2017 13:20:53 +0100 Subject: [PATCH 46/46] Rename cex_row param --- R/plots.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/plots.R b/R/plots.R index e2292b2..5f00e66 100644 --- a/R/plots.R +++ b/R/plots.R @@ -14,8 +14,8 @@ ggplot_heatmap <- function(xx, cellnote = NULL, draw_cellnote = FALSE, label_names, - cex_row = 10, - cex_col = 10, + fontsize_row = 10, + fontsize_col = 10, ...) { theme_clear_grid_heatmap <- theme(axis.line = element_line(color = "black"), panel.grid.major = element_blank(), @@ -82,9 +82,9 @@ ggplot_heatmap <- function(xx, scale_fill_gradient_fun + theme_bw()+ theme_clear_grid_heatmap + theme(axis.text.x = element_text(angle = column_text_angle, - size = cex_col, hjust = 1), + size = fontsize_col, hjust = 1), axis.text.y = element_text(angle = row_text_angle, - size = cex_row, hjust = 1) + size = fontsize_row, hjust = 1) ) if (!is.null(cellnote) && draw_cellnote) { @@ -116,20 +116,20 @@ ggplot_heatmap <- function(xx, plotly_heatmap <- function(x, limits = range(x), colors, row_text_angle=0, column_text_angle=45, grid.color, grid.size, key.title, - row_dend_left, cex_row = 10, cex_col = 10) { + row_dend_left, fontsize_row = 10, fontsize_col = 10) { plot_ly(z = x, x = 1:ncol(x), y = 1:nrow(x), type = "heatmap", showlegend = FALSE, colors=colors, zmin = limits[1], zmax = limits[2]) %>% layout( xaxis = list( - tickfont = list(size = cex_col), + tickfont = list(size = fontsize_col), tickangle = column_text_angle, tickvals = 1:ncol(x), ticktext = colnames(x), showticklabels = TRUE ), yaxis = list( - tickfont = list(size = cex_row), + tickfont = list(size = fontsize_row), tickangle = row_text_angle, tickvals = 1:nrow(x), ticktext = rownames(x), showticklabels = TRUE @@ -303,4 +303,4 @@ side_color_plot <- function(df, palette, values = color_vals) + theme return(g) -} \ No newline at end of file +}