Nothing
acontext("variable value")
problems <-
data.frame(problemStart=c(100, 200, 100, 150, 200, 250),
problemEnd=c(200, 300, 150, 200, 250, 300),
problem.i=c(1, 2, 1, 2, 3, 4),
bases.per.problem=c(100, 100, 50, 50, 50, 50))
problems$problem.name <- with(problems, {
sprintf("size.%d.problem.%d", bases.per.problem, problem.i)
})
sizes <- data.frame(bases.per.problem=c(50, 100),
problems=c(2, 4))
problems$peakStart <- problems$problemStart + 10
problems$peakEnd <- problems$problemEnd - 10
samples <-
rbind(data.frame(problems, sample.id="sample1", peaks=1),
data.frame(problems, sample.id="sample1", peaks=2),
data.frame(problems, sample.id="sample2", peaks=2))
peaks <-
expand.grid(peaks=0:2,
problem.name=problems$problem.name)
peaks$error.type <-
c("false positive", "false negative", "correct")
rownames(problems) <- problems$problem.name
peaks$bases.per.problem <-
problems[paste(peaks$problem.name), "bases.per.problem"]
peak.problems <-
rbind(data.frame(problems, peaks=1),
data.frame(problems, peaks=2))
one.error <-
data.frame(bases.per.problem=1:10,
errors=rnorm(10),
chunks="one")
two.error <-
data.frame(bases.per.problem=1:10,
errors=rnorm(10),
chunks="two")
showSelected.vec <- c(problem.name="peaks", "bases.per.problem")
clickSelects.vec <- c(problem.name="peaks")
viz <-
list(errorLines=ggplot()+
scale_color_manual(values=c(one="red", two="black"))+
scale_size_manual(values=c(one=1, two=2))+
geom_line(aes(bases.per.problem, errors,
color=chunks, size=chunks),
data=one.error)+
geom_line(aes(bases.per.problem, errors,
color=chunks, size=chunks),
data=two.error),
problems=ggplot()+
ggtitle("select problem")+
geom_segment(aes(problemStart, problem.i,
xend=problemEnd, yend=problem.i),
clickSelects="problem.name",
showSelected="bases.per.problem",
size=5,
data=data.frame(problems, sample.id="problems"))+
geom_text(aes(200, 5,
label=paste("problem size", bases.per.problem)),
showSelected="bases.per.problem",
data=data.frame(sizes, sample.id="problems"))+
geom_segment(aes(peakStart, problem.i,
xend=peakEnd, yend=problem.i),
showSelected=showSelected.vec,
clickSelects="problem.name",
data=data.frame(peak.problems, sample.id="problems"),
size=10,
color="deepskyblue")+
## TODO: yend=y=0 as params not aes?
geom_segment(aes(peakStart, 0,
xend=peakEnd, yend=0),
showSelected=showSelected.vec,
clickSelects="problem.name",
data=samples,
size=10,
color="deepskyblue")+
theme_bw()+
theme(panel.margin=grid::unit(0, "cm"))+
facet_grid(sample.id ~ .),
title="viz with .variable .value",
sizes=ggplot()+
ggtitle("select problem size")+
geom_point(aes(bases.per.problem, problems),
clickSelects="bases.per.problem",
size=10,
data=sizes),
peaks=ggplot()+
ggtitle("select number of peaks")+
geom_point(aes(peaks, peaks,
color=error.type,
id=peaks),
showSelected=c("problem.name", "bases.per.problem"),
clickSelects = clickSelects.vec,
size=10,
data=peaks)+
geom_text(aes(1, 3, label=problem.name),
showSelected=c("problem.name", "bases.per.problem"),
data=problems))
info <- animint2HTML(viz)
test_that("No widgets for .variable .value selectors", {
computed.vec <- getSelectorWidgets(info$html)
expected.vec <- c(
"chunks", "problem.name", "bases.per.problem",
"error.type")
expect_identical(sort(computed.vec), sort(expected.vec))
})
circle.xpath <- '//svg[@id="plot_peaks"]//circle'
title.xpath <- paste0(circle.xpath, '//title')
test_that("clickSelects.variable tooltip/title", {
circle.list <- getNodeSet(info$html, circle.xpath)
expect_equal(length(circle.list), 3)
title.list <- getNodeSet(info$html, title.xpath)
title.vec <- sapply(title.list, xmlValue)
expect_identical(title.vec, paste("size.100.problem.1", 0:2))
})
test_that("two lines rendered in first plot", {
path.list <- getNodeSet(
info$html, '//svg[@id="plot_errorLines"]//g[@class="PANEL1"]//path')
style.strs <- sapply(path.list, function(x) xmlAttrs(x)["style"])
pattern <-
paste0("(?<name>\\S+?)",
": *",
"(?<value>.+?)",
";")
style.matrices <- str_match_all_perl(style.strs, pattern)
size.vec <- sapply(style.matrices, function(m)m["stroke-width", "value"])
size.num <- as.numeric(sub("px", "", size.vec))
expect_equal(size.num, c(1, 2))
color.vec <- sapply(style.matrices, function(m)m["stroke", "value"])
expect_color(color.vec, c("red", "black"))
})
test_that(".variable and .value makes compiler create selectors", {
selector.names <- sort(names(info$selectors))
problem.selectors <- paste0(problems$problem.name)
expected.names <-
sort(c("problem.name",
"error.type",
"chunks",
problem.selectors,
"bases.per.problem"))
expect_identical(selector.names, expected.names)
selected <- sapply(info$selectors[problem.selectors], "[[", "selected")
expect_true(all(selected == "1"))
})
test_that(".variable and .value renders correctly at first", {
node.list <-
getNodeSet(info$html, '//g[@class="geom6_segment_problems"]//line')
expect_equal(length(node.list), 2)
})
test_that("clicking reduces the number of peaks", {
no.peaks.html <- clickHTML(id=0)
node.list <-
getNodeSet(no.peaks.html, '//g[@class="geom6_segment_problems"]//line')
expect_equal(length(node.list), 1)
})
test_that("clicking increases the number of peaks", {
more.peaks.html <- clickHTML(id=2)
node.list <-
getNodeSet(more.peaks.html, '//g[@class="geom6_segment_problems"]//line')
expect_equal(length(node.list), 3)
})
viz.for <-
list(problems=ggplot()+
ggtitle("select problem")+
geom_segment(aes(problemStart, problem.i,
xend=problemEnd, yend=problem.i),
clickSelects="problem.name",
showSelected="bases.per.problem",
size=5,
data=data.frame(problems, sample.id="problems"))+
geom_text(aes(200, 5,
label=paste("problem size", bases.per.problem)),
showSelected="bases.per.problem",
data=data.frame(sizes, sample.id="problems"))+
theme_bw()+
theme(panel.margin=grid::unit(0, "cm"))+
facet_grid(sample.id ~ .),
title="viz with for loop",
sizes=ggplot()+
ggtitle("select problem size")+
geom_point(aes(bases.per.problem, problems),
clickSelects="bases.per.problem",
size=10,
data=sizes),
peaks=ggplot()+
ggtitle("select number of peaks")+
geom_text(aes(1, 3, label=problem.name),
showSelected="problem.name",
data=problems))
pp.list <- split(peak.problems, peak.problems$problem.name)
s.list <- split(samples, samples$problem.name)
p.list <- split(peaks, peaks$problem.name)
for(problem.name in names(p.list)){
s.name <- paste0(problem.name, "peaks")
p <- p.list[[problem.name]]
p[[s.name]] <- p$peaks
pp <- pp.list[[problem.name]]
pp[[s.name]] <- pp$peaks
## need problem.underscore since a proper CSS id (as recognized by
## phantomJS) does not have dots!
pp$problem.nodots <- gsub("[.]", "", pp$problem.name)
s <- s.list[[problem.name]]
s[[s.name]] <- s$peaks
p$bases.per.problem <- pp$bases.per.problem[1]
viz.for$problems <- viz.for$problems+
geom_segment(aes_string("peakStart", "problem.i",
id="problem.nodots",
xend="peakEnd", yend="problem.i"),
showSelected=c(s.name, "bases.per.problem"),
clickSelects="problem.name",
data=data.frame(pp, sample.id="problems"),
size=10,
color="deepskyblue")+
geom_segment(aes_string("peakStart", "0",
xend="peakEnd", yend="0"),
showSelected=c(s.name, "bases.per.problem"),
clickSelects="problem.name",
data=s,
size=10,
color="deepskyblue")
viz.for$peaks <- viz.for$peaks+
geom_point(aes_string("peaks", "peaks"),
showSelected=c("problem.name", "bases.per.problem"),
clickSelects=s.name,
size=10,
data=p)
}
info <- animint2HTML(viz.for)
test_that("Widgets for regular selectors", {
computed.vec <- getSelectorWidgets(info$html)
expected.vec <- c(
"problem.name", "bases.per.problem",
"size.100.problem.1peaks", "size.100.problem.2peaks",
"size.50.problem.1peaks", "size.50.problem.2peaks",
"size.50.problem.3peaks", "size.50.problem.4peaks")
expect_identical(sort(computed.vec), sort(expected.vec))
})
chunk.counts <- function(html=getHTML()){
node.set <-
getNodeSet(html, '//td[@class="downloaded"]')
as.integer(sapply(node.set, xmlValue))
}
test_that("counts of chunks downloaded or not at first", {
value.vec <- chunk.counts()
expect_equal(value.vec,
c(1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1,
0, 0, 0, 0, 0))
})
test_that("changing problem downloads one chunk", {
clickID('size100problem2')
Sys.sleep(1)
value.vec <- chunk.counts()
expect_equal(value.vec,
c(1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1,
0, 0, 0, 0))
})
test_that("clickSelects tooltip/title", {
circle.list <- getNodeSet(info$html, circle.xpath)
expect_equal(length(circle.list), 3)
title.list <- getNodeSet(info$html, title.xpath)
title.vec <- sapply(title.list, xmlValue)
expect_identical(title.vec, paste("size.100.problem.1peaks", 0:2))
})
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.