add as_ComplexHeatmap for more unusual operations with draw

NAMESPACE

@@ -1,9 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("+",InputHeatmap)
 export(add_bar)
 export(add_line)
 export(add_point)
 export(add_tile)
+export(as_ComplexHeatmap)
 export(heatmap)
 export(layer_arrow_down)
 export(layer_arrow_up)
@@ -15,14 +17,18 @@ export(scale_robust)
 export(split_columns)
 export(split_rows)
 export(wrap_heatmap)
-import(ComplexHeatmap)
+exportMethods(as_ComplexHeatmap)
 import(dplyr)
 import(grDevices)
 import(tidyr)
+importFrom(ComplexHeatmap,Heatmap)
 importFrom(ComplexHeatmap,anno_barplot)
+importFrom(ComplexHeatmap,anno_block)
 importFrom(ComplexHeatmap,anno_lines)
 importFrom(ComplexHeatmap,anno_points)
+importFrom(ComplexHeatmap,columnAnnotation)
 importFrom(ComplexHeatmap,draw)
+importFrom(ComplexHeatmap,rowAnnotation)
 importFrom(RColorBrewer,brewer.pal)
 importFrom(circlize,colorRamp2)
 importFrom(dendextend,cutree)

R/functions.R

@@ -4,7 +4,6 @@
 #'
 #' @import dplyr
 #' @import tidyr
-#' @import ComplexHeatmap
 #' @importFrom magrittr "%>%"
 #' @importFrom rlang enquo
 #' @importFrom rlang quo_name
@@ -260,7 +259,6 @@ add_grouping = function(my_input_heatmap){
 #'
 #' @import dplyr
 #' @import tidyr
-#' @import ComplexHeatmap
 #' @importFrom magrittr "%>%"
 #' @importFrom rlang enquo
 #' @importFrom rlang quo_name

R/methods.R

@@ -40,20 +40,66 @@ InputHeatmap<-setClass(
 	)
 )
 
+
+#' Creates a  `ComplexHeatmap` object for less standard plot manipulation (e.g. changing legend position)
+#'
+#' \lifecycle{maturing}
+#'
+#' @description as_ComplexHeatmap() takes a `InputHeatmap` object and produces a `Heatmap` object
+#'
 #' @importFrom methods show
 #' @importFrom tibble rowid_to_column
 #' @importFrom grid grid.points
-setMethod("show", "InputHeatmap", function(object){
+#' 
+#'
+#' @name as_ComplexHeatmap
+#'
+#' @param tidyHeatmap A `InputHeatmap` object from tidyHeatmap::heatmap() call
+#' 
+#' @return A `ComplexHeatmap` 
+#'
+#'
+#'
+#' @examples
+#'
+#' 
+#' tidyHeatmap::N52 |>
+#' tidyHeatmap::heatmap(
+#'  .row = symbol_ct,
+#'  .column = UBR,
+#'  .value = `read count normalised log`,
+#' ) |>
+#' as_ComplexHeatmap()
+#'
+#' @docType methods
+#' @rdname as_ComplexHeatmap-method
+#'
+#' @export
+#' 
+setGeneric("as_ComplexHeatmap", function(tidyHeatmap) standardGeneric("as_ComplexHeatmap"))
+
+
+#' Creates a  `ComplexHeatmap` object for less standard plot manipulation (e.g. changing legend position)
+#'
+#' @importFrom ComplexHeatmap columnAnnotation
+#' @importFrom ComplexHeatmap rowAnnotation
+#'
+#' @docType methods
+#' @rdname as_ComplexHeatmap-method
+#'
+#' @export
+#' 
+setMethod("as_ComplexHeatmap", "InputHeatmap", function(tidyHeatmap){
 
 	# Fix CRAN notes
 	. = NULL
 	index_column_wise = NULL
 	shape = NULL
 
-	object@input$top_annotation = 
+	tidyHeatmap@input$top_annotation = 
 		c(
-			object@group_top_annotation,
-			object@top_annotation %>% annot_to_list()
+			tidyHeatmap@group_top_annotation,
+			tidyHeatmap@top_annotation %>% annot_to_list()
 		) %>%
 		list_drop_null() %>%
 		when(
@@ -63,10 +109,10 @@ setMethod("show", "InputHeatmap", function(object){
 			~ NULL
 		)
 
-	object@input$left_annotation = 
+	tidyHeatmap@input$left_annotation = 
 		c(
-			object@group_left_annotation,
-			object@left_annotation %>% annot_to_list()
+			tidyHeatmap@group_left_annotation,
+			tidyHeatmap@left_annotation %>% annot_to_list()
 		) %>%
 		list_drop_null()  %>%
 		when(
@@ -77,13 +123,13 @@ setMethod("show", "InputHeatmap", function(object){
 		)
 
 	# On-top layer
-	object@input$layer_fun = function(j, i, x, y, w, h, fill) {
+	tidyHeatmap@input$layer_fun = function(j, i, x, y, w, h, fill) {
 		ind = 
 			tibble(row = i, column = j) %>%
 			rowid_to_column("index_column_wise") %>%
 
 			# Filter just points to label
-			inner_join(object@layer_symbol, by = c("row", "column")) %>%
+			inner_join(tidyHeatmap@layer_symbol, by = c("row", "column")) %>%
 			select(`index_column_wise`, `shape`)
 
 		if(nrow(ind)>0)
@@ -95,21 +141,32 @@ setMethod("show", "InputHeatmap", function(object){
 			)
 	}
 
-
+	return(do.call(Heatmap, tidyHeatmap@input))
+})
 
-
 
+setMethod("show", "InputHeatmap", function(object){
 
+	object %>%
+		as_ComplexHeatmap() %>%
+		show()
+})
+
+
+#' @rdname plot_arithmetic
+#' @export
+"+.InputHeatmap" <- function(e1, e2) {
 
-	show(do.call(Heatmap, object@input))
-} )
+	as_ComplexHeatmap(e1) + as_ComplexHeatmap(e2)
+}
 
 #' Creates a  `InputHeatmap` object from `tbl_df` on evaluation creates a `ComplexHeatmap`
 #'
 #' \lifecycle{maturing}
 #'
 #' @description heatmap() takes a tbl object and easily produces a ComplexHeatmap plot, with integration with tibble and dplyr frameworks.
 #'
+#' @importFrom ComplexHeatmap Heatmap
 #' @importFrom rlang enquo
 #' @importFrom magrittr "%>%"
 #' @importFrom stats sd

R/utilities.R

@@ -745,6 +745,7 @@ get_top_left_annotation = function(.data_, .column, .row, .abundance, annotation
 }
 
 #' @importFrom grid unit
+#' @importFrom ComplexHeatmap anno_block
 get_group_annotation = function(.data, .column, .row, .abundance, palette_annotation){
 
   # Comply with CRAN NOTES