fix numeric xlevels specification in type_barplot

NEWS.md

@@ -10,13 +10,17 @@ where the formatting is also better._
 
 - `type_text()` gains `xpd` and `srt` arguments for controlling text clipping
   rotation, respectively. (#428 @grantmcdermott)
+- Add `xlevels` (in addition to `ylevels`) in `type_spineplot()` for spine plots
+  with categorical `x` variable. (#431 @zeileis)
 
 ### Bug fixes
 
 - Safer handling of pre-plot hooks. Resolves an issue affecting how `tinyplot`
   behaves inside loops, particularly for themed plots where only the final plot
   was being drawn in Quarto/RMarkdown contexts. Special thanks to @hadley and @cderv
-  for helping us to debug. (@vincentarelbundock #425)
+  for helping us to debug. (#425 @vincentarelbundock)
+- The `xlevels` argument of `type_barplot()` could not handle numeric indexes correctly.
+  (#431 @zeileis)
 
 ## 0.4.1
 

R/type_barplot.R

@@ -19,8 +19,9 @@
 #'   or the mid-way in the third category, respectively.
 #' @param FUN a function to compute the summary statistic for `y` within each
 #'   group of `x` in case of using a two-sided formula `y ~ x` (default: mean).
-#' @param xlevels a character or numeric vector specifying in which order the
-#'   levels of the `x` variable should be plotted.
+#' @param xlevels a character or numeric vector specifying the ordering of the
+#'   levels of the `x` variable (if character) or the corresponding indexes
+#'   (if numeric) for the plot.
 #' @param xaxlabels a character vector with the axis labels for the `x` variable,
 #'   defaulting to the levels of `x`.
 #' @param drop.zeros logical. Should bars with zero height be dropped? If set
@@ -34,6 +35,10 @@
 #' tinyplot(~ cyl | vs, data = mtcars, type = "barplot", beside = TRUE)
 #' tinyplot(~ cyl | vs, data = mtcars, type = "barplot", beside = TRUE, fill = 0.2)
 #' 
+#' # Reorder x variable categories either by their character levels or numeric indexes
+#' tinyplot(~ cyl, data = mtcars, type = "barplot", xlevels = c("8", "6", "4"))
+#' tinyplot(~ cyl, data = mtcars, type = "barplot", xlevels = 3:1)
+#' 
 #' # Note: Above we used automatic argument passing for `beside`. But this
 #' # wouldn't work for `width`, since it would conflict with the top-level
 #' # `tinyplot(..., width = <width>)` argument. It's safer to pass these args
@@ -88,7 +93,11 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL,
           if (is.null(FUN)) FUN = function(x, ...) mean(x, ..., na.rm = TRUE)
         }
         if (!is.factor(datapoints$x)) datapoints$x = factor(datapoints$x)
-        if (!is.null(xlevels)) datapoints$x = factor(datapoints$x, levels = if(is.numeric(xlevels)) levels(x)[xlevels] else xlevels)
+        if (!is.null(xlevels)) {
+          xlevels = if(is.numeric(xlevels)) levels(datapoints$x)[xlevels] else xlevels
+          if (any(is.na(xlevels)) || !all(xlevels %in% levels(datapoints$x))) warning("not all 'xlevels' correspond to levels of 'x'")
+          datapoints$x = factor(datapoints$x, levels = xlevels)
+        }
         if (!is.null(xaxlabels)) levels(datapoints$x) <- xaxlabels
         datapoints = aggregate(datapoints[, "y", drop = FALSE], datapoints[, c("x", "by", "facet")], FUN = FUN, drop = FALSE)
         datapoints$y[is.na(datapoints$y)] = 0 #FIXME: always?#

R/type_spineplot.R

@@ -4,6 +4,9 @@
 #'   are modified versions of histograms or mosaic plots, and particularly
 #'   useful for visualizing factor variables. Note that [`tinyplot`] defaults
 #'   to `type_spineplot()` if `y` is a factor variable.
+#' @param xlevels,ylevels a character or numeric vector specifying the ordering of the
+#'   levels of the `x` and `y` variables (if character) or the corresponding indexes
+#'   (if numeric) for the plot.
 #' @inheritParams graphics::spineplot
 #' @examples
 #' # "spineplot" type convenience string
@@ -47,7 +50,13 @@
 #'   type = type_spineplot(weights = ttnc$Freq),
 #'   palette = "Dark 2", facet.args = list(nrow = 1), axes = "t"
 #' )
-#' 
+#'
+#' # Reorder x and y variable categories either by their character levels or numeric indexes
+#' tinyplot(
+#'   Survived ~ Sex, facet = ~ Class, data = ttnc,
+#'   type = type_spineplot(weights = ttnc$Freq, xlevels = c("Female", "Male"), ylevels = 2:1)
+#' )
+#'
 #' # Note: It's possible to use "by" on its own (without faceting), but the
 #' # overlaid result isn't great. We will likely overhaul this behaviour in a
 #' # future version of tinyplot...
@@ -56,10 +65,10 @@
 #' )
 #' 
 #' @export
-type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, ylevels = NULL, col = NULL, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) {
+type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, xlevels = NULL, ylevels = NULL, col = NULL, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) {
   col = col
   out = list(
-    data = data_spineplot(off = off, breaks = breaks, ylevels = ylevels, xaxlabels = xaxlabels, yaxlabels = yaxlabels, weights = weights),
+    data = data_spineplot(off = off, breaks = breaks, xlevels = xlevels, ylevels = ylevels, xaxlabels = xaxlabels, yaxlabels = yaxlabels, weights = weights),
     draw = draw_spineplot(tol.ylab = tol.ylab, off = off, col = col, xaxlabels = xaxlabels, yaxlabels = yaxlabels),
     name = "spineplot"
   )
@@ -68,7 +77,7 @@ type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, ylevels =
 }
 
 #' @importFrom grDevices nclass.Sturges
-data_spineplot = function(off = NULL, breaks = NULL, ylevels = ylevels, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) {
+data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels = ylevels, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) {
     fun = function(
       datapoints,
       by = NULL, col = NULL, bg = NULL, palette = NULL,
@@ -114,7 +123,6 @@ data_spineplot = function(off = NULL, breaks = NULL, ylevels = ylevels, xaxlabel
 
         ## process y variable
         if (!is.factor(datapoints$y)) datapoints$y = factor(datapoints$y)
-        # if (!is.null(ylevels)) datapoints$y = factor(datapoints$y, levels = if(is.numeric(ylevels)) levels(datapoints$y)[ylevels] else ylevels)
         if (is.null(ylim)) ylim = c(0, 1)
 
         ## adjust facet margins
@@ -125,12 +133,20 @@ data_spineplot = function(off = NULL, breaks = NULL, ylevels = ylevels, xaxlabel
         x_by = identical(datapoints$x, datapoints$by)
         y_by = identical(datapoints$y, datapoints$by)
 
+        x.categorical = is.factor(datapoints$x)
+        if (!is.null(xlevels) && x.categorical) {
+          xlevels = if(is.numeric(xlevels)) levels(datapoints$x)[xlevels] else xlevels
+          if (any(is.na(xlevels)) || !all(xlevels %in% levels(datapoints$x))) warning("not all 'xlevels' correspond to levels of 'x'")
+          datapoints$x = factor(datapoints$x, levels = xlevels)
+          if (x_by) datapoints$by = datapoints$x
+        }
         if (!is.null(ylevels)) {
-          datapoints$y = factor(datapoints$y, levels = if(is.numeric(ylevels)) levels(datapoints$y)[ylevels] else ylevels)
+          ylevels = if(is.numeric(ylevels)) levels(datapoints$y)[ylevels] else ylevels
+          if (any(is.na(ylevels)) || !all(ylevels %in% levels(datapoints$y))) warning("not all 'ylevels' correspond to levels of 'y'")
+          datapoints$y = factor(datapoints$y, levels = ylevels)
           if (y_by) datapoints$by = datapoints$y
         }
 
-        x.categorical = is.factor(datapoints$x)
         x = datapoints$x
         y = datapoints$y
 

inst/tinytest/test-type_barplot.R

@@ -39,4 +39,9 @@ f = function() {
   tinyplot(Freq ~ Sex | Survived, facet = ~ Class, data = as.data.frame(Titanic),
            type = "barplot", flip = TRUE, fill = 0.6, beside = TRUE)
 }
-expect_snapshot_plot(f, label = "barplot_flip_fancy")
+expect_snapshot_plot(f, label = "barplot_flip_fancy")
+
+f = function() {
+  tinyplot(~ cyl, data = mtcars, type = "barplot", xlevels = 3:1)
+}
+expect_snapshot_plot(f, label = "barplot_xlevels_issue430")