diff --git a/DESCRIPTION b/DESCRIPTION index f2dba5747..8bb579f77 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -74,7 +74,6 @@ Imports: grid, gtable (>= 0.1.1), MASS, - plyr (>= 1.7.1), reshape2, scales (>= 0.4.1), stats, diff --git a/NAMESPACE b/NAMESPACE index e3dd8a975..8c80ee576 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -509,7 +509,6 @@ import(RJSONIO) import(data.table) import(grid) import(gtable) -import(plyr) import(scales) importFrom(grDevices,col2rgb) importFrom(grDevices,rgb) @@ -517,8 +516,6 @@ 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) diff --git a/R/facet-grid-.r b/R/facet-grid-.r index cf5312be1..680b07fba 100644 --- a/R/facet-grid-.r +++ b/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( diff --git a/R/ggplot2.r b/R/ggplot2.r index 90f86f657..04c1a4fa2 100644 --- a/R/ggplot2.r +++ b/R/ggplot2.r @@ -1,4 +1,3 @@ #' @import scales grid gtable -#' @importFrom plyr defaults #' @importFrom stats setNames NULL diff --git a/R/utilities.r b/R/utilities.r index 578770fd9..c5ceeefff 100644 --- a/R/utilities.r +++ b/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 +} \ No newline at end of file diff --git a/R/z_animint.R b/R/z_animint.R index 2608b31a0..d121239bb 100644 --- a/R/z_animint.R +++ b/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, diff --git a/tests/testthat/helper-plot-data.r b/tests/testthat/helper-plot-data.r index 69e8717cc..ac649769a 100644 --- a/tests/testthat/helper-plot-data.r +++ b/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] }) } diff --git a/tests/testthat/test-compiler-animation.R b/tests/testthat/test-compiler-animation.R index 032d7fe06..ae2c1cbdd 100644 --- a/tests/testthat/test-compiler-animation.R +++ b/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( diff --git a/tests/testthat/test-compiler-fortify.r b/tests/testthat/test-compiler-fortify.r index 5265fa482..e94e028b3 100644 --- a/tests/testthat/test-compiler-fortify.r +++ b/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) }) diff --git a/tests/testthat/test-compiler-save-separate-chunks.R b/tests/testthat/test-compiler-save-separate-chunks.R index 6cc02d37c..e2f0a69ae 100644 --- a/tests/testthat/test-compiler-save-separate-chunks.R +++ b/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 diff --git a/tests/testthat/test-renderer1-hjust-text-anchor.R b/tests/testthat/test-renderer1-hjust-text-anchor.R index fcecb6403..47b0d3b17 100644 --- a/tests/testthat/test-renderer1-hjust-text-anchor.R +++ b/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 diff --git a/tests/testthat/test-renderer1-interactivity.R b/tests/testthat/test-renderer1-interactivity.R index d8805c08f..c3b0904f8 100644 --- a/tests/testthat/test-renderer1-interactivity.R +++ b/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()+ diff --git a/tests/testthat/testthat-problems.rds b/tests/testthat/testthat-problems.rds new file mode 100644 index 000000000..a6b9a2872 Binary files /dev/null and b/tests/testthat/testthat-problems.rds differ