From 0c1c43943c9b23be402e5e8da341a0d7a80db138 Mon Sep 17 00:00:00 2001 From: nfrerebeau Date: Wed, 23 Oct 2024 12:29:34 +0200 Subject: [PATCH] hist() now produces a single histogram --- NEWS.md | 2 + R/AllGenerics.R | 12 +- R/hist.R | 93 ++--- inst/examples/ex-hist.R | 6 +- inst/tinytest/_tinysnapshot/plot_hist.svg | 328 +++--------------- .../_tinysnapshot/plot_hist_count.svg | 85 +++++ inst/tinytest/test_plot.R | 5 +- man/hist.Rd | 26 +- 8 files changed, 207 insertions(+), 350 deletions(-) create mode 100644 inst/tinytest/_tinysnapshot/plot_hist_count.svg diff --git a/NEWS.md b/NEWS.md index aa64d3f..4cb948c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,6 @@ # nexus 0.3.0.9000 +## Breaking changes +* `hist()` now produces a single histogram. # nexus 0.3.0 ## New classes and methods diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 7e1ab1b..65ca4f6 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -1073,13 +1073,15 @@ NULL #' #' Produces an histogram of univariate ILR data (see Filzmoser *et al.*, 2009). #' @param x A [`CompositionMatrix-class`] object. +#' @param select A length-one `vector` of column indices. +#' @param breaks An object specifying how to compute the breakpoints +#' (see [graphics::hist()]). #' @param freq A [`logical`] scalar: should absolute frequencies (counts) be #' displayed? If `FALSE` (the default), relative frequencies (probabilities) #' are displayed (see [graphics::hist()]). -#' @param flip A [`logical`] scalar: should the y-axis (ticks and numbering) be -#' flipped from side 2 (left) to 4 (right) from variable to variable? -#' @param ncol An [`integer`] specifying the number of columns to use. -#' Defaults to 1 for up to 4 parts, otherwise to 2. +#' @param labels A [`logical`] scalar: should labels be drawn on top of bars? +#' If `TRUE`, draw the counts or rounded densities; if `labels` is a +#' `character` vector, draw itself. #' @param main A [`character`] string giving a main title for the plot. #' @param sub A [`character`] string giving a subtitle for the plot. #' @param ann A [`logical`] scalar: should the default annotation (title and x @@ -1087,7 +1089,7 @@ NULL #' @param axes A [`logical`] scalar: should axes be drawn on the plot? #' @param frame.plot A [`logical`] scalar: should a box be drawn around the #' plot? -#' @param ... Further parameters to be passed to [graphics::hist()]. +#' @param ... Further graphical parameters. #' @return #' `hist()` is called for its side-effects: is results in a graphic being #' displayed (invisibly return `x`). diff --git a/R/hist.R b/R/hist.R index 13c00e6..a00be0a 100644 --- a/R/hist.R +++ b/R/hist.R @@ -5,30 +5,18 @@ NULL # CompositionMatrix ============================================================ #' @export #' @method hist CompositionMatrix -hist.CompositionMatrix <- function(x, ..., freq = FALSE, - ncol = NULL, flip = FALSE, +hist.CompositionMatrix <- function(x, ..., select = 1, + breaks = "Sturges", + freq = FALSE, labels = FALSE, main = NULL, sub = NULL, ann = graphics::par("ann"), axes = TRUE, frame.plot = axes) { - m <- nrow(x) - p <- ncol(x) - - ## Plot - if (is.null(ncol)) ncol <- if (p > 4) 2 else 1 - nrow <- ceiling(p / ncol) + ## Validation + if (is.character(select)) select <- match(select, labels(x)) + arkhe::assert_length(select, 1) ## Graphical parameters - ## Save and restore - if (p > 1) { - old_par <- graphics::par( - mar = c(4.1, 5.1, 4.1, if (flip) 5.1 else 2.1), - oma = c(0, 0, 5, 0), - mfcol = c(nrow, ncol) - ) - on.exit(graphics::par(old_par)) - } cex.lab <- list(...)$cex.lab %||% graphics::par("cex.lab") - if (p > 1) cex.lab <- cex.lab * ifelse(max(m, p) < 3, 0.83, 0.66) # See ?par col.lab <- list(...)$col.lab %||% graphics::par("col.lab") font.lab <- list(...)$font.lab %||% graphics::par("font.lab") cex.main <- list(...)$cex.main %||% graphics::par("cex.main") @@ -38,53 +26,44 @@ hist.CompositionMatrix <- function(x, ..., freq = FALSE, ## Compute univariate ilr transformation z <- univariate_ilr(x) - index <- seq_len(p) - for (j in index) { - xi <- x[, j, drop = TRUE] - zi <- z[, j, drop = TRUE] + ## Select one compositonal part + xi <- x[, select, drop = TRUE] + zi <- z[, select, drop = TRUE] - lab_i <- pretty(xi, n = 6) - lab_i <- lab_i[lab_i > 0] - at_i <- univariate_ilr(lab_i) + ## Compute axis in percent + lab_i <- pretty(xi, n = 6) + lab_i <- lab_i[lab_i > 0] + at_i <- univariate_ilr(lab_i) - ## Histogram - h <- graphics::hist(x = zi, ..., plot = FALSE) - xlim <- range(at_i, h$breaks, finite = TRUE) - plot(h, freq = freq, xlim = xlim, - main = NULL, sub = NULL, xlab = NULL, ylab = NULL, axes = FALSE) + ## Plot histogram + h <- graphics::hist(x = zi, breaks = breaks, plot = FALSE) + xlim <- range(at_i, h$breaks, finite = TRUE) + plot(h, freq = freq, xlim = xlim, labels = labels, ..., + main = main, sub = sub, xlab = NULL, ylab = NULL, axes = FALSE) - ## Construct axis - y_side <- if (j %% 2 || !flip) 2 else 4 - if (axes) { - graphics::axis(side = 1, xpd = NA, las = 1) - graphics::axis(side = 3, at = at_i, labels = label_percent(lab_i), - xpd = NA, las = 1) - graphics::axis(side = y_side, xpd = NA, las = 1) - } - - ## Plot frame - if (frame.plot) { - graphics::box() - } + ## Construct axis + if (axes) { + graphics::axis(side = 1, xpd = NA, las = 1) + graphics::axis(side = 3, at = at_i, labels = label_percent(lab_i), + xpd = NA, las = 1) + graphics::axis(side = 2, xpd = NA, las = 1) + } - ## Add annotation - if (ann) { - xlab <- colnames(x)[j] - ylab <- "Frequency" - graphics::mtext(sprintf("ilr(%s)", xlab), side = 1, line = 2.5, - cex = cex.lab, col = col.lab, font = font.lab) - graphics::mtext(sprintf("%s %%", xlab), side = 3, line = 2.5, - cex = cex.lab, col = col.lab, font = font.lab) - graphics::mtext(ylab, side = y_side, line = 3, - cex = cex.lab, col = col.lab, font = font.lab) - } + ## Plot frame + if (frame.plot) { + graphics::box() } ## Add annotation if (ann) { - graphics::par(mfcol = c(1, 1)) - graphics::mtext(main, side = 3, line = 3, - cex = cex.main, col = col.main, font = font.main) + xlab <- labels(x)[select] + ylab <- "Frequency" + graphics::mtext(sprintf("ilr(%s)", xlab), side = 1, line = 3, + cex = cex.lab, col = col.lab, font = font.lab) + graphics::mtext(sprintf("%s %%", xlab), side = 3, line = 3, + cex = cex.lab, col = col.lab, font = font.lab) + graphics::mtext(ylab, side = 2, line = 3, + cex = cex.lab, col = col.lab, font = font.lab) } invisible(x) diff --git a/inst/examples/ex-hist.R b/inst/examples/ex-hist.R index 57a06ed..36673c2 100644 --- a/inst/examples/ex-hist.R +++ b/inst/examples/ex-hist.R @@ -5,7 +5,5 @@ data("hongite") coda <- as_composition(hongite) ## Boxplot plot -hist(coda) -hist(coda[, 1, drop = FALSE]) - -univariate_ilr(coda) +hist(coda, select = "A") +hist(coda, select = "B") diff --git a/inst/tinytest/_tinysnapshot/plot_hist.svg b/inst/tinytest/_tinysnapshot/plot_hist.svg index d83d506..c8631a3 100644 --- a/inst/tinytest/_tinysnapshot/plot_hist.svg +++ b/inst/tinytest/_tinysnapshot/plot_hist.svg @@ -23,280 +23,66 @@ - - + + - - - - - - - - + + + + + + - - - - - --0.6 --0.4 --0.2 -0.0 - - - - - - - -30% -40% -50% - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 - -ilr(A) -A % -Frequency - - - - - - - - - - - - - - - - - - - - - --2.5 --1.5 --0.5 - - - - - - - - - - - - 5% -15% -35% - - - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 - -ilr(B) -B % -Frequency - - - - - - - - - - - - - - - - - - - - - - - --4 --3 --2 --1 -0 - - - - - - -10% -40% - - - - - - -0.0 -0.1 -0.2 -0.3 -0.4 - -ilr(C) -C % -Frequency - - - - - - - - - - - - - - - - - - - - - - - - - - --2.2 --1.8 --1.4 - - - - - - - - - 4% - 6% -10% -16% - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 - -ilr(D) -D % -Frequency - - - - - - - - - - - - - - - - - - - --2.5 --2.0 --1.5 - - - - - - - - - 2% - 4% - 8% -14% - - - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 -1.2 -1.4 - -ilr(E) -E % -Frequency + + + + + + + +-2.5 +-2.0 +-1.5 +-1.0 +-0.5 +0.0 + + + + + + + + + + + + 5% +10% +15% +25% +35% +45% + + + + + + + + +0.0 +0.1 +0.2 +0.3 +0.4 +0.5 +0.6 + +ilr(B) +B % +Frequency diff --git a/inst/tinytest/_tinysnapshot/plot_hist_count.svg b/inst/tinytest/_tinysnapshot/plot_hist_count.svg new file mode 100644 index 0000000..87aa658 --- /dev/null +++ b/inst/tinytest/_tinysnapshot/plot_hist_count.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +2 +1 +1 +4 +9 +6 +2 + + + + + + + +-0.6 +-0.4 +-0.2 +0.0 + + + + + + + +30% +35% +40% +45% +50% +55% + + + + + + +0 +2 +4 +6 +8 + +ilr(A) +A % +Frequency + + diff --git a/inst/tinytest/test_plot.R b/inst/tinytest/test_plot.R index b97554e..b90c7ad 100644 --- a/inst/tinytest/test_plot.R +++ b/inst/tinytest/test_plot.R @@ -17,9 +17,12 @@ if (at_home()) { expect_snapshot_plot(plot_pairs, "plot_pairs_group") # Histogram ================================================================== - plot_hist <- function() hist(coda, ncol = 3) + plot_hist <- function() hist(coda, select = "B") expect_snapshot_plot(plot_hist, "plot_hist") + plot_hist_count <- function() hist(coda, freq = TRUE, labels = TRUE) + expect_snapshot_plot(plot_hist_count, "plot_hist_count") + # Barplot ==================================================================== plot_barplot <- function() barplot(coda, by = NULL, order_columns = FALSE, border = "black") expect_snapshot_plot(plot_barplot, "plot_barplot") diff --git a/man/hist.Rd b/man/hist.Rd index e625fd4..892d22b 100644 --- a/man/hist.Rd +++ b/man/hist.Rd @@ -9,9 +9,10 @@ \S4method{hist}{CompositionMatrix}( x, ..., + select = 1, + breaks = "Sturges", freq = FALSE, - ncol = NULL, - flip = FALSE, + labels = FALSE, main = NULL, sub = NULL, ann = graphics::par("ann"), @@ -22,17 +23,20 @@ \arguments{ \item{x}{A \code{\linkS4class{CompositionMatrix}} object.} -\item{...}{Further parameters to be passed to \code{\link[graphics:hist]{graphics::hist()}}.} +\item{...}{Further graphical parameters.} + +\item{select}{A length-one \code{vector} of column indices.} + +\item{breaks}{An object specifying how to compute the breakpoints +(see \code{\link[graphics:hist]{graphics::hist()}}).} \item{freq}{A \code{\link{logical}} scalar: should absolute frequencies (counts) be displayed? If \code{FALSE} (the default), relative frequencies (probabilities) are displayed (see \code{\link[graphics:hist]{graphics::hist()}}).} -\item{ncol}{An \code{\link{integer}} specifying the number of columns to use. -Defaults to 1 for up to 4 parts, otherwise to 2.} - -\item{flip}{A \code{\link{logical}} scalar: should the y-axis (ticks and numbering) be -flipped from side 2 (left) to 4 (right) from variable to variable?} +\item{labels}{A \code{\link{logical}} scalar: should labels be drawn on top of bars? +If \code{TRUE}, draw the counts or rounded densities; if \code{labels} is a +\code{character} vector, draw itself.} \item{main}{A \code{\link{character}} string giving a main title for the plot.} @@ -61,10 +65,8 @@ data("hongite") coda <- as_composition(hongite) ## Boxplot plot -hist(coda) -hist(coda[, 1, drop = FALSE]) - -univariate_ilr(coda) +hist(coda, select = "A") +hist(coda, select = "B") } \references{ Filzmoser, P., Hron, K. & Reimann, C. (2009). Univariate Statistical