tests/testthat/test-renderer1-PeakConsistency.R

In tdhock/animint: Interactive animations

acontext("PeakConsistency")

data(PeakConsistency, package = "animint")

color.code <-
  c(truth="#1B9E77", #teal
    PeakSeg="#D95F02", #orange
    PeakSegJoint="#7570B3", #violet
    "#E7298A", #pink
    "#66A61E", #green
    "#E6AB02", #tan
    "#A6761D", #brown
    "#666666") #grey

second.small <-
  list(signals=ggplot()+
         theme_bw()+
         theme_animint(width=1000, height=800)+
         theme(panel.margin=grid::unit(0, "cm"))+
         facet_grid(sample.id ~ ., labeller=function(val){
           mapply(paste, "sample", val, SIMPLIFY = FALSE)
         })+
         guides(size="none")+
         geom_segment(aes(chromStart+0.5, mean,
                          xend=chromEnd+0.5, yend=mean,
                          showSelected=seed, showSelected2=sample.size,
                          color=model, size=model),
                      data=subset(PeakConsistency$model, increase==1))+
         scale_size_manual(values=c(PeakSegJoint=0.5, PeakSeg=1))+
         scale_color_manual(values=color.code),
       first=list(sample.size=5))

info <- animint2HTML(second.small)

getStroke <- function(element.list){
  style.strs <- sapply(element.list, function(x) xmlAttrs(x)["style"])
  pattern <-
    paste0("(?<name>\\S+?)",
           ": *",
           "(?<value>.+?)",
           ";")
  style.matrices <- str_match_all_perl(style.strs, pattern)
  sapply(style.matrices, function(m)m["stroke", "value"])
}

test_that("15 segments of both colors", {
  line.list <-
    getNodeSet(info$html, '//g[@class="geom1_segment_signals"]//line')
  computed.vec <- getStroke(line.list)
  color.counts <- as.numeric(table(computed.vec))
  expect_equal(color.counts, c(15, 15))
})

viz <-
  list(increase=ggplot()+
         make_tallrect(PeakConsistency$increase, "increase")+
         geom_line(aes(increase, mean.diff), data=PeakConsistency$increase),
       errors=ggplot()+
         ylab("distance from true peaks to estimated peaks")+
         scale_color_manual(values=color.code)+
         make_tallrect(PeakConsistency$error, "sample.size")+
         geom_line(aes(sample.size, errors,
                       clickSelects=seed,
                       showSelected=increase,
                       group=interaction(model, seed),
                       color=model),
                   size=5,
                   alpha=0.7,
                   data=PeakConsistency$error),
       signals=ggplot()+
         theme_bw()+
         theme_animint(width=1000, height=800)+
         theme(panel.margin=grid::unit(0, "cm"))+
         facet_grid(sample.id ~ ., labeller=function(val){
           mapply(paste, "sample", val, SIMPLIFY = FALSE)
         })+
         geom_point(aes(chromEnd, count,
                        showSelected3=increase,
                        showSelected=seed),
                    color="grey50",
                    data=PeakConsistency$signal)+
         geom_vline(aes(xintercept=chromStart+0.5, color=model,
                        showSelected=increase,
                        showSelected2=seed),
                    show.legend=TRUE,
                    linetype="dashed",
                    data=PeakConsistency$truth)+
         guides(size="none")+
         geom_segment(aes(chromStart+0.5, mean,
                          xend=chromEnd+0.5, yend=mean,
                          showSelected3=increase,
                          showSelected=seed, showSelected2=sample.size,
                          color=model, size=model),
                      data=PeakConsistency$model)+
         geom_vline(aes(xintercept=chromStart+0.5,
                        showSelected=seed, showSelected2=sample.size,
                        showSelected3=increase,
                        color=model, size=model),
                    show.legend=TRUE,
                    linetype="dashed",
                    data=PeakConsistency$guess)+
         scale_size_manual(values=c(PeakSegJoint=1, PeakSeg=2))+
         scale_color_manual(values=color.code),
       first=list(sample.size=5))

## viz$errors+facet_grid(. ~ increase)
## viz$signals+facet_grid(sample.id ~ increase + seed)

info <- animint2HTML(viz)

test_that("4 paths of both colors in second plot", {
  path.list <- 
    getNodeSet(info$html, '//g[@class="geom4_line_errors"]//path')
  computed.vec <- getStroke(path.list)
  color.counts <- as.numeric(table(computed.vec))
  expect_equal(color.counts, c(4, 4))
})

test_that("15 segments of both colors in last plot", {
  line.list <-
    getNodeSet(info$html, '//g[@class="geom7_segment_signals"]//line')
  computed.vec <- getStroke(line.list)
  color.counts <- as.numeric(table(computed.vec))
  expect_equal(color.counts, c(15, 15))
})

## test_that("showSelectedlegendcolour is truth", {
##   tsv.path <-
##     file.path("animint-htmltest", "geom6_vline_signals_chunk_common.tsv")
##   common.df <- read.table(tsv.path, comment.char="", header=TRUE)
##   computed.vec <- paste(common.df$showSelectedlegendcolour)
##   expected.vec <- rep("truth", length(computed.vec))
##   expect_identical(computed.vec, expected.vec)
##   tsv.path <-
##     file.path("animint-htmltest", "geom6_vline_signals_chunk1.tsv")
##   varied.df <- read.table(tsv.path, comment.char="", header=TRUE)
## })

test_that("20 truth <line> in last plot", {
  line.list <-
    getNodeSet(info$html, '//g[@class="geom6_vline_signals"]//line')
  expect_equal(length(line.list), 20)
})

test_that("20 prediction <line> in last plot", {
  line.list <-
    getNodeSet(info$html, '//g[@class="geom8_vline_signals"]//line')
  expect_equal(length(line.list), 20)
})