replacing plyr occurences

DESCRIPTION

@@ -74,7 +74,6 @@ Imports:
     grid,
     gtable (>= 0.1.1),
     MASS,
-    plyr (>= 1.7.1),
     reshape2,
     scales (>= 0.4.1),
     stats,

NAMESPACE

@@ -509,16 +509,13 @@ import(RJSONIO)
 import(data.table)
 import(grid)
 import(gtable)
-import(plyr)
 import(scales)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,rgb)
 importFrom(grid,arrow)
 importFrom(grid,unit)
 importFrom(knitr,knit_print)
 importFrom(methods,is)
-importFrom(plyr,as.quoted)
-importFrom(plyr,defaults)
 importFrom(scales,alpha)
 importFrom(stats,na.omit)
 importFrom(stats,setNames)

R/facet-grid-.r

@@ -121,7 +121,6 @@
 #' mg + facet_grid(vs + am ~ gear, margins = "gear")
 #' mg + facet_grid(vs + am ~ gear, margins = c("gear", "am"))
 #' }
-#' @importFrom plyr as.quoted
 facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = NULL, drop = TRUE) {
   scales <- match.arg(scales, c("fixed", "free_x", "free_y", "free"))
   free <- list(

R/ggplot2.r

@@ -1,4 +1,3 @@
 #' @import scales grid gtable
-#' @importFrom plyr defaults
 #' @importFrom stats setNames
 NULL

R/utilities.r

@@ -306,3 +306,151 @@ stop_servr <- function(tmpPath = ".") {
   }
   res
 }
+
+# Replacement for plyr::as.quoted
+as.quoted <- function(x) {
+  if (is.null(x)) return(list())
+  if (is.quoted(x)) return(x)
+
+  if (is.character(x)) {
+    return(structure(lapply(x, as.name), class = "quoted"))
+  }
+  if (is.name(x)) {
+    return(structure(list(x), class = "quoted"))
+  }
+  if (is.formula(x)) {
+    return(structure(as.list(parse.formula(x)), class = "quoted"))
+  }
+  if (is.call(x)) {
+    if (identical(x[[1]], as.name("+"))) {
+      # Handle expressions like a + b
+      left <- as.quoted(x[[2]])
+      right <- as.quoted(x[[3]])
+      return(structure(c(left, right), class = "quoted"))
+    }
+    return(structure(list(x), class = "quoted"))
+  }
+  if (is.list(x)) {
+    return(structure(x, class = "quoted"))
+  }
+
+  structure(list(x), class = "quoted")
+}
+
+# Helper function to check if object is already quoted
+is.quoted <- function(x) {
+  inherits(x, "quoted")
+}
+
+# Helper to parse formula objects
+parse.formula <- function(f) {
+  if (length(f) == 2) {
+    # One-sided formula
+    vars <- f[[2]]
+  } else if (length(f) == 3) {
+    # Two-sided formula
+    vars <- f[[2:3]]
+  } else {
+    stop("Invalid formula")
+  }
+
+  if (is.call(vars) && identical(vars[[1]], as.name("+"))) {
+    # Handle formulas with multiple variables (e.g., a + b)
+    as.list(vars[-1])
+  } else {
+    list(vars)
+  }
+}
+
+# Evaluation function to replace plyr::eval.quoted
+eval.quoted <- function(exprs, data = NULL, enclos = parent.frame()) {
+  if (!is.quoted(exprs)) exprs <- as.quoted(exprs)
+
+  if (is.null(data)) {
+    lapply(exprs, eval, envir = enclos)
+  } else {
+    lapply(exprs, eval, envir = data, enclos = enclos)
+  }
+}
+
+# Replacement for plyr::id
+id <- function(x, drop = FALSE) {
+  if (length(x) == 0) return(integer())
+
+  if (is.data.frame(x)) {
+    # Handle data frames by converting to a list of vectors
+    x <- lapply(x, as.factor)
+  } else {
+    x <- as.factor(x)
+  }
+
+  # For a single vector, just return the numeric values
+  if (!is.list(x)) {
+    return(as.integer(x))
+  }
+
+  # For multiple vectors, create unique combinations
+  combs <- do.call(paste, c(x, sep = "\r"))
+  as.integer(factor(combs, levels = unique(combs)))
+}
+
+#' Fill in missing values in a list with values from another list
+#'
+#' This function takes two lists and fills in missing values in the first list
+#' with values from the second list. It's similar to modifyList() but preserves
+#' NULLs and doesn't recursively merge nested lists.
+#'
+#' @param x the list to be modified
+#' @param y the list of defaults to use to fill in missing values
+#' @return a new list with missing values in x filled in from y
+#' @noRd
+defaults <- function(x, y) {
+  if (is.null(x)) return(y)
+  if (is.null(y)) return(x)
+
+  # Special handling for unit objects
+  if (inherits(x, "unit") || inherits(y, "unit")) {
+    return(x)
+  }
+  # Special handling for theme elements
+  if (inherits(x, "element") || inherits(y, "element")) {
+    return(x)
+  }
+  # Handle unnamed vectors/lists
+  if (is.null(names(x)) && is.null(names(y))) {
+    return(x)
+  }
+  # If x is unnamed but y is named, add names from y
+  if (is.null(names(x)) && !is.null(names(y))) {
+    names(x) <- names(y)[seq_along(x)]
+  }
+  # Get names from both lists
+  nx <- names(x)
+  ny <- names(y)
+  # Find which names in y are missing from x
+  missing <- setdiff(ny, nx)
+  # Add missing elements from y to x
+  if (length(missing) > 0) {
+    # Handle lists specially to preserve attributes
+    if (is.list(x) && is.list(y)) {
+      x[missing] <- y[missing]
+    } else {
+      # For other types, do standard combination
+      x <- c(x, y[missing])
+    }
+  }
+  # Preserve attributes where possible
+  if (!is.null(attributes(y))) {
+    attrs <- attributes(y)
+    # Don't copy over names or class
+    attrs$names <- NULL 
+    attrs$class <- NULL
+    # Copy remaining attributes if they don't already exist
+    for (a in names(attrs)) {
+      if (is.null(attr(x, a))) {
+        attr(x, a) <- attrs[[a]]
+      }
+    }
+  }
+  x
+} 

R/z_animint.R

@@ -729,7 +729,7 @@ getLegendList <- function(plistextra){
     guides.args[[aes.name]] <- guide.type
   }
   guides.result <- do.call(guides, guides.args)
-  guides.list <- plyr::defaults(plot$guides, guides.result)
+  guides.list <- defaults(plot$guides, guides.result)
   gdefs <- guides_train(scales = scales,
                            theme = theme,
                            guides = guides.list,

tests/testthat/helper-plot-data.r

@@ -1,13 +1,16 @@
+library(data.table)
 # Transform the data as the coordinate system does
 cdata <- function(plot) {
   pieces <- ggplot_build(plot)
-
+  # Process each piece of data while maintaining panel structure
   lapply(pieces$data, function(d) {
-    plyr::ddply(d, "PANEL", function(panel_data) {
-      scales <- panel_scales(pieces$panel, panel_data$PANEL[1])
+    dt <- as.data.table(d)
+    # Explicitly group by PANEL and process each panel's data
+    dt[, {
+      scales <- panel_scales(pieces$panel, PANEL)
       details <- plot$coordinates$train(scales)
-      plot$coordinates$transform(panel_data, details)
-    })
+      as.data.table(plot$coordinates$transform(as.data.frame(.SD), details))
+    }, by = PANEL]
   })
 }
 

tests/testthat/test-compiler-animation.R

@@ -1,15 +1,17 @@
 acontext("animation")
 
-if(require(maps) && require(plyr)){
+library(data.table)
+library(animint2)
+if(require(maps)){
   data(UStornadoes, package = "animint2")
   stateOrder <- data.frame(state = unique(UStornadoes$state)[order(unique(UStornadoes$TornadoesSqMile), decreasing=T)], rank = 1:49) # order states by tornadoes per square mile
   UStornadoes$state <- factor(UStornadoes$state, levels=stateOrder$state, ordered=TRUE)
   UStornadoes$weight <- 1/UStornadoes$LandArea
   # useful for stat_bin, etc.
   USpolygons <- map_data("state")
-  USpolygons$state = state.abb[match(USpolygons$region, tolower(state.name))]
-  UStornadoCounts <-
-    ddply(UStornadoes, .(state, year), summarize, count=length(state))
+  USpolygons$state <- state.abb[match(USpolygons$region, tolower(state.name))]
+  UStornadoes_dt <- data.table(UStornadoes)
+  UStornadoCounts <- UStornadoes_dt[, .(count = .N), by = .(state, year)]
   tornado.anim <- list(
     map=ggplot()+
       geom_polygon(aes(

tests/testthat/test-compiler-fortify.r

@@ -1,5 +1,6 @@
 context("Fortify")
 library(sp)
+library(animint2)
 
 test_that("Spatial polygons have correct ordering", {
   make_square <- function(x = 0, y = 0, height = 1, width = 1){
@@ -32,6 +33,7 @@ test_that("Spatial polygons have correct ordering", {
   polys2_sp <- SpatialPolygons(polys2)
   fake_sp2 <- SpatialPolygonsDataFrame(polys2_sp, fake_data)
 
-  expect_equivalent(fortify(fake_sp), plyr::arrange(fortify(fake_sp2), id, order))
-
+  fortified <- fortify(fake_sp2)
+  fortified <- fortified[order(fortified$id, fortified$order), ]
+  expect_equivalent(fortify(fake_sp), fortified)
 })

tests/testthat/test-compiler-save-separate-chunks.R

@@ -1,5 +1,5 @@
 acontext("save separate chunks")
-library(plyr)
+library(data.table)
 
 data(FluView, package = "animint2")
 # use one season to test
@@ -85,15 +85,13 @@ test_that("save separate chunks for geom_polygon", {
 })
 
 ### test case 2
-USdots <-
-  ddply(FluView$USpolygons, .(region), summarise,
-        mean.lat = mean(lat), 
-        mean.long = mean(long))
-# add state flu to points.
-flu.points <- ldply(unique(state_flu$WEEKEND), function(we) {
+USpolygons_dt <- as.data.table(FluView$USpolygons)
+USdots <- USpolygons_dt[, .(mean.lat = mean(lat), mean.long = mean(long)), by = region]
+
+flu.points <- rbindlist(lapply(unique(state_flu$WEEKEND), function(we) {
   df <- subset(state_flu, WEEKEND == we)
   merge(USdots, df, by.x = "region", by.y = "state")
-})
+}))
 
 test_that("save separate chunks for geom_point without specifying group", {
   # the compiler will not break a geom into chunks if any of the resulting 

tests/testthat/test-renderer1-hjust-text-anchor.R

@@ -39,12 +39,13 @@ grad.desc <- function(
 
 dat <- grad.desc()
 contour <- dat$contour
-objective <- dat$objective
-objective <- plyr::ldply(objective$iteration, function(i) {
-  df <- subset(objective, iteration <= i)
-  cbind(df, iteration2 = i)
-})
-objective2 <- subset(objective, iteration == iteration2)
+objective <- as.data.table(dat$objective)
+
+objective <- objective[, {
+  .SD[, .(iteration, x, y, z, iteration2 = i)]
+}, by = .(i = iteration)][, i := NULL][]
+
+objective2 <- objective[iteration == iteration2]
 
 grad.desc.viz <- function(hjust) {
   objective2$hjust <- hjust

tests/testthat/test-renderer1-interactivity.R

@@ -178,9 +178,10 @@ UStornadoes$state <- factor(UStornadoes$state, levels=stateOrder$state, ordered=
 UStornadoes$weight <- 1/UStornadoes$LandArea
 USpolygons <- map_data("state")
 USpolygons$state = state.abb[match(USpolygons$region, tolower(state.name))]
-library(plyr)
-UStornadoCounts <-
-  ddply(UStornadoes, .(state, year), summarize, count=length(state))
+
+library(data.table) 
+UStornadoes_dt <- as.data.table(UStornadoes)
+UStornadoCounts <- UStornadoes_dt[, .(count = .N), by = .(state, year)]
 seg.color <- "#55B1F7"
 tornado.lines <- list(
   map=ggplot()+