Nothing
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)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.