test-renderer1-linetype.R

acontext("linetype")

error.types <-
  data.frame(x=1:3, status=c("correct", "false positive", "false negative"))

gg <- 
  a_plot(error.types)+
    a_geom_point(a_aes(x, x))+
    a_geom_tallrect(a_aes(xmin=x, xmax=x+0.5, linetype=status),
                  fill="grey",
                  color="black")

dasharrayPattern <-
  paste0("stroke-dasharray:",
         "(?<value>.*?)",
         ";")

rect.xpaths <- 
  c('//svg[@id="plot_numeric"]//g[@class="PANEL1"]//rect',
    '//svg[@id="plot_character"]//g[@class="PANEL1"]//rect',
    '//td[@class="numeric_legend"]//rect',
    '//td[@class="character_legend"]//rect')

test_that("linetypes render correctly", {
  viz <-
    list(numeric=gg+
           a_scale_linetype_manual(values=c(correct=0,
                                   "false positive"=1,
                                   "false negative"=3),
                                limits=c("correct", "false positive",
                                 "false negative")),

         character=gg+a_scale_linetype_manual(values=c(correct="blank",
                                              "false positive"="solid",
                                              "false negative"="dotted"),
                                limits=c("correct", "false positive",
                                 "false negative")))
  info <- animint2HTML(viz)

  for(xpath in rect.xpaths){
    node.set <- getNodeSet(info$html, xpath)
    expect_equal(length(node.set), 3)
    attr.mat <- sapply(node.set, xmlAttrs)
    match.mat <- str_match_perl(attr.mat["style",], dasharrayPattern)
    value.vec <- match.mat[, "value"]
    expect_match(value.vec[1], "0(px)?, *20(px)?")
    expect_identical(value.vec[2], NA_character_)
    expect_match(value.vec[3], "2(px)?, *4(px)?")
  }
})