tests/testthat/test-renderer2-PredictedPeaks.R

In tdhock/animint2: Animated Interactive Grammar of Graphics

acontext("PredictedPeaks data set")

require(httr)
PredictedPeaks.RData <- file.path(tempdir(), "PredictedPeaks.RData")
request <- GET("http://github.com/tdhock/animint-examples/blob/master/data/PredictedPeaks.RData?raw=true")
stop_for_status(request)
writeBin(content(request), PredictedPeaks.RData)
## If we don't load this data set into the global environment, then we
## get Error in eval(expr, envir, enclos) (from helper-functions.R#5)
## : object 'PredictedPeaks' not found
load(PredictedPeaks.RData, .GlobalEnv) 

hover.dots <- subset(PredictedPeaks$chromCounts, nonInputType==type)

viz <- list(
  oneChrom=ggplot()+
    ggtitle("PeakSegJoint detections on selected chromosome")+
    theme_bw()+
    coord_cartesian(xlim=c(0, 1))+
    theme_animint(width=1500, height=100)+
    theme(axis.line.x=element_blank(), axis.text.x=element_blank(), 
          axis.ticks.x=element_blank(), axis.title.x=element_blank())+
    ## geom_text(aes(relative.middle, type.fac, label=samples.up,
    ##               clickSelects=peak.name,
    ##               showSelected2=chrom,
    ##               showSelected=dotID),
    ##           size=11,
    ##           data=PredictedPeaks$chromCounts)+
    geom_text(aes(relative.middle, type.fac, label=samples.up,
                  href=paste0(
                    "http://genome.ucsc.edu/cgi-bin/hgTracks?db=hg19&position=",
                    chrom, ":", zoomStart, "-", zoomEnd)),
              showSelected=c("dotID", "chrom"),
              size=11,
              data=PredictedPeaks$chromCounts)+
    scale_y_discrete("cell type", drop=FALSE),
  chroms=ggplot()+
    theme_bw()+
    theme_animint(width=1500, height=330)+
    scale_y_discrete("chromosome", drop=FALSE)+ 
    scale_x_continuous("position on chromosome (mega bases)")+
    geom_text(aes(0, chrom, label=paste0(peaks, "_")),
              clickSelects="chrom",
              showSelected="dotID",
              hjust=1,
              size=11,
              data=PredictedPeaks$countsByChrom)+
    geom_segment(aes(chromStart/1e6, chrom,
                     xend=chromEnd/1e6, yend=chrom),
                 clickSelects="chrom",
                 size=9,
                 data=PredictedPeaks$chrom.ranges)+
    geom_point(aes(chromEnd/1e6, chrom,
                   id=chrom),
               clickSelects="chrom",
               size=5,
               data=PredictedPeaks$chrom.ranges)+
    geom_text(aes(max(PredictedPeaks$chrom.ranges$chromEnd)/2e6, chrom,
                  label=totals),
              showSelected="dotID",
              data=PredictedPeaks$scatter.text),
  scatter=ggplot()+
    geom_hline(aes(yintercept=N),
               color="grey",
               data=PredictedPeaks$counts.Input)+
    scale_x_continuous("number of samples with a peak")+
    facet_grid(nonInputType ~ .)+
    theme_bw()+
    scale_fill_gradient(low="grey", high="red")+
    theme_animint(width=1500)+
    theme(panel.margin=grid::unit(0, "cm"))+
    geom_vline(aes(xintercept=N),
               color="grey",
               data=PredictedPeaks$counts.not.Input)+
    geom_rect(aes(xmin=up-size, xmax=up+size,
                  ymin=Input-size, ymax=Input+size,
                  tooltip=totals,
                  fill=log10(count)),
              clickSelects="dotID",
              showSelected="chrom",
              color="transparent",
              data=PredictedPeaks$bg.rect),
  first=list(dotID="38 neutro samples, 1 Input samples", chrom="chr16"))

info <- animint2HTML(viz)

## Simulate mouseover using javascript?

## myScript <- 'myObj = document.getElementById("chrM");
## myArray = [];
## for(var b in myObj) { 
##   myArray.push(b);
## }
## return myArray;'
## remDr$executeScript(myScript)
## remDr$executeScript('return document.getElementById("chrM").onmouseover();')

## Simulate mouseover using RSelenium?

## e <- remDr$findElement("id", "chrM")
## remDr$mouseMoveToLocation(webElement=e)

## e <- remDr$findElement("id", "chrY")
## remDr$mouseMoveToLocation(webElement=e)

## getStyleValue(getHTML(), '//g[@class="geom4_point_chroms"]//circle', "opacity")

## getNodeSet(getHTML(), '//g[@class="geom4_point_chroms"]//circle')

test_that("without selectize option, only render chrom widget", {
  widget.vec <- getSelectorWidgets(info$html)
  expect_identical(widget.vec, "chrom")
})

getSorted <- function(){
  text.list <- getNodeSet(getHTML(), '//g[@class="geom1_text_oneChrom"]//text')
  value.vec <- sapply(text.list, xmlValue)
  sort(as.numeric(value.vec))
}

test_that("initially 2 text elements rendered", {
  num.vec <- getSorted()
  expect_equal(num.vec, c(1, 38))
})

clickID("chrM")
Sys.sleep(1)

exp.vec <- c(1, 14, 38)

test_that("3 elements rendered (first time)", {
  num.vec <- getSorted()
  expect_equal(num.vec, exp.vec)
})

clickID("chrY")
Sys.sleep(1)

clickID("chrM")
Sys.sleep(1)

test_that("3 elements rendered (second time)", {
  num.vec <- getSorted()
  expect_equal(num.vec, exp.vec)
})

thresh.df <- data.frame(max.input.samples=9, thresh.type="specific")
PredictedPeaks$counts.not.Input$thresh.type <- "max samples"
PredictedPeaks$counts.Input$thresh.type <- "max samples"

viz <- list(
  oneChrom=ggplot()+
    ggtitle("PeakSegJoint detections on selected chromosome")+
    theme_bw()+
    coord_cartesian(xlim=c(0, 1))+
    theme_animint(width=1500, height=100)+
    theme(axis.line.x=element_blank(), axis.text.x=element_blank(), 
          axis.ticks.x=element_blank(), axis.title.x=element_blank())+
    geom_text(aes(relative.middle, type.fac, label=samples.up),
              showSelected=c("dotID", "chrom"),
              clickSelects="peak.name",
              size=11,
              data=PredictedPeaks$chromCounts)+
    scale_y_discrete("cell type", drop=FALSE),
  chroms=ggplot()+
    theme_bw()+
    theme_animint(width=1500, height=330)+
    scale_y_discrete("chromosome", drop=FALSE)+ 
    scale_x_continuous("position on chromosome (mega bases)")+
    geom_text(aes(0, chrom, label=paste0(peaks, "_")),
              clickSelects="chrom",
              showSelected="dotID",
              hjust=1,
              size=11,
              data=PredictedPeaks$countsByChrom)+
    geom_segment(aes(chromStart/1e6, chrom,
                     xend=chromEnd/1e6, yend=chrom),
                 clickSelects="chrom",
                 size=9,
                 data=PredictedPeaks$chrom.ranges)+
    geom_point(aes(chromEnd/1e6, chrom),
               id="chrom",
               clickSelects="chrom",
               size=5,
               data=PredictedPeaks$chrom.ranges)+
    geom_text(aes(max(PredictedPeaks$chrom.ranges$chromEnd)/2e6, chrom,
                  label=totals),
              showSelected="dotID",
             data=PredictedPeaks$scatter.text),
  scatter=ggplot()+
    geom_vline(aes(xintercept=N, color=thresh.type),
               data=PredictedPeaks$counts.not.Input)+
    scale_color_manual("threshold", values=c(
                                      "max samples"="grey",
                                      specific="grey30"))+
    geom_hline(aes(yintercept=max.input.samples+0.5, color=thresh.type),
               show.legend=TRUE,
               data=thresh.df)+
    geom_hline(aes(yintercept=N, color=thresh.type),
               show.legend=TRUE,
               data=PredictedPeaks$counts.Input)+
    scale_x_continuous("number of samples with a peak")+
    facet_grid(nonInputType ~ .)+
    theme_bw()+
    scale_fill_gradient(low="grey", high="red")+
    theme_animint(width=1500)+
    theme(panel.margin=grid::unit(0, "cm"))+
    geom_rect(aes(xmin=up-size, xmax=up+size,
                  ymin=Input-size, ymax=Input+size,
                  tooltip=totals,
                  fill=log10(count)),
              clickSelects="dotID",
              showSelected="chrom",
              color="transparent",
              data=PredictedPeaks$bg.rect)+
   geom_point(aes(up, Input),
              showSelected="peak.name",
              data=hover.dots),
  selectize=list(dotID=TRUE, chrom=FALSE),
  first=list(dotID="38 neutro samples, 1 Input samples", chrom="chr16"))

## TODO:href + hoverselects!

info <- animint2HTML(viz)

test_that("selectize option respected", {
  widget.vec <- getSelectorWidgets(info$html)
  expected.widgets <- c("dotID", "thresh.type")
  expect_identical(sort(widget.vec), sort(expected.widgets))
})

test_that("rects rendered in fill legend", {
  rect.list <- getNodeSet(
    info$html, '//tr[@class="log10(count)_variable"]//rect')
  expect_equal(length(rect.list), 5)
})

test_that("no lines rendered in fill legend", {
  line.list <- getNodeSet(
    info$html, '//tr[@class="log10(count)_variable"]//line')
  expect_equal(length(line.list), 0)
})

test_that("lines in color legend", {
  line.list <- getNodeSet(
    info$html, '//tr[@class="thresh_type_variable"]//line')
  expect_equal(length(line.list), 2)
})

specific_hlines <- function(html=getHTML()){
  getNodeSet(html, '//g[@class="geom7_hline_scatter"]//line')
}

specific.id <- "plot_scatter_thresh_type_variable_specific"
xpath <- sprintf('//td[@id="%s_label"]', specific.id)
specific_opacity <- function(html=getHTML()){
  as.numeric(getStyleValue(html, xpath, "opacity"))
}

test_that("initially rendered hlines", {
  line.list <- specific_hlines(info$html)
  expect_equal(length(line.list), 2)
  computed.opacity <- specific_opacity(info$html)
  expect_equal(computed.opacity, 1)
})

test_that("hlines after clicking specific", {
  clickID(specific.id)
  html <- getHTML()
  line.list <- specific_hlines(html)
  expect_equal(length(line.list), 0)
  computed.opacity <- specific_opacity(html)
  expect_equal(computed.opacity, 0.5)
})

test_that("hlines after clicking specific again", {
  clickID(specific.id)
  html <- getHTML()
  line.list <- specific_hlines(html)
  expect_equal(length(line.list), 2)
  computed.opacity <- specific_opacity(html)
  expect_equal(computed.opacity, 1)
})

## e <- remDr$findElement("class name", "show_hide_selector_widgets")
## e$clickElement()

## remDr$findElements("class name", "selectize-input")

## It takes a long time to render the selectize widget with many
## levels, why?