From 9c850565dd114ec4ba973dd14c0015ead21deefc Mon Sep 17 00:00:00 2001 From: yun Date: Fri, 2 Aug 2024 17:58:02 +0800 Subject: [PATCH] update vignetee --- DESCRIPTION | 1 + vignettes/Single-Heatmap-Colors.Rmd | 227 ++++++++++++++++++++++++++++ vignettes/single-heatmap.Rmd | 111 -------------- 3 files changed, 228 insertions(+), 111 deletions(-) create mode 100644 vignettes/Single-Heatmap-Colors.Rmd delete mode 100644 vignettes/single-heatmap.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 9203c79c..9b6c24a2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ BugReports: https://github.com/Yunuuuu/ggalign/issues Suggests: knitr, rmarkdown, + scales, testthat (>= 3.0.0) Config/testthat/edition: 3 VignetteBuilder: knitr diff --git a/vignettes/Single-Heatmap-Colors.Rmd b/vignettes/Single-Heatmap-Colors.Rmd new file mode 100644 index 00000000..62d59a4c --- /dev/null +++ b/vignettes/Single-Heatmap-Colors.Rmd @@ -0,0 +1,227 @@ +--- +title: "single-heatmap" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{single-heatmap} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +In this thread, We'll use `ggalign` to draw all the heatmap in + + +```{r setup} +library(ggalign) +``` + +```{r} +set.seed(123) +nr1 <- 4 +nr2 <- 8 +nr3 <- 6 +nr <- nr1 + nr2 + nr3 +nc1 <- 6 +nc2 <- 8 +nc3 <- 10 +nc <- nc1 + nc2 + nc3 +mat <- cbind( + rbind( + matrix(rnorm(nr1 * nc1, mean = 1, sd = 0.5), nrow = nr1), + matrix(rnorm(nr2 * nc1, mean = 0, sd = 0.5), nrow = nr2), + matrix(rnorm(nr3 * nc1, mean = 0, sd = 0.5), nrow = nr3) + ), + rbind( + matrix(rnorm(nr1 * nc2, mean = 0, sd = 0.5), nrow = nr1), + matrix(rnorm(nr2 * nc2, mean = 1, sd = 0.5), nrow = nr2), + matrix(rnorm(nr3 * nc2, mean = 0, sd = 0.5), nrow = nr3) + ), + rbind( + matrix(rnorm(nr1 * nc3, mean = 0.5, sd = 0.5), nrow = nr1), + matrix(rnorm(nr2 * nc3, mean = 0.5, sd = 0.5), nrow = nr2), + matrix(rnorm(nr3 * nc3, mean = 1, sd = 0.5), nrow = nr3) + ) +) +mat <- mat[sample(nr, nr), sample(nc, nc)] +rownames(mat) <- paste0("row", seq_len(nr)) +colnames(mat) <- paste0("column", seq_len(nc)) +``` + +Because the `ComplexHeatmap` will reorder the dendrogram by default, but +`align_dendro` won't change the tree layout. In following codes, we hypothesized +that the arguments `row_dend_reorder` and `column_dend_reorder` of +`ComplexHeatmap::Heatmap` is `FALSE`. + +It is important to note that `ggalign` considers the left-bottom as the starting +point, while `ComplexHeatmap` considers the left-top as the starting point. + + +```{r} +ggheatmap(mat) + + scale_fill_gradient2(low = "#2600D1FF", high = "#EE3F3FFF") + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +# ComplexHeatmap::Heatmap(mat, +# row_dend_reorder = FALSE, +# column_dend_reorder = FALSE +# ) +``` + +```{r} +ggheatmap(mat) + + scale_fill_gradient2(low = "green", high = "red") + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +mat2 <- mat +mat2[1, 1] <- 100000 +ggheatmap(mat2) + + scale_fill_gradient2( + low = "green", high = "red", + limits = c(-2, 2), + oob = scales::squish + ) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + theme(axis.text.x = element_text(angle = -60, hjust = 0)) + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +h1 <- ggheatmap(mat) + + scale_fill_gradient2(name = "mat", low = "green", high = "red") + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + theme(axis.text.x = element_text(angle = -60, hjust = 0)) + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) + +h2 <- ggheatmap(mat / 4) + + scale_fill_gradient2( + name = "mat/4", limits = c(-2, 2L), + oob = scales::squish, + low = "green", high = "red" + ) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + theme(axis.text.x = element_text(angle = -60, hjust = 0)) + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) + +h3 <- ggheatmap(abs(mat)) + + scale_fill_gradient2(name = "abs(mat)", low = "green", high = "red") + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + theme(axis.text.x = element_text(angle = -60, hjust = 0)) + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) + +patchwork::wrap_plots( + build_patchwork(h1), + build_patchwork(h2), + build_patchwork(h3), + ncol = 2L +) +``` + +```{r} +ggheatmap(mat) + + scale_fill_gradientn(colors = rev(rainbow(10))) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +discrete_mat <- matrix(sample(1:4, 100, replace = TRUE), 10, 10) +colors <- structure(1:4, names = c("1", "2", "3", "4")) # black, red, green, blue +ggheatmap(discrete_mat, filling = FALSE) + + geom_tile(aes(fill = factor(value))) + + scale_fill_manual(values = colors) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +discrete_mat <- matrix(sample(letters[1:4], 100, replace = TRUE), 10, 10) +colors <- structure(1:4, names = letters[1:4]) +ggheatmap(discrete_mat) + + scale_fill_manual(values = colors) +``` + +```{r} +mat_with_na <- mat +na_index <- sample(c(TRUE, FALSE), + nrow(mat) * ncol(mat), + replace = TRUE, prob = c(1, 9) +) +mat_with_na[na_index] <- NA +ggheatmap(mat_with_na) + + scale_fill_gradient2( + low = "#2600D1FF", + high = "#EE3F3FFF", + na.value = "black" + ) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +We won't compare the LAB and RGB space. + +```{r} +ggheatmap(mat) + + scale_fill_gradient2(low = "#2600D1FF", high = "#EE3F3FFF") + + theme(panel.border = element_rect(linetype = "dashed", fill = NA)) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +ggheatmap(mat, filling = FALSE) + + geom_tile(aes(fill = value), width = 0.95, height = 0.95) + + scale_fill_gradient2(low = "#2600D1FF", high = "#EE3F3FFF") + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` + +```{r} +ggheatmap(mat, filling = FALSE) + + hmanno("r", size = unit(15, "mm")) + + align_dendro() + + hmanno("t", size = unit(15, "mm")) + + align_dendro() & + theme(plot.margin = margin()) +``` diff --git a/vignettes/single-heatmap.Rmd b/vignettes/single-heatmap.Rmd deleted file mode 100644 index 946f6663..00000000 --- a/vignettes/single-heatmap.Rmd +++ /dev/null @@ -1,111 +0,0 @@ ---- -title: "single-heatmap" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{single-heatmap} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -We'll use ggalign to draw all the heatmap in - - -```{r setup} -library(ggalign) -``` - -```{r} -set.seed(123) -nr1 <- 4 -nr2 <- 8 -nr3 <- 6 -nr <- nr1 + nr2 + nr3 -nc1 <- 6 -nc2 <- 8 -nc3 <- 10 -nc <- nc1 + nc2 + nc3 -mat <- cbind( - rbind( - matrix(rnorm(nr1 * nc1, mean = 1, sd = 0.5), nrow = nr1), - matrix(rnorm(nr2 * nc1, mean = 0, sd = 0.5), nrow = nr2), - matrix(rnorm(nr3 * nc1, mean = 0, sd = 0.5), nrow = nr3) - ), - rbind( - matrix(rnorm(nr1 * nc2, mean = 0, sd = 0.5), nrow = nr1), - matrix(rnorm(nr2 * nc2, mean = 1, sd = 0.5), nrow = nr2), - matrix(rnorm(nr3 * nc2, mean = 0, sd = 0.5), nrow = nr3) - ), - rbind( - matrix(rnorm(nr1 * nc3, mean = 0.5, sd = 0.5), nrow = nr1), - matrix(rnorm(nr2 * nc3, mean = 0.5, sd = 0.5), nrow = nr2), - matrix(rnorm(nr3 * nc3, mean = 1, sd = 0.5), nrow = nr3) - ) -) -mat <- mat[sample(nr, nr), sample(nc, nc)] -rownames(mat) <- paste0("row", seq_len(nr)) -colnames(mat) <- paste0("column", seq_len(nc)) -``` - -```{r} -ggheatmap(mat) + - scale_fill_gradient2(low = "#2600D1FF", high = "#EE3F3FFF") + - hmanno("r", size = unit(15, "mm")) + - align_dendro() + - hmanno("t", size = unit(15, "mm")) + - align_dendro() & - theme(plot.margin = margin()) -``` - -```{r} -ggheatmap(mat) + - scale_fill_gradient2(low = "green", high = "red") + - hmanno("r", size = unit(15, "mm")) + - align_dendro() + - hmanno("t", size = unit(15, "mm")) + - align_dendro() & - theme(plot.margin = margin()) -``` - -```{r} -mat2 <- mat -mat2[1, 1] <- 100000 -ggheatmap(mat2) + - scale_fill_gradient2( - low = "green", high = "red", - limits = c(-2, 2), - oob = scales::squish - ) + - hmanno("r", size = unit(15, "mm")) + - align_dendro() + - theme(axis.text.x = element_text(angle = -60, hjust = 0)) + - hmanno("t", size = unit(15, "mm")) + - align_dendro() & - theme(plot.margin = margin()) -``` - -```{r} -mat_with_na <- mat -na_index <- sample(c(TRUE, FALSE), - nrow(mat) * ncol(mat), - replace = TRUE, prob = c(1, 9) -) -mat_with_na[na_index] <- NA -ggheatmap(mat_with_na) + - scale_fill_gradient2( - low = "#2600D1FF", - high = "#EE3F3FFF", - na.value = "black" - ) + - hmanno("r", size = unit(15, "mm")) + - align_dendro() + - hmanno("t", size = unit(15, "mm")) + - align_dendro() & - theme(plot.margin = margin()) -```