introduction.R
In tidyHeatmap: A Tidy Implementation of Heatmap

params <-
list(demo_metadata = TRUE)

## ----setup, include=FALSE-----------------------------------------------------

knitr::opts_chunk$set(
  dpi = 150,
  fig.retina = 1,
  dev = "png",
  dev.args = list(
    png = list(type = "cairo-png", antialias = "subpixel" )
  )
)


## ----install, eval=FALSE------------------------------------------------------
# 
# devtools::install_github("stemangiola/tidyHeatmap")
# 
# 

## ----install2, eval=FALSE-----------------------------------------------------
# 
# install.packages("tidyHeatmap")
# 

## ----library, echo=FALSE, include=FALSE---------------------------------------
library(dplyr)
library(tidyr)
library(tidyHeatmap)
library(grid)

## ----setup data---------------------------------------------------------------
mtcars_tidy <- 
	mtcars |> 
	as_tibble(rownames="Car name") |> 
	
	# Scale
	mutate_at(vars(-`Car name`, -hp, -vs), scale) |>
	
	# tidyfy
	pivot_longer(cols = -c(`Car name`, hp, vs), names_to = "Property", values_to = "Value")

mtcars_tidy

## ----heatmap, fig.width=10, fig.height=10-------------------------------------
mtcars_heatmap <- 
	mtcars_tidy |> 
	heatmap(`Car name`, Property, Value,	scale = "row"	) |>
	annotation_tile(hp)

mtcars_heatmap

## ----save, eval=F-------------------------------------------------------------
# mtcars_heatmap |> save_pdf("mtcars_heatmap.pdf")

## ----distance, fig.width=10, fig.height=10------------------------------------

tidyHeatmap::pasilla |>
	
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row",
		
		# Arguments passed to ComplexHeatmap 
		clustering_distance_rows = "manhattan",
		clustering_distance_columns = "manhattan",
		clustering_method_rows = "ward.D",
		clustering_method_columns = "ward.D"
	) 

## ----grouping, fig.width=10, fig.height=10------------------------------------
# Make up more groupings
mtcars_tidy_groupings = 
	mtcars_tidy |>
	mutate(property_group = if_else(Property %in% c("cyl", "disp"), "Engine", "Other"))

mtcars_tidy_groupings |> 
	group_by(vs, property_group) |>
	heatmap(`Car name`, Property, Value,	scale = "row"	) |>
	annotation_tile(hp)

## ----grouping2, fig.width=10, fig.height=10-----------------------------------
mtcars_tidy_groupings |> 
	group_by(vs, property_group) |>
	heatmap(
		`Car name`, Property, Value	,	
		scale = "row",
		palette_grouping = list(
			
			# For first grouping (vs)
			c("#66C2A5", "#FC8D62"), 
			
			# For second grouping (property_group)
			c("#b58b4c", "#74a6aa")
		)
	) |>
	annotation_tile(hp)


## ----split, fig.width=10, fig.height=10---------------------------------------
mtcars_tidy |> 
	heatmap(`Car name`, Property, Value,	scale = "row"	) |>
	split_rows(2) |>
	split_columns(2)

## ----split2, fig.width=10, fig.height=10--------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row",
		row_km = 2,
		column_km = 2
	) 

## ----custom, fig.width=10, fig.height=10--------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, 
		Property, 
		Value,	
		scale = "row",
		palette_value = c("red", "white", "blue")
	)

## ----redblue, fig.width=10, fig.height=10-------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, 
		Property, 
		Value,	
		scale = "row",
		palette_value = circlize::colorRamp2(
			seq(-2, 2, length.out = 11), 
			RColorBrewer::brewer.pal(11, "RdBu")
		)
	)


## ----flexible, fig.width=10, fig.height=10------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, 
		Property, 
		Value,	
		scale = "row",
		palette_value = circlize::colorRamp2(c(-2, -1, 0, 1, 2), viridis::magma(5))
	)

## ----customtile, fig.width=10, fig.height=10----------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, 
		Property, 
		Value,	
		scale = "row"
	) |>
	add_tile(
		hp, 
		palette = c("red", "white", "blue")
	)

## ----customtile2, fig.width=10, fig.height=10---------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, 
		Property, 
		Value,	
		scale = "row"
	) |>
	annotation_tile(
		hp, 
		palette = circlize::colorRamp2(c(0, 100, 200, 300), viridis::magma(4))
	)

## ----multiple, fig.width=10, fig.height=10------------------------------------
tidyHeatmap::pasilla |>
	group_by(location, type) |>
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row"
	) |>
	annotation_tile(condition) |>
	annotation_tile(activation)

## ----nolegend, fig.width=10, fig.height=10------------------------------------

tidyHeatmap::pasilla |>
	group_by(location, type) |>
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row",
		show_heatmap_legend = FALSE
	) |>
	annotation_tile(condition, show_legend = FALSE) |>
	annotation_tile(activation, show_legend = FALSE)

## ----manyannotations, fig.width=10, fig.height=10-----------------------------
# Create some more data points
pasilla_plus <- 
	tidyHeatmap::pasilla |>
	dplyr::mutate(activation_2 = activation, activation_3 = activation) |> 
	tidyr::nest(data = -sample) |>
	dplyr::mutate(size = rnorm(n(), 4,0.5)) |>
	dplyr::mutate(age = runif(n(), 50, 200)) |>
	tidyr::unnest(data) 

# Plot
pasilla_plus |>
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row"
	) |>
	annotation_tile(condition) |>
	annotation_point(activation) |>
	annotation_numeric(activation_3) |>
	annotation_tile(activation_2) |>
	annotation_bar(size) |>
	annotation_line(age)

## ----size, fig.width=10, fig.height=10----------------------------------------
pasilla_plus |>
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row"
	) |>
	annotation_tile(condition, size = unit(0.3, "cm"),	annotation_name_gp= gpar(fontsize = 8)) |>
	annotation_point(activation, size = unit(0.3, "cm"),	annotation_name_gp= gpar(fontsize = 8)) |>
	annotation_tile(activation_2, size = unit(0.3, "cm"),	annotation_name_gp= gpar(fontsize = 8)) |>
	annotation_bar(size, size = unit(0.3, "cm"),	annotation_name_gp= gpar(fontsize = 8)) |>
	annotation_line(age, size = unit(0.3, "cm"),	annotation_name_gp= gpar(fontsize = 8))

## ----layer, fig.width=10, fig.height=10---------------------------------------
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"
	) |>
	layer_square(
		`count normalised adjusted log` > 6 & sample == "untreated2",
		.size = my_size
	) |>
	layer_arrow_up(
		`count normalised adjusted log` > 6 & sample == "untreated1",
		.size = 4
	)

## ----layertext, fig.width=10, fig.height=10-----------------------------------
tidyHeatmap::pasilla |>
	
	# filter
	filter(symbol %in% head(unique(tidyHeatmap::pasilla$symbol), n = 10)) |>
	
	# Add dynamic text
	mutate(my_text = "mt", my_size = 7) |> 
	
	# Plot
	heatmap(
		.column = sample,
		.row = symbol,
		.value = `count normalised adjusted`,	
		scale = "row"
	) |> 
	layer_text(
		`count normalised adjusted log` > 6 & sample == "untreated3", 
		.value = "a", 
		.size = 15
	) |> 
	layer_text(
	`count normalised adjusted log` > 6 & sample == "untreated2", 
	.value = my_text,
	.size = my_size
)

## ----sidebyside, warning=FALSE, fig.width=10, fig.height=10-------------------

p_heatmap = heatmap(mtcars_tidy, `Car name`, Property, Value, scale = "row") 

p_heatmap + p_heatmap


## ----borders, fig.width=10, fig.height=10-------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
		rect_gp = grid::gpar(col = "#161616", lwd = 0.5)
	) 

## ----droprow, fig.width=10, fig.height=10-------------------------------------
mtcars_tidy |> 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
		cluster_rows = FALSE
	) 

## ----reorder, fig.width=10, fig.height=10-------------------------------------
library(forcats)
mtcars_tidy |> 
	mutate(`Car name` = forcats::fct_reorder(`Car name`, `Car name`, .desc = TRUE)) %>% 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
		cluster_rows = FALSE
	) 

## ----sizedendro, fig.width=10, fig.height=10----------------------------------
mtcars_tidy |> 
	mutate(`Car name` = forcats::fct_reorder(`Car name`, `Car name`, .desc = TRUE)) %>% 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
		column_dend_height = unit(0.2, "cm"), 
		row_dend_width = unit(0.2, "cm")
	) 

## ----sizecolumns, fig.width=10, fig.height=10---------------------------------
mtcars_tidy |> 
	mutate(`Car name` = forcats::fct_reorder(`Car name`, `Car name`, .desc = TRUE)) %>% 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
		row_names_gp = gpar(fontsize = 7),
		column_names_gp = gpar(fontsize = 7),
		column_title_gp = gpar(fontsize = 7),
		row_title_gp = gpar(fontsize = 7)
	) 

## ----align_numeric, fig.width=10, fig.height=10-------------------------------
mtcars_tidy |> 
	mutate(`Car name` = forcats::fct_reorder(`Car name`, `Car name`, .desc = TRUE)) %>% 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row"
	) |> 
  annotation_numeric(hp, align_to="right")

## ----sidelegend, fig.width=10, fig.height=10----------------------------------

heatmap(mtcars_tidy, `Car name`, Property, Value, scale = "row"	) %>%
	as_ComplexHeatmap() %>%
	ComplexHeatmap::draw(heatmap_legend_side = "left"	)

## ----title, fig.width=10, fig.height=10---------------------------------------
mtcars_tidy |> 
    heatmap(`Car name`, Property, Value,    scale = "row"   ) |>
    as_ComplexHeatmap() |>
    ComplexHeatmap::draw(
        column_title = "TITLE", 
        column_title_gp = gpar(fontsize = 16)
    )

## ----patchworkintegrate, fig.width=10, fig.height=10--------------------------
library(ggplot2)
library(patchwork)

p_heatmap =
	mtcars_tidy |> 
	heatmap(
		`Car name`, Property, Value,	
		scale = "row", 
			show_heatmap_legend = FALSE,
		row_names_gp = gpar(fontsize = 7)
	) 

p_ggplot = data.frame(value = 1:10) |> ggplot(aes(value)) + geom_density()

wrap_heatmap(p_heatmap) + 
	p_ggplot +
	
	# Add padding for better aesthetics
	wrap_heatmap(
		p_heatmap,
		padding = grid::unit(c(-30, -0, -0, -10), "points" ),
		clip = FALSE
	) + 
	plot_layout(width = c(1, 0.3, 1))


## ----title2, fig.width=10, fig.height=10--------------------------------------
mtcars_tidy |> 
    heatmap(`Car name`, Property, Value,  scale = "row" ) |>
    wrap_heatmap() +
		ggplot2::ggtitle("TITLE")

## -----------------------------------------------------------------------------
sessionInfo()