Add coord_geo_radial (Fixes #56)

willgearty · Mar 5, 2024 · 5be9fc1 · 5be9fc1
1 parent 277f799
commit 5be9fc1
Show file tree

Hide file tree

Showing 13 changed files with 1,882 additions and 43 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -7,12 +7,14 @@ S3method(print,geo_scale)
 S3method(print,ggarrange2)
 export(CoordGeo)
 export(CoordGeoPolar)
+export(CoordGeoRadial)
 export(CoordTransFlip)
 export(CoordTransXY)
 export(FacetGridColor)
 export(FacetWrapColor)
 export(coord_geo)
 export(coord_geo_polar)
+export(coord_geo_radial)
 export(coord_trans_flip)
 export(coord_trans_xy)
 export(disparity_through_time)
@@ -42,6 +44,7 @@ importFrom(ggnewscale,new_scale_fill)
 importFrom(ggplot2,CoordCartesian)
 importFrom(ggplot2,CoordFlip)
 importFrom(ggplot2,CoordPolar)
+importFrom(ggplot2,CoordRadial)
 importFrom(ggplot2,CoordTrans)
 importFrom(ggplot2,FacetGrid)
 importFrom(ggplot2,FacetWrap)

diff --git a/NEWS.md b/NEWS.md
@@ -1,12 +1,13 @@
 # deeptime (development version)
 deeptime now requires ggplot2 version 3.4.0 or higher. This version introduces several new features and bug fixes:
 
-* Fixed the interaction between coord_geo() and ggsave() (#49)
 * Added geom_points_range(), a function designed for visualizing temporal occurrence data
-* Fixed `size = "auto"` when `center_end_labels = TRUE` in coord_geo()
+* Added facet_grid_color() and facet_wrap_color() for changing strip background colors (#50)
+* Added coord_geo_radial(), an enhanced version of coord_geo_polar() (only works with ggplot2 version 3.5.0 and higher) (#56)
 * Added `family` and `fontface` arguments to coord_geo()
 * Added the ability to include interval labels with coord_geo_polar() (#48)
-* Added facet_grid_color() and facet_wrap_color() for changing strip background colors (#50)
+* Fixed the interaction between coord_geo() and ggsave() (#49)
+* Fixed `size = "auto"` when `center_end_labels = TRUE` in coord_geo()
 * Updated several functions to work with ggplot2 version 3.5.0
 
 Notable changes:

diff --git a/R/coord_geo.R b/R/coord_geo.R
@@ -134,6 +134,8 @@ coord_geo <- function(pos = "bottom", dat = "periods", xlim = NULL, ylim = NULL,
   if (is.character(xtrans)) xtrans <- as.trans(xtrans)
   if (is.character(ytrans)) ytrans <- as.trans(ytrans)
 
+  # TODO: check arguments
+
   pos <- as.list(pos)
   n_scales <- length(pos)
 

diff --git a/R/coord_geo_polar.R b/R/coord_geo_polar.R
@@ -1,10 +1,13 @@
 #' Polar coordinate system with geological timescale
+#' @description
+#' `r lifecycle::badge('deprecated')`
 #'
 #' `coord_geo_polar` behaves similarly to [ggplot2::coord_polar()] in that it
 #' occurs after statistical transformation and will affect the visual appearance
 #' of geoms. The main difference is that it also adds a geological timescale to
 #' the background of the plot.
 #'
+#' @details
 #' If a custom data.frame is provided (with `dat`), it should consist of at
 #' least 2 columns of data. See `data(periods)` for an example.
 #' \itemize{
@@ -52,6 +55,12 @@
 #' arguments. Also note that the curvature of the labels may vary based on the
 #' distance from the origin. This is why `abbrv` is set to `TRUE` by default.
 #'
+#' @section Life cycle: This function is soft-deprecated in favor of
+#'   [coord_geo_radial()] as of **deeptime** version 1.1.0. There is currently
+#'   no plan to remove this function, but users are strongly encouraged to
+#'   migrate to the new function for enhanced polar functionality. Note that
+#'   [coord_geo_radial()] requires ggplot2 version 3.5.0 or later.
+#'
 #' @param dat Either A) a string indicating a built-in dataframe with interval
 #'   data from the ICS ("periods", "epochs", "stages", "eons", or "eras"), B) a
 #'   string indicating a timescale from macrostrat (see list here:
@@ -119,12 +128,15 @@ coord_geo_polar <- function(dat = "periods", theta = "y",
                             skip = c("Quaternary", "Holocene",
                                      "Late Pleistocene"),
                             neg = TRUE, prop = 1, textpath_args = list()) {
+  lifecycle::deprecate_soft("1.1.0", "coord_geo_polar()", "coord_geo_radial()")
   dat <- make_list(dat)
   n_scales <- length(dat)
 
   theta <- arg_match0(theta, c("x", "y"))
   r <- if (theta == "x") "y" else "x"
 
+  # TODO: check arguments
+
   ggproto(NULL, CoordGeoPolar,
     theta = theta, r = r,
     start = start, direction = sign(direction), clip = clip,
@@ -169,6 +181,46 @@ ggname <- function(prefix, grob) {
   grob
 }
 
+clean_dat <- function(dat, fill, neg, r_lims) {
+  if (is(dat, "data.frame")) {
+    # just use the supplied data
+  } else {
+    dat <- get_scale_data(dat)
+  }
+
+  if (neg) {
+    dat$max_age <- -1 * (dat$max_age)
+    dat$min_age <- -1 * (dat$min_age)
+  }
+
+  if (!is.null(fill)) {
+    dat$color <- rep(fill, length.out = nrow(dat))
+  } else if (!("color" %in% colnames(dat))) {
+    dat$color <- rep(c("grey60", "grey80"), length.out = nrow(dat))
+  }
+
+  if (neg) {
+    dat$max_age[
+      (dat$max_age < min(r_lims) & dat$min_age < min(r_lims)) |
+        (dat$max_age < min(r_lims) & dat$min_age > min(r_lims))
+    ] <- min(r_lims)
+    dat$min_age[
+      (dat$max_age > max(r_lims) & dat$min_age < max(r_lims)) |
+        (dat$max_age < max(r_lims) & dat$min_age > max(r_lims))
+    ] <- max(r_lims)
+  } else {
+    dat$max_age[
+      (dat$max_age > max(r_lims) & dat$min_age < max(r_lims)) |
+        (dat$max_age < max(r_lims) & dat$min_age > max(r_lims))
+    ] <- max(r_lims)
+    dat$min_age[
+      (dat$max_age > min(r_lims) & dat$min_age < min(r_lims)) |
+        (dat$max_age < min(r_lims) & dat$min_age > min(r_lims))
+    ] <- min(r_lims)
+  }
+  subset(dat, max_age <= max(r_lims) & min_age >= min(r_lims))
+}
+
 #' @rdname coord_geo_polar
 #' @format NULL
 #' @usage NULL
@@ -187,50 +239,11 @@ CoordGeoPolar <- ggproto("CoordGeoPolar", CoordPolar,
     r_lims <- panel_params$r.range
 
     # convert, subset, and adjust data
-    clean_dat <- function(dat, fill, neg) {
-      if (is(dat, "data.frame")) {
-        # just use the supplied data
-      } else {
-        dat <- get_scale_data(dat)
-      }
-
-      if (neg) {
-        dat$max_age <- -1 * (dat$max_age)
-        dat$min_age <- -1 * (dat$min_age)
-      }
-
-      if (!is.null(fill)) {
-        dat$color <- rep(fill, length.out = nrow(dat))
-      } else if (!("color" %in% colnames(dat))) {
-        dat$color <- rep(c("grey60", "grey80"), length.out = nrow(dat))
-      }
-
-      if (neg) {
-        dat$max_age[
-          (dat$max_age < min(r_lims) & dat$min_age < min(r_lims)) |
-            (dat$max_age < min(r_lims) & dat$min_age > min(r_lims))
-        ] <- min(r_lims)
-        dat$min_age[
-          (dat$max_age > max(r_lims) & dat$min_age < max(r_lims)) |
-            (dat$max_age < max(r_lims) & dat$min_age > max(r_lims))
-        ] <- max(r_lims)
-      } else {
-        dat$max_age[
-          (dat$max_age > max(r_lims) & dat$min_age < max(r_lims)) |
-            (dat$max_age < max(r_lims) & dat$min_age > max(r_lims))
-        ] <- max(r_lims)
-        dat$min_age[
-          (dat$max_age > min(r_lims) & dat$min_age < min(r_lims)) |
-            (dat$max_age < min(r_lims) & dat$min_age > min(r_lims))
-        ] <- min(r_lims)
-      }
-      subset(dat, max_age <= max(r_lims) & min_age >= min(r_lims))
-    }
-
     dat_list <- mapply(clean_dat,
       dat = self$dat,
       fill = self$fill,
       neg = self$neg,
+      MoreArgs = list(r_lims = r_lims),
       SIMPLIFY = FALSE
     )