From c9febb74dddab29b7e60488c91564796387f2785 Mon Sep 17 00:00:00 2001 From: Chris Sobczak Date: Wed, 17 Jun 2026 00:23:03 -0700 Subject: Rename corplot to heatmap --- NAMESPACE | 2 +- R/corplot.R | 142 --------------------------------------- R/heatmap.R | 142 +++++++++++++++++++++++++++++++++++++++ README.Rmd | 2 +- README.md | 7 +- man/corplot.Rd | 26 ------- man/figures/README-example-1.png | Bin 48834 -> 50206 bytes man/heatmap.Rd | 26 +++++++ tests/testthat/test-corplot.R | 5 -- tests/testthat/text-heatmap.R | 5 ++ 10 files changed, 181 insertions(+), 176 deletions(-) delete mode 100644 R/corplot.R create mode 100644 R/heatmap.R delete mode 100644 man/corplot.Rd create mode 100644 man/heatmap.Rd delete mode 100644 tests/testthat/test-corplot.R create mode 100644 tests/testthat/text-heatmap.R diff --git a/NAMESPACE b/NAMESPACE index 1a107ff..266fb54 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,7 @@ # Generated by roxygen2: do not edit by hand -export(corplot) export(gg_csobczak) +export(heatmap) export(networkplot) import(ggplot2) import(ggraph) diff --git a/R/corplot.R b/R/corplot.R deleted file mode 100644 index e849a92..0000000 --- a/R/corplot.R +++ /dev/null @@ -1,142 +0,0 @@ -#' Correlation Plot (Upper Triangle) -#' -#' Minimal ggplot2 correlation plot showing the upper triangle -#' in the top-right corner with no axis labels. -#' @param R A square numeric correlation matrix -#' @param title Optional plot title -#' -#' @return A ggplot object -#' -#' @examples -#' X <- matrix(data = rnorm(100), nrow = 10) -#' R <- cor(X) -#' corplot(R, title = 'Example Correlation Plot') -#' -#' @importFrom reshape2 melt -#' @import ggplot2 -#' @export -corplot <- function(R, title = NULL){ - R_list <- tryCatch({ - if(is.matrix(R)){ - cnames <- colnames(R) - rnames <- rownames(R) - if(nrow(R) == ncol(R)){ - list( - R = R[upper.tri(R)], - cnames = cnames, - rnames = rnames, - p = ncol(R) - ) - } - }else if(is.vector(R)){ - m <- length(R) - n <- (1 + sqrt(1 + 8 * m)) / 2 - if(n == floor(n)){ - list( - R = R, - cnames = NULL, - rnames = NULL, - p = n - ) - }else{ - stop('Input length not compatible with upper triangle') - } - }else{ - Rm <- as.matrix(R) - cnames <- colnames(Rm) - rnames <- rownames(Rm) - if(nrow(Rm) == ncol(Rm)){ - list( - R = Rm[upper.tri(Rm)], - cnames = cnames, - rnames = rnames, - p = ncol(Rm) - ) - } - } - }, error = function(e){ - stop(paste('Invalid input for corplot:', e$message)) - }) - - if(is.null(R_list$cnames)){ - R_list$cnames <- as.character(seq_len(R_list$p)) - } - if(is.null(R_list$rnames)){ - R_list$rnames <- as.character(seq_len(R_list$p)) - } - - # Now get a df from the upper triangle - m <- length(R_list$R) - n <- as.integer((1 + sqrt(1 + 8 * m)) / 2) - M <- matrix(NA, n, n) - M[upper.tri(M)] <- R_list$R - colnames(M) <- R_list$cnames - rownames(M) <- R_list$rnames - df <- reshape2::melt(M, na.rm = TRUE) - colnames(df) <- c('i', 'j', 'value') - - col_label_df <- data.frame( - j = seq_len(n)[-1], - i = 0, - label = R_list$cnames[-1] - ) - row_label_df <- data.frame( - j = seq_len(n)[-n], - i = seq_len(n)[-n], - label = R_list$cnames[-n] - ) - - max_nchar <- max(nchar(R_list$cnames)) - top_margin <- 5 + max_nchar * 2 - - # And plot it - p <- ggplot2::ggplot( - data = df, - ggplot2::aes(x = .data$j, y = .data$i, fill = .data$value) - ) + - ggplot2::geom_tile() + - ggplot2::geom_text( - data = col_label_df, - ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), - inherit.aes = FALSE, - angle = 90, - hjust = 0, - vjust = 0.5 - ) + - ggplot2::geom_text( - data = row_label_df, - ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), - inherit.aes = FALSE, - hjust = 1, - vjust = 0.5 - ) + - ggplot2::scale_fill_gradient2( - low = 'red', - mid = 'white', - high = 'blue', - midpoint = 0, - limits = c(-1, 1), - name = NULL, - guide = 'none' - ) + - ggplot2::scale_y_reverse() + - ggplot2::coord_fixed(clip = 'off') + - ggplot2::theme_void() + - ggplot2::theme( - plot.margin = ggplot2::margin( - t = top_margin, - r = 5, - b = 5, - l = 5 - ) - ) - - if(!is.null(title)){ - p <- p + - ggplot2::ggtitle(title) + - ggplot2::theme( - plot.title = ggplot2::element_text(hjust = 0.5) - ) - } - return(p) -} diff --git a/R/heatmap.R b/R/heatmap.R new file mode 100644 index 0000000..569f0ec --- /dev/null +++ b/R/heatmap.R @@ -0,0 +1,142 @@ +#' Heatmap Plot (Upper Triangle) +#' +#' Minimal ggplot2 relationship structure plot showing the upper triangle +#' in the top-right corner with no axis labels. +#' @param R A square numeric correlation matrix +#' @param title Optional plot title +#' +#' @return A ggplot object +#' +#' @examples +#' X <- matrix(data = rnorm(100), nrow = 10) +#' R <- cor(X) +#' heatmap(R, title = 'Example Correlation Plot') +#' +#' @importFrom reshape2 melt +#' @import ggplot2 +#' @export +heatmap <- function(R, title = NULL){ + R_list <- tryCatch({ + if(is.matrix(R)){ + cnames <- colnames(R) + rnames <- rownames(R) + if(nrow(R) == ncol(R)){ + list( + R = R[upper.tri(R)], + cnames = cnames, + rnames = rnames, + p = ncol(R) + ) + } + }else if(is.vector(R)){ + m <- length(R) + n <- (1 + sqrt(1 + 8 * m)) / 2 + if(n == floor(n)){ + list( + R = R, + cnames = NULL, + rnames = NULL, + p = n + ) + }else{ + stop('Input length not compatible with upper triangle') + } + }else{ + Rm <- as.matrix(R) + cnames <- colnames(Rm) + rnames <- rownames(Rm) + if(nrow(Rm) == ncol(Rm)){ + list( + R = Rm[upper.tri(Rm)], + cnames = cnames, + rnames = rnames, + p = ncol(Rm) + ) + } + } + }, error = function(e){ + stop(paste('Invalid input for corplot:', e$message)) + }) + + if(is.null(R_list$cnames)){ + R_list$cnames <- as.character(seq_len(R_list$p)) + } + if(is.null(R_list$rnames)){ + R_list$rnames <- as.character(seq_len(R_list$p)) + } + + # Now get a df from the upper triangle + m <- length(R_list$R) + n <- as.integer((1 + sqrt(1 + 8 * m)) / 2) + M <- matrix(NA, n, n) + M[upper.tri(M)] <- R_list$R + colnames(M) <- R_list$cnames + rownames(M) <- R_list$rnames + df <- reshape2::melt(M, na.rm = TRUE) + colnames(df) <- c('i', 'j', 'value') + + col_label_df <- data.frame( + j = seq_len(n)[-1], + i = 0, + label = R_list$cnames[-1] + ) + row_label_df <- data.frame( + j = seq_len(n)[-n], + i = seq_len(n)[-n], + label = R_list$cnames[-n] + ) + + max_nchar <- max(nchar(R_list$cnames)) + top_margin <- 5 + max_nchar * 2 + + # And plot it + p <- ggplot2::ggplot( + data = df, + ggplot2::aes(x = .data$j, y = .data$i, fill = .data$value) + ) + + ggplot2::geom_tile() + + ggplot2::geom_text( + data = col_label_df, + ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), + inherit.aes = FALSE, + angle = 90, + hjust = 0, + vjust = 0.5 + ) + + ggplot2::geom_text( + data = row_label_df, + ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), + inherit.aes = FALSE, + hjust = 1, + vjust = 0.5 + ) + + ggplot2::scale_fill_gradient2( + low = 'red', + mid = 'white', + high = 'blue', + midpoint = 0, + limits = c(-1, 1), + name = NULL, + guide = 'none' + ) + + ggplot2::scale_y_reverse() + + ggplot2::coord_fixed(clip = 'off') + + ggplot2::theme_void() + + ggplot2::theme( + plot.margin = ggplot2::margin( + t = top_margin, + r = 5, + b = 5, + l = 5 + ) + ) + + if(!is.null(title)){ + p <- p + + ggplot2::ggtitle(title) + + ggplot2::theme( + plot.title = ggplot2::element_text(hjust = 0.5) + ) + } + return(p) +} diff --git a/README.Rmd b/README.Rmd index ae302ae..2633b1e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -37,7 +37,7 @@ library(csobczak.r) library(patchwork) X <- matrix(data = rnorm(100), nrow = 10) R <- cor(X) -p1 <- corplot(R, title = 'Example Correlation Plot') +p1 <- heatmap(R, title = 'Example Correlation Plot') p2 <- networkplot(R, title = 'Example Network Plot') p1 + p2 ``` diff --git a/README.md b/README.md index 5f95c2a..950f68c 100644 --- a/README.md +++ b/README.md @@ -25,10 +25,15 @@ pak::pkg_install('git::https://codeberg.org/csobczak/csobczak.r') ``` r library(csobczak.r) +#> +#> Attaching package: 'csobczak.r' +#> The following object is masked from 'package:stats': +#> +#> heatmap library(patchwork) X <- matrix(data = rnorm(100), nrow = 10) R <- cor(X) -p1 <- corplot(R, title = 'Example Correlation Plot') +p1 <- heatmap(R, title = 'Example Correlation Plot') p2 <- networkplot(R, title = 'Example Network Plot') p1 + p2 ``` diff --git a/man/corplot.Rd b/man/corplot.Rd deleted file mode 100644 index a27d577..0000000 --- a/man/corplot.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/corplot.R -\name{corplot} -\alias{corplot} -\title{Correlation Plot (Upper Triangle)} -\usage{ -corplot(R, title = NULL) -} -\arguments{ -\item{R}{A square numeric correlation matrix} - -\item{title}{Optional plot title} -} -\value{ -A ggplot object -} -\description{ -Minimal ggplot2 correlation plot showing the upper triangle -in the top-right corner with no axis labels. -} -\examples{ -X <- matrix(data = rnorm(100), nrow = 10) -R <- cor(X) -corplot(R, title = 'Example Correlation Plot') - -} diff --git a/man/figures/README-example-1.png b/man/figures/README-example-1.png index a5e59b1..a15dc43 100644 Binary files a/man/figures/README-example-1.png and b/man/figures/README-example-1.png differ diff --git a/man/heatmap.Rd b/man/heatmap.Rd new file mode 100644 index 0000000..51472de --- /dev/null +++ b/man/heatmap.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/heatmap.R +\name{heatmap} +\alias{heatmap} +\title{Heatmap Plot (Upper Triangle)} +\usage{ +heatmap(R, title = NULL) +} +\arguments{ +\item{R}{A square numeric correlation matrix} + +\item{title}{Optional plot title} +} +\value{ +A ggplot object +} +\description{ +Minimal ggplot2 relationship structure plot showing the upper triangle +in the top-right corner with no axis labels. +} +\examples{ +X <- matrix(data = rnorm(100), nrow = 10) +R <- cor(X) +heatmap(R, title = 'Example Correlation Plot') + +} diff --git a/tests/testthat/test-corplot.R b/tests/testthat/test-corplot.R deleted file mode 100644 index 2aecdc1..0000000 --- a/tests/testthat/test-corplot.R +++ /dev/null @@ -1,5 +0,0 @@ -test_that("returns a ggplot object", { - x <- matrix(data = rnorm(100), nrow = 10) - p <- corplot(x) - inherits(p, 'ggplot') -}) diff --git a/tests/testthat/text-heatmap.R b/tests/testthat/text-heatmap.R new file mode 100644 index 0000000..94ea14e --- /dev/null +++ b/tests/testthat/text-heatmap.R @@ -0,0 +1,5 @@ +test_that("returns a ggplot object", { + x <- matrix(data = rnorm(100), nrow = 10) + p <- heatmap(x) + inherits(p, 'ggplot') +}) -- cgit v1.2.3