Merge pull request #121 from stemangiola/add-layer-size

Add layer size

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidyHeatmap
 Title: A Tidy Implementation of Heatmap
-Version: 1.10.0
+Version: 1.10.1
 Authors@R: 
     c(person(given = "Stefano",
            family = "Mangiola",

R/functions.R

@@ -446,7 +446,8 @@ add_annotation = function(my_input_heatmap,
 #'
 setGeneric("layer_symbol", function(.data,
 																		...,
-																		symbol = "point")
+																		symbol = "point",
+																		.size = NULL)
 	standardGeneric("layer_symbol"))
 
 #' layer_symbol
@@ -461,10 +462,11 @@ setGeneric("layer_symbol", function(.data,
 #'
 setMethod("layer_symbol", "InputHeatmap", function(.data,
 																									 ...,
-																									 symbol = "point"){
+																									 symbol = "point",
+																									 .size = NULL){
 
 	.data_drame = .data@data
-
+	.size = enquo(.size)
 
 	symbol_dictionary = 
 		list(
@@ -491,6 +493,9 @@ setMethod("layer_symbol", "InputHeatmap", function(.data,
 	.vertical = .data@arguments$.vertical
 	.abundance = .data@arguments$.abundance
 
+	# Extract the abundance matrix for dimensions of the text
+	abundance_mat = .data@input[[1]]
+
 	# Append which cells have to be signed
 	.data@layer_symbol= 
 		.data@layer_symbol |>
@@ -502,8 +507,15 @@ setMethod("layer_symbol", "InputHeatmap", function(.data,
 					row = !!.vertical  %>%  as.factor() %>% as.integer()
 				) |>
 				filter(...) |>
-				select(column, row) |>
-				mutate(shape = symbol_dictionary[[symbol]])
+				mutate(shape = symbol_dictionary[[!!symbol]]) |> 
+
+				# Add size
+				when(
+					quo_is_null(.size) ~ mutate(., size = min(3, 80 / max(dim(abundance_mat)) )) ,
+					~ mutate(., size := !!.size )
+				) |> 
+
+				select(column, row, shape, size) 
 		)
 
 	.data

R/methods.R

@@ -128,7 +128,6 @@ setMethod("as_ComplexHeatmap", "InputHeatmap", function(tidyHeatmap){
 	# On-top layer
 	tidyHeatmap@input$layer_fun = function(j, i, x, y, w, h, fill) {
 
-
 		# Add symbol
 		ind = 
 			tibble(row = i, column = j) |>
@@ -142,7 +141,7 @@ setMethod("as_ComplexHeatmap", "InputHeatmap", function(tidyHeatmap){
 			grid.points(
 				x[ind$index_column_wise], y[ind$index_column_wise], 
 				pch = ind$shape , 
-				size = unit(3, "mm"), 
+				size = unit(ind$size, "mm"), 
 				gp = gpar(col = NULL, fill="#161616")
 			)
 		}
@@ -672,7 +671,8 @@ setMethod("annotation_bar", "InputHeatmap", function(.data,
 #'
 #'
 #' @export
-setGeneric("layer_arrow_up", function(.data,	...)
+setGeneric("layer_arrow_up", function(.data,..., 
+																			.size = NULL)
 	standardGeneric("layer_arrow_up"))
 
 #' layer_arrow_up
@@ -683,7 +683,8 @@ setGeneric("layer_arrow_up", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_arrow_up", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="arrow_up") })
+setMethod("layer_arrow_up", "InputHeatmap", function(.data,..., 
+																										 .size = NULL){ .data |>	layer_symbol(..., symbol="arrow_up", .size = !!enquo(.size)) })
 
 #' Adds a layers of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -723,7 +724,8 @@ setMethod("layer_arrow_up", "InputHeatmap", function(.data, ...){ .data |>	layer
 #'
 #'
 #' @export
-setGeneric("layer_arrow_down", function(.data,	...)
+setGeneric("layer_arrow_down", function(.data,..., 
+																				.size = NULL)
 	standardGeneric("layer_arrow_down"))
 
 #' layer_arrow_down
@@ -734,7 +736,8 @@ setGeneric("layer_arrow_down", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_arrow_down", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="arrow_down") })
+setMethod("layer_arrow_down", "InputHeatmap", function(.data,..., 
+																											 .size = NULL){ .data |>	layer_symbol(..., symbol="arrow_down", .size = !!enquo(.size)) })
 
 #' Adds a layers of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -773,7 +776,8 @@ setMethod("layer_arrow_down", "InputHeatmap", function(.data, ...){ .data |>	lay
 #'
 #'
 #' @export
-setGeneric("layer_point", function(.data,	...)
+setGeneric("layer_point", function(.data,..., 
+																	 .size = NULL)
 	standardGeneric("layer_point"))
 
 #' layer_point
@@ -784,7 +788,8 @@ setGeneric("layer_point", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_point", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="point") })
+setMethod("layer_point", "InputHeatmap", function(.data,..., 
+																									.size = NULL){ .data |>	layer_symbol(..., symbol="point", .size = !!enquo(.size)) })
 
 #' Adds a layers of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -823,7 +828,8 @@ setMethod("layer_point", "InputHeatmap", function(.data, ...){ .data |>	layer_sy
 #'
 #'
 #' @export
-setGeneric("layer_square", function(.data,	...)
+setGeneric("layer_square", function(.data,..., 
+																		.size = NULL)
 	standardGeneric("layer_square"))
 
 #' layer_square
@@ -833,7 +839,8 @@ setGeneric("layer_square", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_square", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="square") })
+setMethod("layer_square", "InputHeatmap", function(.data,..., 
+																									 .size = NULL){ .data |>	layer_symbol(..., symbol="square", .size = !!enquo(.size)) })
 
 #' Adds a layers of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -872,7 +879,8 @@ setMethod("layer_square", "InputHeatmap", function(.data, ...){ .data |>	layer_s
 #'
 #'
 #' @export
-setGeneric("layer_diamond", function(.data,	...)
+setGeneric("layer_diamond", function(.data,..., 
+																		 .size = NULL)
 	standardGeneric("layer_diamond"))
 
 #' layer_diamond
@@ -883,7 +891,8 @@ setGeneric("layer_diamond", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_diamond", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="diamond") })
+setMethod("layer_diamond", "InputHeatmap", function(.data,..., 
+																										.size = NULL){ .data |>	layer_symbol(..., symbol="diamond", .size = !!enquo(.size)) })
 
 #' Adds a layer of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -922,7 +931,8 @@ setMethod("layer_diamond", "InputHeatmap", function(.data, ...){ .data |>	layer_
 #'
 #'
 #' @export
-setGeneric("layer_star", function(.data,	...)
+setGeneric("layer_star", function(.data,..., 
+																	.size = NULL)
 	standardGeneric("layer_star"))
 
 #' layer_star
@@ -933,7 +943,8 @@ setGeneric("layer_star", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_star", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="star") })
+setMethod("layer_star", "InputHeatmap", function(.data,..., 
+																								 .size = NULL){ .data |>	layer_symbol(..., symbol="star", .size = !!enquo(.size)) })
 
 #' Adds a layer of symbols above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
 #'
@@ -972,7 +983,8 @@ setMethod("layer_star", "InputHeatmap", function(.data, ...){ .data |>	layer_sym
 #'
 #'
 #' @export
-setGeneric("layer_asterisk", function(.data,	...)
+setGeneric("layer_asterisk", function(.data,..., 
+																			.size = NULL)
 	standardGeneric("layer_asterisk"))
 
 #' layer_asterisk
@@ -983,7 +995,8 @@ setGeneric("layer_asterisk", function(.data,	...)
 #' 
 #' @return A `InputHeatmap` object that gets evaluated to a `ComplexHeatmap`
 #'
-setMethod("layer_asterisk", "InputHeatmap", function(.data, ...){ .data |>	layer_symbol(..., symbol="asterisk") })
+setMethod("layer_asterisk", "InputHeatmap", function(.data,..., 
+																										 .size = NULL){ .data |>	layer_symbol(..., symbol="asterisk", .size = !!enquo(.size)) })
 
 
 #' Adds a layers of texts above the heatmap tiles to a `InputHeatmap`, that on evaluation creates a `ComplexHeatmap`
@@ -1079,7 +1092,6 @@ setMethod("layer_text", "InputHeatmap", function(.data,
 					row = !!.vertical  %>%  as.factor() %>% as.integer()
 				) |>
 				filter(...) |>
-
 				mutate(text := as.character( !!enquo(.value) )) |> 
 
 				# Add size

README.md

@@ -129,7 +129,7 @@ mtcars_tidy
     ##  8 Mazda RX4       110     0 gear         0.424
     ##  9 Mazda RX4       110     0 carb         0.735
     ## 10 Mazda RX4 Wag   110     0 mpg          0.151
-    ## # … with 278 more rows
+    ## # ℹ 278 more rows
 
 ## Plotting
 
@@ -151,8 +151,11 @@ mtcars_heatmap <-
 
     ## Warning: Using one column matrices in `filter()` was deprecated in dplyr 1.1.0.
     ## ℹ Please use one dimensional logical vectors instead.
-    ## ℹ The deprecated feature was likely used in the dplyr package.
-    ##   Please report the issue at <]8;;https://github.com/tidyverse/dplyr/issueshttps://github.com/tidyverse/dplyr/issues]8;;>.
+    ## ℹ The deprecated feature was likely used in the tidyHeatmap package.
+    ##   Please report the issue at <https://github.com/stemangiola/tidyHeatmap>.
+    ## This warning is displayed once every 8 hours.
+    ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
+    ## generated.
 
 ``` r
 mtcars_heatmap
@@ -303,6 +306,9 @@ mtcars_tidy |>
 
     ## Warning: `add_tile()` was deprecated in tidyHeatmap 1.9.0.
     ## ℹ Please use `annotation_tile()` instead
+    ## This warning is displayed once every 8 hours.
+    ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
+    ## generated.
 
 ![](man/fragments/figures/unnamed-chunk-16-1.png)<!-- -->
 
@@ -424,14 +430,25 @@ tidyHeatmap::pasilla |>
     # filter
     filter(symbol %in% head(unique(tidyHeatmap::pasilla$symbol), n = 10)) |>
 
+    # Add dynamic size
+    mutate(my_size = runif(n(), 1,5)) |> 
+
     heatmap(
         .column = sample,
         .row = symbol,
         .value = `count normalised adjusted`,   
         scale = "row"
     ) |> 
     layer_point(
-        `count normalised adjusted log` > 6 & sample == "untreated3" 
+        `count normalised adjusted log` > 6 & sample == "untreated3"
+    ) |>
+    layer_square(
+        `count normalised adjusted log` > 6 & sample == "untreated2",
+        .size = my_size
+    ) |>
+    layer_arrow_up(
+        `count normalised adjusted log` > 6 & sample == "untreated1",
+        .size = 4
     )
 ```
 

man/fragments/intro.Rmd

@@ -354,14 +354,25 @@ tidyHeatmap::pasilla |>
 	# filter
 	filter(symbol %in% head(unique(tidyHeatmap::pasilla$symbol), n = 10)) |>
 	
+	# Add dynamic size
+	mutate(my_size = runif(n(), 1,5)) |> 
+	
 	heatmap(
 		.column = sample,
 		.row = symbol,
 		.value = `count normalised adjusted`,	
 		scale = "row"
 	) |> 
 	layer_point(
-		`count normalised adjusted log` > 6 & sample == "untreated3" 
+		`count normalised adjusted log` > 6 & sample == "untreated3"
+	) |>
+	layer_square(
+		`count normalised adjusted log` > 6 & sample == "untreated2",
+		.size = my_size
+	) |>
+	layer_arrow_up(
+		`count normalised adjusted log` > 6 & sample == "untreated1",
+		.size = 4
 	)
 ```
 

tests/testthat/.gitignore

@@ -0,0 +1 @@
+Rplots.pdf