tests/testthat/test-renderer1-many-facets.R

In animint2: Animated Interactive Grammar of Graphics

library(testthat)

acontext("many facets")

n.circles <- 40
df <- data.frame(x=0, y=0, facet=1:n.circles)
gg <- ggplot()+
  geom_point(aes(x, y), data=df)+
  theme_bw()+
  theme(panel.margin=grid::unit(0, "cm"))
viz <-
  list(horizontal=gg+
         theme_animint(width=n.circles * 30 + 50)+
         facet_grid(. ~ facet),
       vertical=gg+
         theme_animint(height=n.circles * 30 + 50)+
         facet_grid(facet ~ .))

info <- animint2HTML(viz)

test_that("points have positive positions", {
  circle.list <-
    getNodeSet(info$html, '//circle')
  expect_equal(length(circle.list), n.circles * 2)
  xy.vec <- as.numeric(sapply(circle.list, function(circle){
    xmlAttrs(circle)[c("cx", "cy")]
  }))
  expect_true(all(0 < xy.vec))
})

test_that("no horizontal space between border_rects", {
  rect.list <- getNodeSet(
    info$html, '//svg[@id="plot_horizontal"]//rect[@class="border_rect"]')
  expect_equal(length(rect.list), n.circles)
  first <- xmlAttrs(rect.list[[1]])
  first.right <- as.numeric(first[["x"]])+as.numeric(first[["width"]])
  second <- xmlAttrs(rect.list[[2]])
  second.left <- as.numeric(second[["x"]])
  expect_equal(first.right, second.left)
})

test_that("no vertical space between border_rects", {
  rect.list <- getNodeSet(
    info$html, '//svg[@id="plot_vertical"]//rect[@class="border_rect"]')
  expect_equal(length(rect.list), n.circles)
  first <- xmlAttrs(rect.list[[1]])
  first.bottom <- as.numeric(first[["y"]])+as.numeric(first[["height"]])
  second <- xmlAttrs(rect.list[[2]])
  second.top <- as.numeric(second[["y"]])
  expect_equal(first.bottom, second.top)
})

test_that("right strips all at the same x position", {
  text.list <- getNodeSet(
    info$html, '//svg[@id="plot_vertical"]//g[@class="rightStrip"]//text')
  expect_equal(length(text.list), n.circles)
  translate.vec <- sapply(text.list, function(x)xmlAttrs(x)[["transform"]])
  translate.mat <- str_match_perl(translate.vec, translatePattern)
  x.vec <- as.numeric(translate.mat[, "x"])
  expected.val <- x.vec[[1]]
  expected.vec <- rep(expected.val, length(x.vec))
  ## print(rbind(computed=x.vec,
  ##             expected=expected.vec))
  expect_equal(x.vec, expected.vec)
})