tests/testthat/test-shiny.R

In tdhock/animint2: Animated Interactive Grammar of Graphics

acontext("shiny")

## We do not need if(on wercker or travis){skip shiny test} as of 10
## Oct 2015, since we only run tests that match the TEST_SUITE env
## var, and test-shiny.R never matches.

## shiny tests require navigating to different ports, so remember
## where we are and return when tests are done
old_address <- remDr$getCurrentUrl()[[1]]
remDr$setImplicitWaitTimeout(milliseconds = 30000)

shiny_dir <- system.file("examples/shiny", package = "animint")
shiny_cmd <- "shiny::runApp(appDir=\"%s\", port=%d, launch.browser=FALSE)"
animint:::run_servr(port = 3147, directory = shiny_dir, code = shiny_cmd)
address <- sprintf("http://localhost:3147")

test_that("animint plot renders in a shiny app", {
  Sys.sleep(10) # give shiny a second to do it's thing
  remDr$navigate(address)
  Sys.sleep(10)
  ## just check that svg is displayed
  html <- getHTML()
  circles <- getNodeSet(html, "//div[@id='animint']//circle")
  expect_true(length(circles) >= 1)
})

shiny_dir <- system.file("examples/shiny-WorldBank", package = "animint")
shiny_cmd <- "shiny::runApp(appDir=\"%s\", port=%d, launch.browser=FALSE)"
animint:::run_servr(port = 3148, directory = shiny_dir, code = shiny_cmd)
address <- sprintf("http://localhost:3148")

test_that("WorldBank renders in a shiny app", {
  Sys.sleep(1) # give shiny a second to do it's thing
  remDr$navigate(address)
  Sys.sleep(20)
  ## just check that svg is displayed
  html <- getHTML()
  circles <- getNodeSet(html, "//div[@id='animint']//circle")
  expect_true(length(circles) >= 1)
})

getYear <- function(){
  node.set <- getNodeSet(getHTML(), '//g[@class="geom10_text_ts"]//text')
  expect_equal(length(node.set), 1)
  value <- xmlValue(node.set[[1]])
  sub("year = ", "", value)
}

test_that("animation updates", {
  old.year <- getYear()
  Sys.sleep(5) #wait for two animation frames.
  new.year <- getYear()
  expect_true(old.year != new.year)
})

getTickLeft <- function(){
  remDr$executeScript('
var node_list = document.querySelectorAll(".yaxis text");
var left_array = [];
for(var i=0; i < node_list.length; i++){
  var rect = node_list[i].getBoundingClientRect();
  left_array[i] = rect["left"];
}
return left_array;
')[[1]]
}

getDivLeft <- function(){
  remDr$executeScript('
return document.querySelector("#animint").getBoundingClientRect()["left"];
')[[1]]
}

test_that("animint fits in div", {
  tick.left.vec <- getTickLeft()
  div.left <- getDivLeft()
  expect_true(all(div.left < tick.left.vec))
})

getCountries <- function(){
  country.labels <- getNodeSet(getHTML(), '//g[@class="geom9_text_ts"]//text')
  sort(sapply(country.labels, xmlValue))
}

test_that("clicking selects country", {
  old.countries <- getCountries()
  expect_identical(old.countries, c("United States", "Vietnam"))
  clickID("Bahrain")
  new.countries <- getCountries()
  expect_identical(new.countries, c("Bahrain", "United States", "Vietnam"))
})

getFacets <- function(){
  facets <- getNodeSet(getHTML(), '//g[@class="topStrip"]//text')
  sapply(facets, xmlValue)
}

test_that("shiny changes axes", {
  old.facets <- getFacets()
  expect_identical(old.facets, c("fertility.rate", "Years"))
  e <- remDr$findElement("class name", "selectize-input")
  ## This click and sendKeys is just to make sure we have focus on the
  ## first selectize element.
  e$clickElement()
  e$sendKeysToElement(list(key="backspace"))
  e$clickElement() # hide menu
  e$clickElement() # show menu
  remDr$sendKeysToActiveElement(list(key="backspace"))
  remDr$sendKeysToActiveElement(list("lite"))
  remDr$sendKeysToActiveElement(list(key="enter"))
  Sys.sleep(10)
  new.facets <- getFacets()
  expect_identical(new.facets, c("literacy", "Years"))
})

rmd_dir <- system.file("examples/rmarkdown", package = "animint")
rmd_cmd <- "rmarkdown::run(dir = \"%s\", shiny_args = list(port=%d, launch.browser=FALSE))"
animint:::run_servr(port = 3120, directory = rmd_dir, code = rmd_cmd)
address <- sprintf("http://localhost:3120")

test_that("animint plot renders in an interactive document", {
  Sys.sleep(10) # give shiny a second to do it's thing
  remDr$navigate(address)
  Sys.sleep(10)
  e <- remDr$findElement("class name", "shiny-frame")
  remDr$switchToFrame(e)
  html <- getHTML()
  circles <- getNodeSet(html, "//svg//circle")
  expect_true(length(circles) >= 1)
})

## go back to non-shiny tests
remDr$navigate(old_address)