Skip to content
Closed
Show file tree
Hide file tree
Changes from 12 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,6 @@ Imports:
grid,
gtable (>= 0.1.1),
MASS,
plyr (>= 1.7.1),
reshape2,
scales (>= 0.4.1),
stats,
Expand Down
25 changes: 16 additions & 9 deletions tests/testthat/helper-plot-data.r
Original file line number Diff line number Diff line change
@@ -1,26 +1,33 @@
library(data.table)
# Transform the data as the coordinate system does

cdata <- function(plot) {
pieces <- ggplot_build(plot)

lapply(pieces$data, function(d) {
plyr::ddply(d, "PANEL", function(panel_data) {
scales <- panel_scales(pieces$panel, panel_data$PANEL[1])

# Process each piece of data while maintaining panel structure
result <- lapply(pieces$data, function(d) {
dt <- as.data.table(d)

# Explicitly group by PANEL and process each panel's data
dt[, {
current_panel <- .BY[[1]] # Get the current PANEL from grouping
scales <- panel_scales(pieces$panel, current_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]
})

return(result)
}

pranges <- function(plot) {
panels <- ggplot_build(plot)$panel

x_ranges <- lapply(panels$x_scales, function(scale) scale$get_limits())
y_ranges <- lapply(panels$y_scales, function(scale) scale$get_limits())



npscales <- plot$scales$non_position_scales()
npranges <- lapply(npscales$scales$scales, function(scale) scale$get_limits())


c(list(x = x_ranges, y = y_ranges), npranges)
}
70 changes: 37 additions & 33 deletions tests/testthat/test-compiler-animation.R
Original file line number Diff line number Diff line change
@@ -1,38 +1,42 @@
library(data.table)
library(animint2)
library(maps)

acontext("animation")

if(require(maps) && require(plyr)){
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))
tornado.anim <- list(
map=ggplot()+
geom_polygon(aes(
x=long, y=lat, group=group),
data=USpolygons,
clickSelects="state",
fill="black", colour="grey") +
geom_segment(aes(
x=startLong, y=startLat, xend=endLong, yend=endLat),
showSelected="year",
colour="#55B1F7", data=UStornadoes),
ts=ggplot()+
make_tallrect(UStornadoCounts, "year")+
geom_line(aes(
year, count, group=state),
clickSelects="state",
data=UStornadoCounts, alpha=3/5, size=4),
time=list(variable="year",ms=2000))
test_that("tornado animation frames correct", {
info <- animint2dir(tornado.anim, open.browser=FALSE)
expect_identical(info$time$sequence, as.character(1950:2012))
})
}
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))]

UStornadoes_dt <- data.table(UStornadoes)
UStornadoCounts <- UStornadoes_dt[, .(count = .N), by = .(state, year)]

tornado.anim <- list(
map=ggplot()+
geom_polygon(aes(
x=long, y=lat, group=group),
data=USpolygons,
clickSelects="state",
fill="black", colour="grey") +
geom_segment(aes(
x=startLong, y=startLat, xend=endLong, yend=endLat),
showSelected="year",
colour="#55B1F7", data=UStornadoes_dt),
ts=ggplot()+
make_tallrect(UStornadoCounts, "year")+
geom_line(aes(
year, count, group=state),
clickSelects="state",
data=UStornadoCounts, alpha=3/5, size=4),
time=list(variable="year",ms=2000))
test_that("tornado animation frames correct", {
info <- animint2dir(tornado.anim, open.browser=FALSE)
expect_identical(info$time$sequence, as.character(1950:2012))
})

## WorldBank/gapminder example.
data(WorldBank, package = "animint2")
Expand Down
9 changes: 7 additions & 2 deletions tests/testthat/test-compiler-fortify.r
Original file line number Diff line number Diff line change
@@ -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){
Expand Down Expand Up @@ -32,6 +33,10 @@ 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))
# arranged with data.table[order(id, order)]
fortified_sp2 <- fortify(fake_sp2)
fortified_sp2 <- as.data.table(fortified_sp2)
fortified_sp2 <- fortified_sp2[order(id, order)]

})
expect_equivalent(fortify(fake_sp), fortified_sp2)
})
14 changes: 6 additions & 8 deletions tests/testthat/test-compiler-save-separate-chunks.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
acontext("save separate chunks")
library(plyr)
library(data.table)

data(FluView, package = "animint2")
# use one season to test
Expand Down Expand Up @@ -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
Expand Down
14 changes: 10 additions & 4 deletions tests/testthat/test-renderer1-hjust-text-anchor.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,10 +40,16 @@ 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)
})

library(data.table)

objective_dt <- as.data.table(objective)

objective <- objective_dt[
CJ(iteration = iteration, iteration2 = iteration),
on = .(iteration <= iteration2)
][, iteration2 := iteration]

objective2 <- subset(objective, iteration == iteration2)

grad.desc.viz <- function(hjust) {
Expand Down
9 changes: 6 additions & 3 deletions tests/testthat/test-renderer1-interactivity.R
Original file line number Diff line number Diff line change
Expand Up @@ -178,9 +178,12 @@ 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))

# Replaced plyr::ddply with data.table
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()+
Expand Down
Binary file added tests/testthat/testthat-problems.rds
Binary file not shown.
Loading