acontext("PeakConsistency") library(animint2) data(PeakConsistency, package = "animint2") 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, color=model, size=model), showSelected=c("seed", "sample.size"), 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("(?\\S+?)", ": *", "(?.+?)", ";") 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, group=interaction(model, seed), color=model), showSelected="increase", clickSelects="seed", 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), showSelected=c("seed", "increase"), color="grey50", data=PeakConsistency$signal)+ geom_vline(aes( xintercept=chromStart+0.5, color=model), showSelected=c("increase", "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, color=model, size=model), showSelected=c("seed", "sample.size", "increase"), data=PeakConsistency$model)+ geom_vline(aes( xintercept=chromStart+0.5, color=model, size=model), showSelected=c("seed", "sample.size", "increase"), 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)) print(color.counts) 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 in last plot", { line.list <- getNodeSet(info$html, '//g[@class="geom6_vline_signals"]//line') expect_equal(length(line.list), 20) }) test_that("20 prediction in last plot", { line.list <- getNodeSet(info$html, '//g[@class="geom8_vline_signals"]//line') expect_equal(length(line.list), 20) })