diff --git a/NEWS.md b/NEWS.md index de33d3d..7c796a3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,14 @@ ## New features +- New argument `cell.grid` to draw a light rectangle around every cell (behind + the glyphs) and drop the through-center gridlines, so the sized glyphs + (`method = "circle"` or `scale.square = TRUE`) sit inside boxed cells -- the + corrplot boxed-cell look: `ggcorrplot(corr, method = "circle", cell.grid = + TRUE)`. The cell border color is set with the companion argument + `cell.grid.col` (default `"grey90"`). Defaults to `FALSE`; has no effect on a + full-tile square heatmap, whose tiles already carry an `outline.color` border. + - New argument `scale.square` to size the squares by the absolute correlation when `method = "square"`: `ggcorrplot(corr, scale.square = TRUE)` scales each square (larger = stronger correlation) on top of the fill color, the classic diff --git a/R/ggcorrplot.R b/R/ggcorrplot.R index 7c4bc14..37f32a9 100644 --- a/R/ggcorrplot.R +++ b/R/ggcorrplot.R @@ -14,6 +14,15 @@ #' (circles are always sized). Uses \code{circle.scale} to tune the size range. #' As with \code{method = "circle"}, coefficient labels (\code{lab = TRUE}) are #' drawn at full size and may overflow the smallest squares. +#' @param cell.grid logical. If \code{TRUE}, draw a light rectangle around every +#' cell (behind the glyphs) and remove the through-center gridlines, so the +#' sized glyphs (\code{method = "circle"} or \code{scale.square = TRUE}) sit +#' inside boxed cells -- the corrplot boxed-cell look. Defaults to \code{FALSE} +#' (the current behavior). Has no effect on a full-tile square heatmap +#' (\code{method = "square"} without \code{scale.square}), whose tiles already +#' carry a cell border (\code{outline.color}). +#' @param cell.grid.col the color of the \code{cell.grid} cell borders. Defaults +#' to \code{"grey90"}. Only used when \code{cell.grid = TRUE}. #' @param lower.method,upper.method character, an optional per-triangle glyph for #' a mixed layout: one of "square", "circle" or "number" (the coefficient drawn #' as text, colored by its value on the same scale as the fill, so coefficients @@ -267,7 +276,9 @@ ggcorrplot <- function(corr, palette = NULL, preset = NULL, hc.rect.col = "gray30", - scale.square = FALSE) { + scale.square = FALSE, + cell.grid = FALSE, + cell.grid.col = "grey90") { type <- match.arg(type) method <- match.arg(method) # Resolve on insig[1] (not match.arg(insig)) so a caller passing the old @@ -406,8 +417,12 @@ ggcorrplot <- function(corr, outline.color = outline.color, circle.scale = circle.scale, lab_size = lab_size, tl.cex = tl.cex, tl.col = tl.col, digits = digits, nsmall = nsmall, leading.zero = leading.zero, - scale.square = scale.square + scale.square = scale.square, + cell.grid = cell.grid, cell.grid.col = cell.grid.col ) + # A mixed layout always boxes at least the diagonal (name) region when + # cell.grid = TRUE, so the gridline blanking below is always consistent here. + draw.cell.grid <- cell.grid } else { p <- ggplot2::ggplot( @@ -415,6 +430,18 @@ ggcorrplot <- function(corr, mapping = ggplot2::aes(x = .data[["Var1"]], y = .data[["Var2"]], fill = .data[["value"]]) ) + # cell.grid: draw a light cell-rectangle grid BEHIND the sized glyphs so they + # sit inside boxed cells (the corrplot look). Added before the glyph layer so + # it renders underneath. Skipped for a full-tile square heatmap (method = + # "square" without scale.square): its geom_tile already carries a cell border + # (outline.color), so a second border would double-draw. fill = NA overrides + # the inherited aes(fill = value) for drawing while still training the same + # fill scale as the glyph layer (byte-identical fill legend). + draw.cell.grid <- cell.grid && !(method == "square" && !scale.square) + if (draw.cell.grid) { + p <- p + ggplot2::geom_tile(fill = NA, colour = cell.grid.col) + } + # modification based on method (extracted so the mixed-method path can request # a different glyph per triangle from the same builder, P0.0) p <- p + .method_layer(method, @@ -489,6 +516,18 @@ ggcorrplot <- function(corr, ), axis.text.y = ggplot2::element_text(size = tl.cex, colour = tl.col) ) + # cell.grid replaces the through-center gridlines with per-cell rectangles, so + # blank the panel grid (added after the theme() above so it wins). Gated on + # draw.cell.grid -- TRUE only when boxes were actually drawn -- so a full-tile + # square heatmap (which draws no box and keeps its gridlines behind the opaque + # tiles) is genuinely untouched, matching the documented "no effect". This also + # keeps a lower/upper full-tile square's gridlines in the blank triangle intact. + if (draw.cell.grid) { + p <- p + ggplot2::theme( + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank() + ) + } if (coord.fixed) { p <- p + ggplot2::coord_fixed() } else { @@ -876,7 +915,8 @@ cor_pmat <- function(x, ..., use = c("pairwise.complete.obs", "everything")) { # variable name. Returns a list of ggplot components. .mixed_layers <- function(df, lower.method, upper.method, outline.color, circle.scale, lab_size, tl.cex, tl.col, - digits, nsmall, leading.zero, scale.square = FALSE) { + digits, nsmall, leading.zero, scale.square = FALSE, + cell.grid = FALSE, cell.grid.col = "grey90") { xi <- as.integer(df$Var1) yi <- as.integer(df$Var2) regions <- list( @@ -891,6 +931,16 @@ cor_pmat <- function(x, ..., use = c("pairwise.complete.obs", "everything")) { d <- r$data if (nrow(d) == 0) next m <- r$method + # cell.grid: box every region behind its glyph, EXCEPT a full-tile square + # region (m == "square" without scale.square), whose geom_tile already draws + # an outline.color border -- a second box would double-draw. Added before the + # region's glyph so it renders underneath. fill = NA (no aes fill inherited + # from the mixed base plot) draws only the border. + if (cell.grid && !(m == "square" && !scale.square)) { + layers <- c(layers, list(ggplot2::geom_tile( + data = d, fill = NA, colour = cell.grid.col + ))) + } if (m == "square" && !scale.square) { layers <- c(layers, list(ggplot2::geom_tile( data = d, diff --git a/inst/WORDLIST b/inst/WORDLIST index b89d550..e1c6b1c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -6,6 +6,7 @@ erroring ggplot ggtheme glyphs +gridlines hc hclust http diff --git a/man/ggcorrplot.Rd b/man/ggcorrplot.Rd index ae8c58f..fc22bfc 100644 --- a/man/ggcorrplot.Rd +++ b/man/ggcorrplot.Rd @@ -47,7 +47,9 @@ ggcorrplot( palette = NULL, preset = NULL, hc.rect.col = "gray30", - scale.square = FALSE + scale.square = FALSE, + cell.grid = FALSE, + cell.grid.col = "grey90" ) cor_pmat(x, ..., use = c("pairwise.complete.obs", "everything")) @@ -220,6 +222,17 @@ squares, the current behavior). Has no effect for \code{method = "circle"} As with \code{method = "circle"}, coefficient labels (\code{lab = TRUE}) are drawn at full size and may overflow the smallest squares.} +\item{cell.grid}{logical. If \code{TRUE}, draw a light rectangle around every +cell (behind the glyphs) and remove the through-center gridlines, so the +sized glyphs (\code{method = "circle"} or \code{scale.square = TRUE}) sit +inside boxed cells -- the corrplot boxed-cell look. Defaults to \code{FALSE} +(the current behavior). Has no effect on a full-tile square heatmap +(\code{method = "square"} without \code{scale.square}), whose tiles already +carry a cell border (\code{outline.color}).} + +\item{cell.grid.col}{the color of the \code{cell.grid} cell borders. Defaults +to \code{"grey90"}. Only used when \code{cell.grid = TRUE}.} + \item{x}{numeric matrix or data frame} \item{...}{other arguments to be passed to the function cor.test.} diff --git a/tests/testthat/_snaps/vdiffr/ggcorrplot-works-cell-grid-circle.svg b/tests/testthat/_snaps/vdiffr/ggcorrplot-works-cell-grid-circle.svg new file mode 100644 index 0000000..0bd2f3b --- /dev/null +++ b/tests/testthat/_snaps/vdiffr/ggcorrplot-works-cell-grid-circle.svg @@ -0,0 +1,323 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +mpg +cyl +disp +hp +drat +wt +qsec +vs +am +gear +carb +mpg +cyl +disp +hp +drat +wt +qsec +vs +am +gear +carb +Corr + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +ggcorrplot works - cell grid circle + + diff --git a/tests/testthat/test-cell-grid.R b/tests/testthat/test-cell-grid.R new file mode 100644 index 0000000..6a31793 --- /dev/null +++ b/tests/testthat/test-cell-grid.R @@ -0,0 +1,104 @@ +# cell.grid: draw a light rectangle behind every (sized) cell -- the corrplot +# boxed-cell look. Default FALSE keeps every existing call byte-identical. + +corr <- round(cor(mtcars), 1) +geoms <- function(p) unname(vapply(p$layers, function(l) class(l$geom)[1], "")) +first_layer_col <- function(p) p$layers[[1]]$aes_params$colour + +test_that("cell.grid defaults to FALSE: no cell-grid layer, output unchanged", { + # circle default has exactly one glyph layer (GeomPoint), no background tile + p <- ggcorrplot(corr, method = "circle") + expect_identical(geoms(p), "GeomPoint") + # explicit FALSE == implicit default (byte-identical built data) + expect_equal( + ggplot2::ggplot_build(ggcorrplot(corr, method = "circle"))$data, + ggplot2::ggplot_build(ggcorrplot(corr, method = "circle", cell.grid = FALSE))$data + ) +}) + +test_that("cell.grid = TRUE boxes circles: a GeomTile is drawn BEFORE the glyph", { + p <- ggcorrplot(corr, method = "circle", cell.grid = TRUE) + g <- geoms(p) + # background tile first, glyph second + expect_identical(g[1], "GeomTile") + expect_identical(g[2], "GeomPoint") + # the background tile has no fill and uses the default cell.grid.col + expect_true(is.na(p$layers[[1]]$aes_params$fill)) + expect_identical(first_layer_col(p), "grey90") +}) + +test_that("cell.grid = TRUE boxes size-scaled squares", { + p <- ggcorrplot(corr, scale.square = TRUE, cell.grid = TRUE) + g <- geoms(p) + expect_identical(g[1], "GeomTile") + expect_identical(g[2], "GeomPoint") + expect_identical(p$layers[[2]]$aes_params$shape, 22) +}) + +test_that("cell.grid.col sets the cell border color", { + p <- ggcorrplot(corr, method = "circle", cell.grid = TRUE, cell.grid.col = "black") + expect_identical(first_layer_col(p), "black") +}) + +test_that("cell.grid has no effect on a full-tile square heatmap", { + # method = "square" without scale.square already draws a bordered tile, so no + # extra background tile is added and the built data is unchanged + a <- ggcorrplot(corr, method = "square") + b <- ggcorrplot(corr, method = "square", cell.grid = TRUE) + expect_identical(geoms(a), "GeomTile") + expect_identical(geoms(b), "GeomTile") # still a single tile layer + expect_equal( + ggplot2::ggplot_build(a)$data, + ggplot2::ggplot_build(b)$data + ) + # "no effect" must include the theme: the gridlines are NOT blanked for a + # full-tile square heatmap (no box was drawn to replace them). Checked on a + # lower triangle, where those gridlines are actually visible in the blank half. + low <- ggcorrplot(corr, method = "square", type = "lower", cell.grid = TRUE) + expect_false(inherits(b$theme$panel.grid.major, "element_blank")) + expect_false(inherits(low$theme$panel.grid.major, "element_blank")) +}) + +test_that("cell.grid = TRUE blanks the panel gridlines", { + off <- ggcorrplot(corr, method = "circle") + on <- ggcorrplot(corr, method = "circle", cell.grid = TRUE) + # default keeps the theme's gridlines; cell.grid removes them + expect_false(inherits(off$theme$panel.grid.major, "element_blank")) + expect_true(inherits(on$theme$panel.grid.major, "element_blank")) + expect_true(inherits(on$theme$panel.grid.minor, "element_blank")) +}) + +test_that("cell.grid boxes every region of a mixed layout except full-tile squares", { + # circle, number and diagonal-name regions each get a background box tile + p <- ggcorrplot(corr, + lower.method = "number", upper.method = "circle", cell.grid = TRUE, + show.legend = FALSE + ) + g <- geoms(p) + tile_idx <- which(g == "GeomTile") + # one box per non-empty region (lower number, upper circle, diagonal name) + expect_identical(length(tile_idx), 3L) + # every box carries the cell.grid color and maps no fill (transparent box) + cols <- vapply(tile_idx, function(i) p$layers[[i]]$aes_params$colour, "") + expect_true(all(cols == "grey90")) + has_fill_map <- vapply(tile_idx, function(i) "fill" %in% names(p$layers[[i]]$mapping), TRUE) + expect_false(any(has_fill_map)) +}) + +test_that("a full-tile square region in a mixed layout is not double-boxed", { + # lower = square (full tile, has its own outline.color border) -> no extra + # cell.grid tile for that region; upper = circle -> boxed + p <- ggcorrplot(corr, + lower.method = "square", upper.method = "circle", cell.grid = TRUE, + show.legend = FALSE + ) + g <- geoms(p) + # GeomTile layers = the full-tile square region (1) + the circle region's box + # (1) + the diagonal name box (1) = fewer than if every region were boxed. + # Assert the full-tile square region's tile is the bordered heatmap tile, not a + # transparent cell.grid box: it maps fill and uses outline.color. + square_tiles <- Filter(function(l) { + class(l$geom)[1] == "GeomTile" && "fill" %in% names(l$mapping) + }, p$layers) + expect_true(length(square_tiles) >= 1) +}) diff --git a/tests/testthat/test-vdiffr.R b/tests/testthat/test-vdiffr.R index dfab78b..9308603 100644 --- a/tests/testthat/test-vdiffr.R +++ b/tests/testthat/test-vdiffr.R @@ -78,5 +78,11 @@ if (getRversion() >= "4.1") { title = "ggcorrplot works - scale square", fig = ggcorrplot(corr, scale.square = TRUE, outline.color = "white") ) + + set.seed(123) + vdiffr::expect_doppelganger( + title = "ggcorrplot works - cell grid circle", + fig = ggcorrplot(corr, method = "circle", cell.grid = TRUE) + ) }) }