Remove a few plyr calls + other cleanups

DESCRIPTION

@@ -42,7 +42,7 @@ Imports:
     progress,
     RColorBrewer,
     rlang,
-    scales (>= 1.1.0),
+    scales (>= 1.3.0),
     utils,
     magrittr
 Suggests:
@@ -63,15 +63,14 @@ Suggests:
     sna (>= 2.3-2),
     survival,
     rmarkdown,
-    roxygen2,
     testthat,
     crosstalk,
     knitr,
     spelling,
     emmeans,
     vdiffr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 SystemRequirements: openssl
 Encoding: UTF-8
 Language: en-US

NAMESPACE

@@ -172,6 +172,7 @@ importFrom(magrittr,"%>%")
 importFrom(plyr,ddply)
 importFrom(plyr,summarize)
 importFrom(rlang,"%||%")
+importFrom(rlang,.data)
 importFrom(stats,anova)
 importFrom(stats,complete.cases)
 importFrom(stats,cor)

R/gg-plots.R

@@ -225,7 +225,7 @@ ggally_density <- function(data, mapping, ...) {
   p <- ggplot(data = data) +
     geom_point(
       data = data.frame(rangeX = rangeX, rangeY = rangeY),
-      mapping = aes(x = !!as.name("rangeX"), y = !!as.name("rangeY")),
+      mapping = aes(x = .data$rangeX, y = .data$rangeY),
       alpha = 0
     )
 
@@ -532,10 +532,10 @@ ggally_statistic <- function(
       list(
         data = cordf,
         aes(
-          x = !!as.name("xPos"),
-          y = !!as.name("yPos"),
-          label = !!as.name("labelp"),
-          color = !!as.name("labelp")
+          x     = .data$xPos,
+          y     = .data$yPos,
+          label = .data$labelp,
+          color = .data$labelp
         )
       ),
       group_args
@@ -1033,10 +1033,10 @@ ggally_text <- function(
     theme(
       panel.grid.minor = element_blank(),
       panel.grid.major = element_line(
-        colour = ifnull(theme$panel.background$fill, NA)
+        colour = theme$panel.background$fill %||% NA
       ),
       panel.background = element_rect(
-        fill = ifnull(theme$panel.grid.major$colour, NA)
+        fill = theme$panel.grid.major$colour %||% NA
       )
     ) +
     labs(x = NULL, y = NULL)
@@ -1060,8 +1060,8 @@ ggally_text <- function(
     p <- p +
       geom_text(label = label, mapping = mapping, ...)
   } else {
-    bg <- ifnull(theme$panel.background$fill, "grey92")
-    fg <- ifnull(theme$axis.text$colour, "gray30")
+    bg <- theme$panel.background$fill %||% "grey92"
+    fg <- theme$axis.text$colour %||% "gray30"
     colour <- scales::colour_ramp(c(bg, fg))(0.75)
     p <- p +
       geom_text(label = label, mapping = mapping, colour = colour, ...)
@@ -1207,11 +1207,11 @@ ggally_diagAxis <- function(
     p <- p + geom_text(
       data = axisBreaks,
       mapping = aes(
-        x     = !!as.name("xPos"),
-        y     = !!as.name("yPos"),
-        label = !!as.name("lab"),
-        hjust = !!as.name("hjust"),
-        vjust = !!as.name("vjust")
+        x     = .data$xPos,
+        y     = .data$yPos,
+        label = .data$lab,
+        hjust = .data$hjust,
+        vjust = .data$"vjust"
       ),
       col = "grey50",
       size = gridLabelSize
@@ -1244,9 +1244,9 @@ ggally_diagAxis <- function(
     p <- p + geom_text(
       data = axisLabs,
       mapping = aes(
-        x     = !!as.name("x"),
-        y     = !!as.name("y"),
-        label = !!as.name("lab")
+        x     = .data$x,
+        y     = .data$y,
+        label = .data$lab
       ),
       col = "grey50",
       size = gridLabelSize
@@ -1329,19 +1329,14 @@ ggally_ratio <- function(
   xName <- mapping_string(mapping$x)
   yName <- mapping_string(mapping$y)
 
-  countData <- plyr::count(data, vars = c(xName, yName))
-
-  # overwrite names so name clashes don't happen
-  colnames(countData)[1:2] <- c("x", "y")
+  countData <- dplyr::count(data, x = .data$xName, y = .data$yName, name = "freq")
 
   xNames <- levels(countData[["x"]])
   yNames <- levels(countData[["y"]])
 
   countData <- subset(countData, freq >= floor)
 
-  if (is.null(ceiling)) {
-    ceiling <- max(countData$freq)
-  }
+  ceiling <- ceiling %||% max(countData$freq)
 
   countData[["freqSize"]] <- sqrt(pmin(countData[["freq"]], ceiling) / ceiling)
   countData[["col"]] <- ifelse(countData[["freq"]] > ceiling, "grey30", "grey50")
@@ -1353,11 +1348,11 @@ ggally_ratio <- function(
     ggplot(
       data = countData,
       mapping = aes(
-        x = !!as.name("xPos"),
-        y = !!as.name("yPos"),
-        height = !!as.name("freqSize"),
-        width = !!as.name("freqSize"),
-        fill = !!as.name("col")
+        x = .data$xPos,
+        y = .data$yPos,
+        height = .data$freqSize,
+        width = .data$freqSize,
+        fill = .data$col
       )
     ) +
     geom_tile(...) +
@@ -1696,7 +1691,7 @@ ggally_naDiag <- function(...) {
 #'   diag = list(discrete = "autopointDiag", continuous = "autopointDiag")
 #' ))
 ggally_autopoint <- function(data, mapping, ...) {
-  require_namespaces("ggforce")
+  rlang::check_installed("ggforce")
 
   args <- list(...)
   if (!"alpha" %in% names(args) && is.null(mapping$alpha)) {
@@ -1786,7 +1781,7 @@ ggally_summarise_by <- function(
     }
 
     ggplot(res) +
-      aes(y = !!as.name("y"), x = 1, label = !!as.name("label"), colour = !!col) +
+      aes(y = .data$y, x = 1, label = .data$label, colour = !!col) +
       geom_text(...) +
       xlab("") +
       ylab(mapping_string(mapping$y)) +
@@ -1829,7 +1824,7 @@ ggally_summarise_by <- function(
 #' \code{weighted_median_iqr} computes weighted median and interquartile range.
 #' @export
 weighted_median_iqr <- function(x, weights = NULL) {
-  require_namespaces("Hmisc")
+  rlang::check_installed("Hmisc")
   s <- round(Hmisc::wtd.quantile(x, weights = weights, probs = c(.25, .5, .75), na.rm = TRUE), digits = 1)
   paste0("Median: ", s[2], " [", s[1], "-", s[3], "]")
 }
@@ -1839,7 +1834,7 @@ weighted_median_iqr <- function(x, weights = NULL) {
 #' \code{weighted_mean_sd} computes weighted mean and standard deviation.
 #' @export
 weighted_mean_sd <- function(x, weights = NULL) {
-  require_namespaces("Hmisc")
+  rlang::check_installed("Hmisc")
   m <- round(Hmisc::wtd.mean(x, weights = weights, na.rm = TRUE), digits = 1)
   sd <- round(sqrt(Hmisc::wtd.var(x, weights = weights, na.rm = TRUE)), digits = 1)
   paste0("Mean: ", m, " (", sd, ")")

R/ggally_colbar.R

@@ -92,7 +92,7 @@ ggally_colbar <- function(
       ...
     ) +
     scale_y_continuous(
-      labels = scales::percent,
+      labels = scales::label_percent(),
       expand = expansion(ifelse(remove_background, 0, .05), 0)
     ) +
     scale_x_discrete(expand = expansion(0, ifelse(remove_background, 0, .6))) +

R/ggaly_trends.R

@@ -75,7 +75,7 @@ ggally_trends <- function(
       mapping$y <- aes(y = !!as.name(".ggally_y"))$y
       p <- ggplot(data, mapping) +
         stat_weighted_mean(geom = "line", ...) +
-        scale_y_continuous(labels = scales::percent) +
+        scale_y_continuous(labels = scales::label_percent()) +
         ylab("")
     } else { # 3 or more categories
       yname <- mapping_string(mapping$y)
@@ -87,7 +87,7 @@ ggally_trends <- function(
         tmp <- data
         tmp[[".ggally_y"]] <- as.integer(y == l)
         tmp$y <- l
-        d <- plyr::rbind.fill(d, tmp)
+        d <- dplyr::bind_rows(d, tmp)
       }
       mapping$linetype <- aes(y = !!as.name("y"))$y
       mapping$y <- aes(y = !!as.name(".ggally_y"))$y
@@ -103,7 +103,7 @@ ggally_trends <- function(
 
       p <- ggplot(d, mapping) +
         stat_weighted_mean(geom = "line", ...) +
-        scale_y_continuous(labels = scales::percent) +
+        scale_y_continuous(labels = scales::label_percent()) +
         ylab("") +
         labs(linetype = yname)
     }

R/ggcoef.R

@@ -60,7 +60,7 @@ ggcoef <- function(
     sort = c("none", "ascending", "descending"),
     ...) {
   if (!is.data.frame(x)) {
-    require_namespaces("broom")
+    rlang::check_installed("broom")
     x <- broom::tidy(
       x,
       conf.int = conf.int,

R/ggmatrix.R

@@ -21,7 +21,7 @@
 #' @template ggmatrix-legend-param
 #' @keywords hplot
 #' @author Barret Schloerke
-#' @importFrom rlang %||%
+#' @importFrom rlang %||% .data
 #' @export
 #' @examples
 #' # Small function to display plots only if it's interactive

R/ggmatrix_gtable.R

@@ -54,7 +54,7 @@ ggmatrix_gtable <- function(
         "  Character values can be parsed using the 'labeller' parameter."
       )
     }
-    ifnull(labels, as.character(seq_len(length_out)))
+    labels %||% as.character(seq_len(length_out))
   }
   fake_data <- expand.grid(
     Var1 = get_labels(pm$xAxisLabels, pm$ncol, "xAxisLabels"),
@@ -67,7 +67,7 @@ ggmatrix_gtable <- function(
   pm_fake <- ggplot(fake_data, mapping = aes(!!as.name("x"), !!as.name("y"))) +
     geom_point() +
     # make the 'fake' strips for x and y titles
-    facet_grid(Var2 ~ Var1, labeller = ifnull(pm$labeller, "label_value"), switch = pm$switch) +
+    facet_grid(Var2 ~ Var1, labeller = pm$labeller %||% "label_value", switch = pm$switch) +
     # remove both x and y titles
     labs(x = pm$xlab, y = pm$ylab)
 
@@ -141,7 +141,7 @@ ggmatrix_gtable <- function(
     pmg$grobs[index] <- legend_obj$grobs
 
     if ("guide-box" %in% legend_layout$name) {
-      legend_position <- ifnull(pm_fake$theme$legend.position, "right")
+      legend_position <- pm_fake$theme$legend.position %||% "right"
 
       if (legend_position %in% c("right", "left")) {
         pmg$widths[[legend_layout$l]] <- legend_obj$widths[1]

R/ggnet.R

@@ -209,7 +209,7 @@ ggnet <- function(
 
   # -- packages ----------------------------------------------------------------
 
-  require_namespaces(c("network", "sna", "scales"))
+  rlnag::check_installed(c("network", "sna", "scales"))
   # -- deprecations ------------------------------------------------------------
 
   if (length(mode) == 1 && mode == "geo") {

R/ggnet2.R

@@ -306,7 +306,7 @@ ggnet2 <- function(
 
   # -- packages ----------------------------------------------------------------
 
-  require_namespaces(c("network", "sna", "scales"))
+  rlang::check_installed(c("network", "sna", "scales"))
 
   # -- conversion to network class ---------------------------------------------
 

R/ggnetworkmap.R

@@ -167,15 +167,14 @@ ggnetworkmap <- function(
     label.nodes = FALSE,
     label.size = size / 2,
     ...) {
-  require_namespaces(c("network", "sna"))
+  rlang::check_installed(c("network", "sna"))
   # sna          # node placement if there is no ggplot object in function call
 
   # -- conversion to network class ---------------------------------------------
 
-  if (inherits(net, "igraph") && "intergraph" %in% rownames(installed.packages())) {
+  if (inherits(net, "igraph")) {
+    rlang::check_installed("intergraph")
     net <- intergraph::asNetwork(net)
-  } else if (inherits(net, "igraph")) {
-    stop("install the 'intergraph' package to use igraph objects with ggnet")
   }
 
   if (!network::is.network(net)) {
@@ -229,9 +228,7 @@ ggnetworkmap <- function(
   if (missing(gg)) {
     # mapproj doesn't need to be loaded, but
     # it needs to exist for ggplot2::coord_map() to work properly
-    if (!("mapproj" %in% installed.packages())) {
-      require_namespaces("mapproj")
-    }
+    rlang::check_installed("mapproj")
     gg <- ggplot() +
       coord_map()
 
@@ -320,7 +317,7 @@ ggnetworkmap <- function(
 
   if (great.circles) {
     # geosphere    # great circles
-    require_namespaces("geosphere")
+    rlang::check_installed("geosphere")
 
     pts <- 25 # number of intermediate points for drawing great circles
     i <- 0 # used to keep track of groups when getting intermediate points for great circles

R/ggnostic.R

@@ -32,7 +32,7 @@ broomify <- function(model, lmStars = TRUE) {
     return(model)
   }
 
-  require_namespaces("broom")
+  rlang::check_installed("broom")
 
   broom_glance_info <- broom::glance(model)
   broom_tidy_coef <- broom::tidy(model)
@@ -496,7 +496,7 @@ fn_switch <- function(
   function(data, mapping, ...) {
     var <- mapping_string(mapping[[mapping_val]])
 
-    fn <- ifnull(types[[var]], types[["default"]])
+    fn <- types[[var]] %||% types[["default"]]
 
     if (is.null(fn)) {
       stop(str_c(

R/ggpairs_internal_plots.R

@@ -114,7 +114,7 @@ wrap_fn_with_param_arg <- function(
   }
 
 
-  allParams <- ifnull(attr(funcVal, "params"), list())
+  allParams <- attr(funcVal, "params") %||% list()
   allParams[names(params)] <- params
 
   original_fn <- funcVal

R/ggparcoord.R

@@ -468,7 +468,7 @@ ggparcoord <- function(
     "Outlying", "Skewed", "Clumpy", "Sparse", "Striated", "Convex", "Skinny",
     "Stringy", "Monotonic"
   )) {
-    require_namespaces("scagnostics")
+    rlang::check_installed("scagnostics")
     scag <- scagnostics::scagnostics(saveData2)
     data.m$variable <- factor(data.m$variable, levels = scag_order(scag, names(saveData2), order))
   } else if (tolower(order) == "skewness") {

R/ggscatmat.R

@@ -293,7 +293,7 @@ scatmat <- function(data, columns = 1:ncol(data), color = NULL, alpha = 1) {
       j <- subset(densities, xlab == names(dn)[m])
       r <- r + stat_density(
         aes(
-          x = !!as.name("x"),
+          x = .data$x,
           y = after_stat(scaled) * diff(range(!!as.name("x"))) + min(!!as.name("x")) # nolint
         ),
         data = j, position = "identity", geom = "line", color = "black"
@@ -330,7 +330,7 @@ scatmat <- function(data, columns = 1:ncol(data), color = NULL, alpha = 1) {
     r <- r +
       geom_point(
         data = ltdata.new,
-        aes(colour = !!as.name("colorcolumn")),
+        aes(colour = .data$colorcolumn),
         alpha = alpha,
         na.rm = TRUE
       )

R/ggsurv.R

@@ -84,7 +84,7 @@ if (getRversion() >= "2.15.1") {
 #'       x = c(90, 125, 5, 60),
 #'       y = c(0.8, 0.65, 0.55, 0.30),
 #'       size = 5,
-#'       colour = scales::hue_pal(
+#'       colour = scales::pal_hue(
 #'         h         = c(0, 360) + 15,
 #'         c         = 100,
 #'         l         = 65,
@@ -111,9 +111,9 @@ ggsurv <- function(
     ylab = "Survival",
     main = "",
     order.legend = TRUE) {
-  require_namespaces(c("survival", "scales"))
+  rlang::check_installed(c("survival", "scales"))
 
-  strata <- ifelse(is.null(s$strata) == TRUE, 1, length(s$strata))
+  strata <- ifelse(is.null(s$strata), 1, length(s$strata))
   stopifnot(length(surv.col) == 1 | length(surv.col) == strata)
   stopifnot(length(lty.est) == 1 | length(lty.est) == strata)