hist() now produces a single histogram

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

R/AllGenerics.R

@@ -1073,21 +1073,23 @@ 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
 #'  and y axis labels) appear on the plot?
 #' @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`).

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)

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")