animint2/tests/testthat/test-renderer1-url-fragment.R at master · vivekktiwari/animint2 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
acontext("url fragment identifier")

iris$observation <- 1:nrow(iris)
viz <- list(
  petal=a_plot()+
    a_geom_point(a_aes(Petal.Width, Petal.Length, fill=Species,
                   id=paste0("petal", observation)),
               clickSelects="observation", data=iris),
  sepal=a_plot()+
    a_geom_point(a_aes(Sepal.Width, Sepal.Length, fill=Species,
                   id=paste0("sepal", observation)),
               clickSelects="observation", data=iris),
  first=list(observation=5))

info <- animint2HTML(viz)

test_that("all species are selected for url with no selection", {
  opacity.str <- getStyleValue(info$html, "//td[@class='legend_entry_a_label']", "opacity")
  opacity.num <- as.numeric(opacity.str)
  opacity.exp <- rep(1, 6)
  expect_equal(opacity.num, opacity.exp)
})

test_that("one observation selected for url with no selection", {
  circle.xpath <- "//circle[@class='a_geom']"
  node.list <- getNodeSet(info$html, circle.xpath)
  opacity.str <- getStyleValue(info$html, circle.xpath, "opacity")
  names(opacity.str) <- sapply(node.list, xmlAttrs)["id",]
  selected.names <- paste0(c("petal", "sepal"), 5)
  is.selected <- names(opacity.str) %in% selected.names
  expect_equal(as.numeric(opacity.str[is.selected]), rep(1, 2))
  expect_equal(as.numeric(opacity.str[!is.selected]), rep(0.5, 298))
})

old_address <- remDr$getCurrentUrl()[[1]]
new_address <- paste0(old_address, '#Species={setosa}')
remDr$navigate(new_address)
remDr$refresh()
Sys.sleep(10)
html <- getHTML()

test_that("one species is selected for url with selection", {
  entry.xpath <- "//td[@class='legend_entry_a_label']"
  node.list <- getNodeSet(html, entry.xpath)
  opacity.str <- getStyleValue(html, entry.xpath, "opacity")
  opacity.num <- as.numeric(opacity.str)
  value.vec <- sapply(node.list, xmlValue)
  is.setosa <- value.vec == "setosa"
  expect_equal(opacity.num[is.setosa], rep(1, 2))
  expect_equal(opacity.num[!is.setosa], rep(0.5, 4))
})

test_that("Current Url is displayed properly",{
  url.xpath <- "//tr[@class='selectorurl']//a"
  node <- getNodeSet(html,url.xpath)
  href <- xmlValue(node[[1]])
  expect_equal(href,paste0(new_address,'observation={5}'))
})

remDr$navigate(old_address)