inst/unitTests/test_igvR.R

# test_igvR.R
#------------------------------------------------------------------------------------------------------------------------
library(RUnit)
library(igvR)
library(GenomicRanges)
library(VariantAnnotation)
#------------------------------------------------------------------------------------------------------------------------
printf <- function (...) print(noquote(sprintf(...)))
#------------------------------------------------------------------------------------------------------------------------
interactive <- function() TRUE;
#------------------------------------------------------------------------------------------------------------------------
if(BrowserViz::webBrowserAvailableForTesting()){
   if(!exists("igv")){
      igv <- igvR(quiet=TRUE) # portRange=9000:9020)
      setBrowserWindowTitle(igv, "igvR unit tests")
      checkTrue(all(c("igvR", "BrowserViz") %in% is(igv)))
      } # exists
   } # interactive
#------------------------------------------------------------------------------------------------------------------------
runTests <- function()
{
   test_getSupportedGenomes()
   test_setGenome()

   setGenome(igv, "hg38")
   test_quick()
   test_getShowGenomicRegion()
   test_displaySimpleBedTrackDirect()
   test_displayDataFrameQuantitativeTrack()
   test_displayDataFrameQuantitativeTrack_autoAndExplicitScale()
   test_removeTracksByName()
   test_displayAlignment()
   test_saveToSVG()
   test_.writeMotifLogoImagesUpdateTrackNames()

   setGenome(igv, "hg19")
   test_displayVcfObject()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   test_displayVcfUrl()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   test_displayDataFrameAnnotationTrack()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   test_displayUCSCBedAnnotationTrack()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   test_displayGRangesAnnotationTrack()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   test_displayUCSCBedGraphQuantitativeTrack()

   removeTracksByName(igv, getTrackNames(igv)[-1])
   setGenome(igv, "hg38")
   test_displayBedpeInteractions()


} # runTests
#------------------------------------------------------------------------------------------------------------------------
test_ping <- function()
{
   message(sprintf("--- test_ping"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))
      checkEquals(ping(igv), "pong")
      }

} # test_ping
#------------------------------------------------------------------------------------------------------------------------
test_getSupportedGenomes <- function()
{
   message(sprintf("--- test_getSupportedGenomes"))
   expected <- c("hg38", "hg19", "hg18", "mm10", "gorgor4", "pantro4", "panpan2", "susscr11", "bostau8", "canfam3",
                 "rn6", "danrer11", "danrer10", "dm6", "ce11", "saccer3",
                 "tair10", "pfal3d7")  # these last two are hosted on trena, aka igv-data.systemsbiology.net
   checkTrue(all(expected %in% getSupportedGenomes(igv)))

} # test_getSupportedGenomes
#------------------------------------------------------------------------------------------------------------------------
test_quick <- function()
{
   message(sprintf("--- test_quick"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))
      checkTrue(ready(igv))
      showGenomicRegion(igv, "trem2")
      x <- getGenomicRegion(igv)
      checkEquals(x, list(chrom="chr6", start=41157506, end=41164186, string="chr6:41,157,506-41,164,186"))
      Sys.sleep(1)
      }

} # test_ping
#------------------------------------------------------------------------------------------------------------------------
test_setGenome <- function()
{
   message(sprintf("--- test_setGenome"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))

      message(sprintf("---- hg38"))
      setGenome(igv, "hg38")
      roi <- "chr1:153,588,447-153,707,067"
      showGenomicRegion(igv, roi)
      Sys.sleep(2)
      roi.from.browser <- getGenomicRegion(igv)
      checkEquals(roi, roi.from.browser$string)

      message(sprintf("---- hg19"))
      setGenome(igv, "hg19")
      showGenomicRegion(igv, "mef2c")
      Sys.sleep(2)

      message(sprintf("---- mm10"))
      setGenome(igv, "mm10")
      roi <- "chr1:40,184,529-40,508,207"
      showGenomicRegion(igv, roi)
      Sys.sleep(2)
      roi.from.browser <- getGenomicRegion(igv)$string
      checkTrue(roi.from.browser == roi)

      message(sprintf("---- tair10"))
      setGenome(igv, "tair10")  #
      roi <- "1:15,094,978-15,332,693"
      showGenomicRegion(igv, roi)
      roi.from.browser <- getGenomicRegion(igv)$string
      checkTrue(roi.from.browser == roi)
      Sys.sleep(2)

      message(sprintf("---- sacCer3"))
      setGenome(igv, "sacCer3")  #
      roi <- "chrV:327,611-331,072"
      showGenomicRegion(igv, roi)
      Sys.sleep(2)
      roi.from.browser <- getGenomicRegion(igv)$string
      checkTrue(roi == roi)

      message(sprintf("---- Pfal3D7"))
      setGenome(igv, "Pfal3D7")  #
      ama1.gene.region <- "Pf3D7_11_v3:1,292,709-1,296,446"
      showGenomicRegion(igv, ama1.gene.region)
      Sys.sleep(2)
      roi <- getGenomicRegion(igv)$string
      checkTrue(roi == ama1.gene.region)


      for(genome in getSupportedGenomes(igv)){
         setGenome(igv, genome);
         Sys.sleep(2)
         }

      } # if webBrowserAvailableForTesting

} # test_setGenome
#------------------------------------------------------------------------------------------------------------------------
test_getShowGenomicRegion <- function()
{
   message(sprintf("--- test_getShowGenomicRegion"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))

      showGenomicRegion(igv, "chr1")
      x <- getGenomicRegion(igv)
      checkTrue(all(c("chrom", "start", "end", "string") %in% names(x)))
      checkEquals(x$chrom, "chr1")
      checkEquals(x$start, 1)
      checkTrue(x$end > 248956420 & x$end < 248956425)  # not sure why, but sometimes varies by 1 base
      checkTrue(grepl("chr1:1-248,956,42", x$string))   # leave off the last digit in the chromLoc string

        #--------------------------------------------------
        # send a list argument first
        #--------------------------------------------------

      new.region.list <- list(chrom="chr5", start=88866900, end=88895833)
      new.region.string <- with(new.region.list, sprintf("%s:%d-%d", chrom, start, end))

      showGenomicRegion(igv, new.region.list)
      x <- getGenomicRegion(igv)
      checkTrue(all(c("chrom", "start", "end", "string") %in% names(x)))
      checkEquals(x$chrom, "chr5")
      checkEquals(x$start, 88866900)
      checkEquals(x$end, 88895833)
      checkEquals(x$string, "chr5:88,866,900-88,895,833")
      Sys.sleep(3)

         # reset the location
      showGenomicRegion(igv, "MYC")
      x <- getGenomicRegion(igv)
      checkEquals(x$chrom, "chr8")
      Sys.sleep(3)

         # send the string, repeat the above tests
      new.loc <- "chr5:88,659,708-88,737,464"
      showGenomicRegion(igv, new.loc)
      x <- getGenomicRegion(igv)
      checkTrue(all(c("chrom", "start", "end", "string") %in% names(x)))
      checkEquals(x$chrom, "chr5")
      checkEquals(x$start, 88659708)
      checkEquals(x$end,   88737464)
      checkEquals(x$string, new.loc)
      } # if interactive

} # test_getShowGenomicRegion
#------------------------------------------------------------------------------------------------------------------------
test_displaySimpleBedTrackDirect <- function()
{
   message(sprintf("--- test_displaySimpleBedTrackDirect"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))
      new.region <- "chr5:88,882,214-88,884,364"
      showGenomicRegion(igv, new.region)

      base.loc <- 88883100
      tbl.01 <- data.frame(chrom=rep("chr5", 3),
                           start=c(base.loc, base.loc+100, base.loc + 250),
                           end=c(base.loc + 50, base.loc+120, base.loc+290),
                           name=c("A", "B", "C"),
                           score=round(runif(3), 2),
                           strand=rep("*", 3),
                           stringsAsFactors=FALSE)
      trackName.01 <- "dataframeTest.01"
      track.01 <- DataFrameAnnotationTrack(trackName.01, tbl.01, color="darkGreen", displayMode="EXPANDED")

      tbl.02 <- tbl.01
      tbl.02$start <- tbl.02$start + 100
      tbl.02$end   <- tbl.02$end + 100
      tbl.02$name <- c("D", "E", "F")
      trackName.02 <- "dataframeTest.02"
      track.02 <- DataFrameAnnotationTrack(trackName.02, tbl.02, color="brown", displayMode="EXPANDED")

      displayTrack(igv, track.01)
      displayTrack(igv, track.02)
      # trackNames <- getTrackNames(igv)
      # message(sprintf("trackNames: %s", paste(trackNames, collapse=",")))
      # checkTrue(trackName.01 %in% trackNames)
      # checkTrue(trackName.02 %in% trackNames)
      # Sys.sleep(3)
      } # if interactive

} # test_displaySimpleBedTrackDirect
#------------------------------------------------------------------------------------------------------------------------
# in contrast to test_displayVcfUrl
test_displayVcfObject <- function()
{
   message(sprintf("--- test_displayVcfObject"))
   if(BrowserViz::webBrowserAvailableForTesting()){
      f <- system.file("extdata", "chr22.vcf.gz", package="VariantAnnotation")
      file.exists(f) # [1] TRUE
      vcf <- readVcf(f, "hg19")
         # get oriented around the contents of this vcf
      start <- 50586118
      end   <- 50633733
      rng <- GRanges(seqnames="22", ranges=IRanges(start=start, end=end))
         # names=c("gene_79087", "gene_644186")))
      vcf.sub <- readVcf(f, "hg19", param=rng)
      track <- VariantTrack("chr22-tiny", vcf.sub)
      showGenomicRegion(igv, sprintf("chr22:%d-%d", start-1000, end+1000))
      displayTrack(igv, track)
      Sys.sleep(3)
      #trackNames <- getTrackNames(igv)
      #printf("trackNames: %s", paste(trackNames, collapse=","))
      #checkTrue("chr22-tiny" %in% trackNames)
      } # if interactive

} # test_displayVcfObject
#------------------------------------------------------------------------------------------------------------------------
test_displayVcfUrl <- function()
{
   message(sprintf("--- test_displayVcfUrl"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      data.url <- "https://igv-data.systemsbiology.net/static/ampad/SCH_11923_B01_GRM_WGS_2017-04-27_10.recalibrated_variants.vcf.gz"
      index.url <- sprintf("%s.tbi", data.url)
      url <- list(data=data.url, index=index.url)
      showGenomicRegion(igv, "chr10:59,950,001-59,952,018")
      track <- VariantTrack("AMPAD chr10", url, displayMode="SQUISHED")
      displayTrack(igv, track)

        # change the colors, squish the display
      track.colored <- VariantTrack("AMPAD chr10 colors", url, displayMode="EXPANDED",
                                    anchorColor="purple",
                                    homvarColor="brown",
                                    hetvarColor="green",
                                    homrefColor="yellow")

      displayTrack(igv, track.colored)
      #checkEquals(length(getTrackNames(igv)), 3)
      } # if interactive

} # test_displayVcfUrl
#------------------------------------------------------------------------------------------------------------------------
# first use a rich, 5-row, 12-column bed file conveniently provided by rtracklayer
# this has all the structure described here: https://genome.ucsc.edu/FAQ/FAQformat.html#format1
test_displayDataFrameAnnotationTrack <- function()
{
   message(sprintf("--- test_displayDataFrameAnnotationTrack"))

   if(BrowserViz::webBrowserAvailableForTesting()){
         # first, the full 12-column form
      bed.filepath <- system.file(package = "rtracklayer", "tests", "test.bed")
      checkTrue(file.exists(bed.filepath))
      tbl.bed <- read.table(bed.filepath, sep="\t", as.is=TRUE, skip=2)
      colnames(tbl.bed) <- c("chrom", "chromStart", "chromEnd", "name", "score", "strand",
                             "thickStart", "thickEnd", "itemRgb", "blockCount", "blockSizes", "blockStarts")

      track.df <- DataFrameAnnotationTrack("bed.12col", tbl.bed)

      showGenomicRegion(igv, "chr7:127470000-127475900")
      displayTrack(igv, track.df)

      Sys.sleep(3)   # provide a chance to see the chr7 region before moving on to the chr9
      showGenomicRegion(igv, "chr9:127474000-127478000")
      Sys.sleep(3)   # provide a chance to see the chr9 region before moving on

         # now a simple 3-column barebones data.frame, in the same two regions as above

      chroms <- rep("chr7", 3)
      starts <- c(127471000, 127472000, 127473000)
      ends   <- starts + as.integer(100 * runif(3))
      tbl.chr7 <- data.frame(chrom=chroms, start=starts, end=ends, stringsAsFactors=FALSE)

      chroms <- rep("chr9", 30)
      starts <- seq(from=127475000, to=127476000, length.out=30)
      ends   <- starts + as.integer(100 * runif(30))
      tbl.chr9 <- data.frame(chrom=chroms, start=starts, end=ends, stringsAsFactors=FALSE)
      tbl.bed3 <- rbind(tbl.chr7, tbl.chr9)
      track.df2 <- DataFrameAnnotationTrack("bed.3col", tbl.bed3, color="green", displayMode="EXPANDED")

      showGenomicRegion(igv, "chr7:127470000-127475900")
      displayTrack(igv, track.df2)
      Sys.sleep(3)   # provide a chance to see the chr9 region before moving on

      showGenomicRegion(igv, "chr9:127474000-127478000")
      Sys.sleep(3)   # provide a chance to see the chr9 region before moving on
      return(TRUE)
      } # if interactive

} # test_displayDataFrameAnnotationTrack
#------------------------------------------------------------------------------------------------------------------------
test_displayUCSCBedAnnotationTrack <- function()
{
   message(sprintf("--- test_displayUCSCBedAnnotationTrack"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      bed.filepath <- system.file(package = "rtracklayer", "tests", "test.bed")
      checkTrue(file.exists(bed.filepath))
      gr.bed <- import(bed.filepath)
      checkTrue(all(c("UCSCData", "GRanges") %in% is(gr.bed)))
      track.ucscBed <- UCSCBedAnnotationTrack("UCSCBed", gr.bed)
      displayTrack(igv, track.ucscBed)
      service(3000)
      showGenomicRegion(igv, "chr7:127470000-127475900")
      service(5000)
      showGenomicRegion(igv, "chr9:127474000-127478000")
      service(5000)
      return(TRUE)
      } # if interactive

} # test_displayUCSCBedAnnotationTrack
#------------------------------------------------------------------------------------------------------------------------
test_displayGRangesAnnotationTrack <- function()
{
   message(sprintf("--- test_displayGRangesAnnotationTrack"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      bed.filepath <- system.file(package = "rtracklayer", "tests", "test.bed")
      checkTrue(file.exists(bed.filepath))
      tbl.bed <- read.table(bed.filepath, sep="\t", as.is=TRUE, skip=2)
      colnames(tbl.bed) <- c("chrom", "chromStart", "chromEnd", "name", "score", "strand",
                             "thickStart", "thickEnd", "itemRgb", "blockCount", "blockSizes", "blockStarts")

      gr.simple <- GRanges(tbl.bed[, c("chrom", "chromStart", "chromEnd", "name")])
      track.gr.1 <- GRangesAnnotationTrack("generic GRanges", gr.simple)
      checkTrue(all(c("GRangesAnnotationTrack", "igvAnnotationTrack", "Track") %in% is(track.gr.1)))
      checkEquals(trackSize(track.gr.1), 5)

      showGenomicRegion(igv, "chr7:127470000-127475900")
      displayTrack(igv, track.gr.1)
      Sys.sleep(1)

      gr.simpler <- GRanges(tbl.bed[, c("chrom", "chromStart", "chromEnd")])
      track.gr.2 <- GRangesAnnotationTrack("no-name GRanges", gr.simpler, color="orange")
      checkTrue(all(c("GRangesAnnotationTrack", "igvAnnotationTrack", "Track") %in% is(track.gr.2)))
      checkEquals(trackSize(track.gr.2), 5)
      showGenomicRegion(igv, "chr7:127470000-127475900")
      displayTrack(igv, track.gr.2)

      Sys.sleep(3)   # provide a chance to see the chr9 region before moving on

      showGenomicRegion(igv, "chr9:127474000-127478000")
      Sys.sleep(3)   # provide a chance to see the chr9 region before moving on

      return(TRUE)
      } # if interactive

} # test_displayGRangesAnnotationTrack
#------------------------------------------------------------------------------------------------------------------------
test_displayDataFrameQuantitativeTrack <- function()
{
   message(sprintf("--- test_displayDataFrameQuantitativeTrack"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      base.start <- 58982201
      starts <- c(base.start, base.start+50, base.start+800)
      ends <- starts + c(40, 10, 80)
      tbl.bg <- data.frame(chrom=rep("chr18", 3),
                           start=starts,
                           end=ends,
                           value=c(0.5, -10.2, 20),
                           stringsAsFactors=FALSE)

         # both of these colnames work equally well.

      track.bg0 <- DataFrameQuantitativeTrack("bedGraph data.frame", tbl.bg, autoscale=FALSE,
                                              min=min(tbl.bg$value), max=max(tbl.bg$value),
                                              trackHeight=200, color="darkgreen")
      shoulder <- 1000
      showGenomicRegion(igv, sprintf("chr18:%d-%d", min(tbl.bg$start) - shoulder, max(tbl.bg$end) + shoulder))
      displayTrack(igv, track.bg0)
      #Sys.sleep(5)
      } # if interactive

} # test_displayDataFrameQuantitativeTrack
#------------------------------------------------------------------------------------------------------------------------
test_displayDataFrameQuantitativeTrack_autoAndExplicitScale <- function()
{
   message(sprintf("--- test_displayDataFrameQuantitativeTrack_autoAndExplicitScale"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      tbl <- data.frame(chr=rep("chr2", 3),
                        start=c(16102928, 16101906, 16102475),
                        end=  c(16102941, 16101917, 16102484),
                        value=c(2, 5, 19),
                        stringsAsFactors=FALSE)

      showGenomicRegion(igv, sprintf("chr2:%d-%d", min(tbl$start)-50, max(tbl$end)+50))
      track <- DataFrameQuantitativeTrack("autoScale", tbl, autoscale=TRUE, trackHeight=100)
      displayTrack(igv, track)
      Sys.sleep(3)
      track <- DataFrameQuantitativeTrack("specifiedScale", tbl, color="purple", trackHeight=100,
                                          autoscale=FALSE, min=1, max=30)
      displayTrack(igv, track)
      Sys.sleep(3)
      } # if interactive

} # test_displayDataFrameQuantitativeTrack_autoAndExplicitScale
#------------------------------------------------------------------------------------------------------------------------
test_displayUCSCBedGraphQuantitativeTrack <- function()
{
   message(sprintf("--- test_displayUCSCBedGraphQuantitativeTrack"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      bedGraph.filepath <- system.file(package = "rtracklayer", "tests", "test.bedGraph")
      checkTrue(file.exists(bedGraph.filepath))

      gr.bed <- import(bedGraph.filepath)
      checkTrue("UCSCData" %in% is(gr.bed))   # UCSC BED format
      track.bg1 <- UCSCBedGraphQuantitativeTrack("rtracklayer bedGraph obj", gr.bed,  color="blue")

      displayTrack(igv, track.bg1)

         # now look at all three regions contained in the bedGraph data
      showGenomicRegion(igv, "chr19:59100000-59105000");  Sys.sleep(3)
      showGenomicRegion(igv, "chr18:59100000-59110000");  Sys.sleep(3)
      showGenomicRegion(igv, "chr17:59100000-59109000");  Sys.sleep(3)
      Sys.sleep(1)

      } # if interactive

} # test_displayUCSCBedGraphQuantitativeTrack
#------------------------------------------------------------------------------------------------------------------------
# TODO (31 mar 2019): temporarily disabled.  some latency problem with latest igv.js?
test_removeTracksByName <- function()
{
   message(sprintf("--- test_removeTracksByName"))
   new.region <- "chr5:88,882,214-88,884,364"
   showGenomicRegion(igv, new.region)

   track.name <- "dataframeTest"

   base.loc <- 88883100
   tbl <- data.frame(chrom=rep("chr5", 3),
                     start=c(base.loc, base.loc+100, base.loc + 250),
                     end=c(base.loc + 50, base.loc+120, base.loc+290),
                     name=c("a", "b", "c"),
                     score=runif(3),
                     strand=rep("*", 3),
                     stringsAsFactors=FALSE)

   track <- DataFrameAnnotationTrack(track.name, tbl, color="darkGreen")
   displayTrack(igv, track)

   #later(function() {
   #  trackNames <- getTrackNames(igv)
   #  checkTrue(track.name %in% trackNames)
     removeTracksByName(igv, track.name)
   #  checkTrue(!track.name %in% getTrackNames(igv))
   #  }, 0.5)
   Sys.sleep(3)

} # test_removeTracksByName
#------------------------------------------------------------------------------------------------------------------------
test_displayAlignment <- function()
{
   message(sprintf("--- test_displayAlignment"))

   bamFile <- system.file(package="igvR", "extdata", "tumor.bam")
   checkTrue(file.exists(bamFile))

   little.region <- GRanges(seqnames = "21", ranges = IRanges(10399760, 10401370))
   little.region <- GRanges(seqnames="21", ranges=IRanges(10400126, 10400326))
   showGenomicRegion(igv, "chr21:10,399,427-10,405,537")

   param <- ScanBamParam(which=little.region, what=scanBamWhat())
   x <- readGAlignments(bamFile, use.names=TRUE, param=param)
   #x <- readGAlignments(bamFile, use.names=TRUE)
   track <- GenomicAlignmentTrack("bam demo", x, visibilityWindow=2000000, trackHeight=500)  # 30000 default
   displayTrack(igv, track)
   print(getGenomicRegion(igv))

   loc <- "may not work immediately due to latency/concurrency complexities, especially acute with bam tracks"

} # test_displayAlignment
#------------------------------------------------------------------------------------------------------------------------
test_displayBedpeInteractions <- function()
{
   message(sprintf("--- test_displayBedpeInteractions"))

   setGenome(igv, "hg38")
   file.1 <- system.file(package="igvR", "extdata", "sixColumn-demo1.bedpe")
   checkTrue(file.exists(file.1))
   tbl.1 <- read.table(file.1, sep="\t", as.is=TRUE, header=TRUE)
   checkEquals(dim(tbl.1), c(32, 6))
   track <- BedpeInteractionsTrack("bedpe-6", tbl.1, color="red")

   shoulder <- 10000
   with(tbl.1, showGenomicRegion(igv, sprintf("%s:%d-%d", chrom1[1],
                                              min(start1)-shoulder, max(end2) + shoulder)))
   displayTrack(igv, track)

} # test_displayBedpeInteractions
#------------------------------------------------------------------------------------------------------------------------
test_saveToSVG <- function()
{
   message(sprintf("--- test_saveToSVG"))
   showGenomicRegion(igv, "GATA2")
   filename <- tempfile(fileext=".svg")
   saveToSVG(igv, filename)

   message(sprintf("file exists? %s", file.exists(filename)))
   message(sprintf("file size:   %d", file.size(filename)))
   checkTrue(file.exists(filename))
   checkTrue(file.size(filename) > 0)   # may still be being written

} # test_saveToSVG
#------------------------------------------------------------------------------------------------------------------------
# read a small slice of a small bigWig file, demonstrating display of a bigwig track
test_mouseBigWigFile <- function()
{
   setGenome(igv, "mm10")
   showGenomicRegion(igv, "TREM2")
   region <- getGenomicRegion(igv)
   shoulder <- 10000

   with(region, showGenomicRegion(igv, sprintf("%s:%d-%d", chrom, start-shoulder, end+shoulder)))
   gr.region <- with(x, GRanges(seqnames=chrom, ranges=IRanges(start-shoulder, end+shoulder)))
   bw.file <- system.file(package="igvR", "extdata", "mm10-sample.bw")
   gr.atac <- import(bw.file, which=gr.region)
   gr.atac  # 458 ranges

   track <- GRangesQuantitativeTrack("microglial ATAC-seq", gr.atac, autoscale=TRUE)
   displayTrack(igv, track)

} # test_mouseBigWigFile
#------------------------------------------------------------------------------------------------------------------------
test_.writeMotifLogoImagesUpdateTrackNames <- function()
{
   message(sprintf("--- test_.writeMotifLogoImagesUpdateTrackNames"))
   tbl <- get(load(system.file(package="igvR", "extdata", "tbl.with.MotifDbNames.Rdata")))
   checkEquals(tbl$name,
               c("MotifDb::Hsapiens-HOCOMOCOv10-MEF2C_HUMAN.H10MO.C",
                 "MA0803.1",
                 "MotifDb::Hsapiens-jaspar2018-MEF2C-MA0497.1"))

   tbl.fixed <- igvR:::.writeMotifLogoImagesUpdateTrackNames(tbl, igvApp.uri="http://localhost:15000")
   checkEquals(dim(tbl), dim(tbl.fixed))
   checkEquals(tbl[, -4], tbl.fixed[, -4])
   checkEquals(tbl.fixed$name[2], "MA0803.1")
   checkEquals(grep("http://localhost:15000?/", tbl.fixed$name, fixed=TRUE), c(1, 3))

} # test_.writeMotifLogoImagesUpdateTrackNames
#------------------------------------------------------------------------------------------------------------------------
explore_blockingTrackLoad <- function()
{
   print(0)
   setGenome(igv, "hg19")
   print(1)
   bamFile <- "~/github/igvR/vignettes/macs2/GSM749704_hg19_wgEncodeUwTfbsGm12878CtcfStdAlnRep1.bam"
   print(2)
   checkTrue(file.exists(bamFile))
   print(3)
   big.region <- GRanges(seqnames = "chr19", ranges = IRanges(10000000,
                                                              10900000))
   print(4)

   param <- ScanBamParam(which=big.region, what=scanBamWhat())
   print(5)

   x <- readGAlignments(bamFile, use.names=TRUE, param=param)
   print(6)
   region.start <- start(range(ranges(x)))
   print(7)
   region.end   <- end(range(ranges(x)))
   print(8)

   showGenomicRegion(igv, sprintf("chr19:%d-%d", region.start, region.end))
   print(9)

   width <- round(width(range(ranges(x))) * 1.1)
   print(10)
   track <- GenomicAlignmentTrack("bam demo", x, visibilityWindow=width, trackHeight=500)  # 30000 default
   print(11)
   displayTrack(igv, track)
   print(12)
   print(getGenomicRegion(igv))
   print(13)
   browser()
   xyz <- 99
   print(14)

   #loc <- "may not work immediately due to latency/concurrency complexities, especially acute with bam tracks"

   #while(is.character(loc)){
   #   loc <- getGenomicRegion(igv)
   #   }

   #broad.loc <- with(loc, sprintf("%s:%d-%d", chrom, start-45000, end+45000))
   #showGenomicRegion(igv, broad.loc)

} # explore_blockingTrackLoad
#------------------------------------------------------------------------------------------------------------------------
demo_addTrackClickFunction_proofOfConcept <- function()
{
   message(sprintf("--- demo_addTrackClickFunction_proofOfConcept"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))
      setGenome(igv, "hg38")
      new.region <- "chr5:88,882,214-88,884,364"
      showGenomicRegion(igv, new.region)

      base.loc <- 88883100
      tbl <- data.frame(chrom=rep("chr5", 3),
                        start=c(base.loc, base.loc+100, base.loc + 250),
                        end=c(base.loc + 50, base.loc+120, base.loc+290),
                        name=c("A", "B", "C"),
                        score=round(runif(3), 2),
                        strand=rep("*", 3),
                        stringsAsFactors=FALSE)

      track <- DataFrameAnnotationTrack("dataframeTest", tbl, color="darkGreen", displayMode="EXPANDED")
      displayTrack(igv, track)
      Sys.sleep(1)
      x <- list(arguments="track, popoverData", body="{console.log('track click 99')}")
      setTrackClickFunction(igv, x)

   } # if interactive

} # demo_displaySimpleBedTrackDirect_proofOfConcept
#------------------------------------------------------------------------------------------------------------------------
# displays a motif logo
demo_addTrackClickFunction_displayMotifLogo <- function()
{
   message(sprintf("--- demo_addTrackClickFunction_displayMotifLogo"))

   if(BrowserViz::webBrowserAvailableForTesting()){
      checkTrue(ready(igv))
      setGenome(igv, "hg38")
         # enableMotifLogoPopups(igv, TRUE)  # no longer necesssary: always on
      new.region <- "chr5:88,882,214-88,884,364"
      showGenomicRegion(igv, new.region)
      base.loc <- 88883100
      element.names <- c("MotifDb::Hsapiens-HOCOMOCOv10-MEF2C_HUMAN.H10MO.C",
                         "MA0803.1",
                         "MotifDb::Hsapiens-jaspar2018-MEF2C-MA0497.1")
      tbl <- data.frame(chrom=rep("chr5", 3),
                        start=c(base.loc, base.loc+100, base.loc + 250),
                        end=c(base.loc + 50, base.loc+120, base.loc+290),
                        name=element.names,
                        stringsAsFactors=FALSE)
      track <- DataFrameAnnotationTrack("dataframeTest", tbl, color="darkGreen", displayMode="EXPANDED")
      displayTrack(igv, track)
      } # if webBrowserAvailableForTesting

} # demo_displaySimpleBedTrackDirect_displayMotifLogo
#------------------------------------------------------------------------------------------------------------------------
if(BrowserViz::webBrowserAvailableForTesting())
   runTests()

Try the igvR package in your browser

Any scripts or data that you put into this service are public.

igvR documentation built on Nov. 8, 2020, 7:14 p.m.