Merge pull request #86 from eclarke/fix_83

Fixes for #77, #78, #82, #83, #84, and #85
eclarke · Apr 29, 2023 · 3cf58a9 · 3cf58a9
2 parents fa3ed5a + 61cad52
commit 3cf58a9
Show file tree

Hide file tree

Showing 7 changed files with 119 additions and 45 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -9,3 +9,6 @@ cran-comments.md
 ^revdep.*$
 ^LICENSE\.md$
 ^CRAN-SUBMISSION$
+^\.github$
+^\.devcontainer
+^repro.*\.R$
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: ggbeeswarm
 Type: Package
 Title: Categorical Scatter (Violin Point) Plots
-Version: 0.7.1.9000
-Date: 2022-12-05
+Version: 0.7.2
+Date: 2023-04-28
 Authors@R: c(
     person(given="Erik", family="Clarke", role=c("aut", "cre"), email="erikclarke@gmail.com"),
     person(given="Scott", family="Sherrill-Mix", role=c("aut"), email="sherrillmix@gmail.com"),
@@ -20,7 +20,8 @@ Depends:
 Imports:
     beeswarm,
     lifecycle,
-    vipor
+    vipor,
+    cli
 Suggests:
     gridExtra
 RoxygenNote: 7.2.2

diff --git a/R/geom-quasirandom.R b/R/geom-quasirandom.R
@@ -37,19 +37,11 @@ geom_quasirandom <- function(
   nbins = NULL,
   dodge.width = NULL,
   groupOnX = NULL,
+  orientation = NULL,
   na.rm = FALSE,
   show.legend = NA,
   inherit.aes = TRUE
 ) {
-  if (!missing(groupOnX)) {
-    lifecycle::deprecate_soft(
-      when = "0.7.1", what = "geom_quasirandom(groupOnX)", 
-      details='ggplot2 now handles this case automatically.'
-    )
-  }
-  if (!method %in% c("quasirandom", "pseudorandom", "smiley", "maxout", "frowney", "minout", "tukey", "tukeyDense")) {
-    stop(sprintf("The method must be one of: quasirandom, pseudorandom, smiley, maxout, frowney, minout, tukey, or tukeyDense."))
-  }
 
   position <- position_quasirandom(
     method = method,
@@ -58,6 +50,7 @@ geom_quasirandom <- function(
     bandwidth = bandwidth,
     nbins = nbins,
     dodge.width = dodge.width,
+    orientation = orientation,
     na.rm = na.rm
   )
 

diff --git a/R/position-beeswarm.R b/R/position-beeswarm.R
@@ -91,7 +91,6 @@ offset_beeswarm <- function(
     )$x
   } else {
     ## NON-SWARM METHODS
-
     # Determine point size as per `ggbeeswarm` CRAN version 0.6.0
 
     # divisor is a magic number to get a reasonable baseline
@@ -101,20 +100,32 @@ offset_beeswarm <- function(
 
     # Hex method specific step
     if (method == "hex") y.size <- y.size * sqrt(3) / 2
-    
+
     # Determine positions along the y axis
     breaks <- seq(yLim.expand[1], yLim.expand[2] + y.size, by = y.size)
 
     mids <- (utils::head(breaks, -1) + utils::tail(breaks, -1)) / 2
-    y.index <- sapply(data$y, cut, breaks = breaks, labels = FALSE)
+
+    # include.lowest = T to account for cases where all y values are the same,
+    # which otherwise would result in NAs. Fixes issue #85.
+    y.index <- sapply(data$y, cut, breaks = breaks, include.lowest=T, labels = FALSE)
+    y.pos <- sapply(y.index, function(a) mids[a])          
 
-    y.pos <- sapply(y.index, function(a) mids[a])
+
+
+    if (any(data$y != y.pos)) {
+      cli::cli_warn(c(
+        "In `position_beeswarm`, method `{method}` discretizes the data axis (a.k.a the continuous or non-grouped axis).",
+        "This may result in changes to the position of the points along that axis, proportional to the value of `cex`."
+      ), .frequency = "once", .frequency_id = "beeswarm_method_data_axis_warn")
+    }
     data$y <- y.pos
 
     # Determine positions along the x axis
     x.index <- determine_pos(y.index, method, side)
 
     x.offset <- x.index * x.size
+
   }
 
   ## CORRAL RUNAWAY POINTS

diff --git a/R/position-quasirandom.R b/R/position-quasirandom.R
@@ -11,10 +11,13 @@
 #' @param nbins the number of bins used when calculating density
 #' (has little effect with quasirandom/random distribution)
 #' @param dodge.width Amount by which points from different aesthetic groups 
-#' will be dodged. This requires that one of the aesthetics is a factor.
+#' will be dodged. This requires that one of the aesthetics is a factor. 
+#' To disable dodging between groups, set this to NULL.
 #' @param na.rm if FALSE, the default, missing values are removed with a warning.
 #' If TRUE, missing values are silently removed.
-#' @param groupOnX `r lifecycle::badge("deprecated")` No longer needed.
+#' @param orientation The orientation (i.e., which axis to group on) is inferred from the data.
+#' This can be overridden by setting `orientation` to either `"x"` or `"y"`.
+#' @param groupOnX `r lifecycle::badge("superseded")` See `orientation`.
 #' @importFrom vipor offsetSingleGroup
 #' @export
 #' @seealso [vipor::offsetSingleGroup()], [geom_quasirandom()]
@@ -24,7 +27,8 @@ position_quasirandom <- function(
   varwidth = FALSE, 
   bandwidth = .5,
   nbins = NULL,
-  dodge.width = NULL,
+  dodge.width = 0,
+  orientation = NULL,
   groupOnX = NULL,
   na.rm = FALSE
 ) {
@@ -33,49 +37,101 @@ position_quasirandom <- function(
   if (!missing(groupOnX)) {
     lifecycle::deprecate_soft(
       when = "0.7.1", what = "position_quasirandom(groupOnX)", 
-      details='ggplot2 now handles this case automatically.'
+      details='The axis to group on is now guessed from the data. To override, specify orientation="x" or "y".'
     )
+    if (groupOnX) {
+      orientation = "x"
+    } else {
+      orientation = "y"
+    }
+  }
+
+  if (!method %in% c("quasirandom", "pseudorandom", "smiley", "maxout", "frowney", "minout", "tukey", "tukeyDense")) {
+    cli::cli_abort("{.fn method} must be one of: quasirandom, pseudorandom, smiley, maxout, frowney, minout, tukey, or tukeyDense.")
+  }
+
+  if (!is.null(orientation) && !(orientation %in% c("x", "y"))) {
+    cli::cli_abort("{.fn orientation} must be 'x', 'y', or NULL.")
   }
 
+
   ggproto(NULL, PositionQuasirandom, 
           width = width, 
           varwidth = varwidth, 
           bandwidth = bandwidth,
           nbins = nbins,
           method = method,
           dodge.width = dodge.width,
-          na.rm = na.rm
+          na.rm = na.rm,
+          orientation = orientation
   )
 }
 
 PositionQuasirandom <- ggplot2::ggproto("PositionQuasirandom", Position,
                                         required_aes = c('x', 'y'),
                                         setup_params = function(self, data) {
-                                          flipped_aes = has_flipped_aes(data)
-                                          data <- flip_data(data, flipped_aes)
-
-                                          # get the number of points in each x axis group
-                                          # and find the largest group
-                                          max.length <- max(data.frame(table(data$x))$Freq)
 
-                                          list(
+                                          params <- list(
                                             width = self$width,
                                             varwidth = self$varwidth,
                                             bandwidth = self$bandwidth,
                                             nbins = self$nbins,
                                             method = self$method,
-                                            # groupOnX = self$groupOnX, deprecated
                                             dodge.width = self$dodge.width,
                                             na.rm = self$na.rm,
-                                            max.length = max.length,
-                                            flipped_aes = flipped_aes
+                                            orientation = self$orientation
                                           )
+
+                                          if (!is.null(params$orientation)) {
+                                            flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE)                                                                                      
+                                          } else {
+                                            flipped_aes <- has_flipped_aes(data, group_has_equal = TRUE)
+                                            if (flipped_aes) {
+                                              cli::cli_inform("Orientation inferred to be along y-axis; override with `position_quasirandom(orientation = 'x')`")
+                                            }
+                                          }
+
+                                          params$flipped_aes <- flipped_aes
+                                          data <- flip_data(data, params$flipped_aes)
+
+                                          # get the number of points in each x axis group
+                                          # and find the largest group
+                                          params$max_length <- max(data.frame(table(data$x))$Freq)
+
+                                          # check that the number of groups < number of data points
+                                          if (!anyDuplicated(data$group)) {
+                                            if (!is.null(params$dodge.width)) {
+                                              # Warn if dodge.width was set to something besides default
+                                              if (params$dodge.width != 0) {
+                                                cli::cli_inform(
+                                                  "Each group consists of only one observation; resetting dodge.width to NULL.",
+                                                  "Disable this message by explicitly setting `dodge.width=NULL`, or by adjusting the group aesthetic."
+                                                )
+                                              }
+                                              params$dodge.width = NULL
+                                            }
+
+
+                                          }
+
+                                          params
+                                        },
+
+                                        setup_data = function(self, data, params) {
+
+                                          data <- flip_data(data, params$flipped_aes)
+                                          data <- remove_missing(
+                                            data,
+                                            na.rm = params$na.rm,
+                                            vars = "y",
+                                            name = "position_quasirandom"
+                                          )
+                                          flip_data(data, params$flipped_aes)
                                         },
 
                                         compute_panel = function(data, params, scales) {
-                                          data <- ggplot2::remove_missing(data, na.rm = as.logical(params$na.rm))
                                           data <- flip_data(data, params$flipped_aes)
-                                          
+
                                           # perform dodging if necessary
                                           data <- ggplot2:::collide(
                                             data,
@@ -91,7 +147,7 @@ PositionQuasirandom <- ggplot2::ggproto("PositionQuasirandom", Position,
                                             params$width <- ggplot2::resolution(
                                               data$x, zero = FALSE) * 0.4
                                           }
-                                          
+
                                           # split data.frame into list of data.frames
                                           if (!is.null(params$dodge.width)) {
                                             data <- split(data, data$group)
@@ -123,14 +179,14 @@ offset_quasirandom <- function(
   width = 0.4, 
   vary.width = FALSE,
   max.length = NULL,
-  na.rm = FALSE,
+  # na.rm = FALSE,
   ...
 ) {
-  if (any(is.na(data$y))) {
-    if (na.rm) {
-
-    }
-  }
+  # if (any(is.na(data$y))) {
+  #   if (na.rm) {
+  #     
+  #   }
+  # }
   x.offset <- vipor::aveWithArgs(
     data$y, data$x,
     FUN = vipor::offsetSingleGroup,

diff --git a/man/geom_quasirandom.Rd b/man/geom_quasirandom.Rd
diff --git a/man/position_quasirandom.Rd b/man/position_quasirandom.Rd