tests/testthat/test1.R

In seqplots: An interactive tool for visualizing NGS signals and sequence motif densities along genomic features using average plots and heatmaps

bw1 <- system.file("extdata", "GSM1208360_chrI_100Kb_q5_sample.bw", package="seqplots")
bed1 <- system.file("extdata", "Transcripts_ce10_chrI_100Kb.bed", package="seqplots")
bed2 <- system.file("extdata", "GSM1208361_chrI_100Kb_PeakCalls.bed", package="seqplots")

test_that("Test BSgenome package installation", {
    context("Testing BSgenome package installation")    
    if(!"BSgenome.Celegans.UCSC.ce10" %in% BSgenome::installed.genomes()) {
        if(.Platform$OS.type != "windows" || .Machine$sizeof.pointer != 4) {
            if (!requireNamespace("BiocManager", quietly=TRUE))
                install.packages("BiocManager")
            BiocManager::install("BSgenome.Celegans.UCSC.ce10")
            expect_true("BSgenome.Celegans.UCSC.ce10" %in% BSgenome::installed.genomes())
        }
    }
})

test_that("Test getPlotSetArray function and plotting interfaces", {
    
    tmp <- file.path(tempdir(), 'SeqPlots')
    context("Testing getPlotSetArray")
    if(.Platform$OS.type != "windows" || .Machine$sizeof.pointer != 4) {
        psa <- getPlotSetArray(bw1, c(bed1, bed2), 'ce10')
    } else {
        psa <- get(load(system.file(
            "extdata", "precalc_plotset.Rdata", package="seqplots"))[[1]])
    }
    expect_that(psa, is_a("PlotSetArray"))
    
    context("Testing utils")
    expect_is(capture.output(show(psa)),    'character', info = NULL, label = NULL)
    expect_is(psa$unlist(), 'PlotSetList', info = NULL, label = NULL)
    expect_is(psa[1],      'PlotSetList', info = NULL, label = NULL)
    expect_is(psa[2,1],    'PlotSetArray', info = NULL, label = NULL)
    expect_is(psa[[2]],    'PlotSetPair', info = NULL, label = NULL)
    
    context("Testing graphics")
    expect_error(plot(psa, what='h'))
    expect_null(plot(psa, what='a'))
    expect_is(plot(psa[2], what='h'), 'data.frame')
    expect_is(plot(psa[2,1], what='h'), 'data.frame')
    
    context("Extended functions tests for better test coverage")
    expect_null(plotAverage(psa, plotScale = 'log2'))
    expect_null(plotAverage(psa$unlist(), plotScale = 'zscore'))
    expect_null(plotAverage(psa$unlist()[[1]]))
    expect_null(plotAverage(psa$unlist()[[1]], labels = 'A') )
    
    expect_is(plot(psa[2,1], what='h', ggplot=TRUE), 'data.frame')
    
    expect_is(
        plotHeatmap(psa[[2,1]], plotScale= "log2", sortrows = 'decreasing', clstmethod = 'hclust' )
        , 'data.frame'
    )
    expect_is(
        plotHeatmap(psa$unlist()[1], plotScale= "zscore", sortrows = 'increasing', clstmethod = 'ssom')
        , 'data.frame'
    )
    
    expect_is(
        plotHeatmap(psa$unlist()[[1]], ggplot = TRUE, indi = FALSE, autoscale=TRUE, raster=FALSE)
        , 'data.frame'
    )
    
    expect_is(
        plotHeatmap(psa$unlist()[[1]], clspace=c('red', 'blue'), raster=FALSE)
        , 'data.frame'
    )
    
    expect_is(
        plotHeatmap(psa$unlist()[[1]], clspace=c('red', 'blue'), raster=FALSE, ggplot = TRUE)
        , 'data.frame'
    )
    
    expect_is(
        plotHeatmap(psa$unlist()[[1]], indi=FALSE, raster=FALSE, ggplot=TRUE)
        , 'data.frame'
    )
    
    expect_is(
        plotHeatmap(psa[[1]], indi=FALSE, raster=FALSE, colvec='red')
        , 'data.frame'
    )
    
    context("Anchored features and median test")
    if(.Platform$OS.type == "windows" && .Machine$sizeof.pointer == 4) 
        skip('Skipping on Win 32bit')
    expect_is( getPlotSetArray(bw1, c(bed1, bed2), 'ce10', type = 'af'), "PlotSetArray" )
    expect_is( getPlotSetArray(bw1, c(bed1, bed2), 'ce10', stat = 'median'), "PlotSetArray" )

    context("Extended functions tests for PlotSetPair")
    expect_null(psa[[1]]$show())
    expect_null(plot(psa[[1]]))
    expect_is(plot(psa[[1]], what='h'), 'data.frame')
    
    
})

test_that("Test motifs", {
    
    context("Test motif - aquire data")
    
    ms <- MotifSetup()
    ms$addMotif('GAGA')
    ms$addMotif('TATA', revcomp=TRUE)
    ms$addBigWig(bw1)
    expect_is(ms, 'MotifSetup', info = NULL, label = NULL)
    expect_equal(ms$nmotifs(), 3, info = NULL, label = NULL)

    context("Testing getPlotSetArray with motifs")
    if(.Platform$OS.type != "windows" || .Machine$sizeof.pointer != 4) {
        psa <- getPlotSetArray(ms, c(bed1, bed2), 'ce10')
    } else {
        psa <- get(load(system.file(
            "extdata", "precalc_plotset.Rdata", package="seqplots"))[[2]])
    }
    expect_that(psa, is_a("PlotSetArray"))
    
    context("Testing utils with motifs")
    expect_is(capture.output(show(psa)),    'character', info = NULL, label = NULL)
    expect_is(psa$unlist(), 'PlotSetList', info = NULL, label = NULL)
    expect_is(psa[1],      'PlotSetList', info = NULL, label = NULL)
    expect_is(psa[2,1],    'PlotSetArray', info = NULL, label = NULL)
    expect_is(psa[[2]],    'PlotSetPair', info = NULL, label = NULL)
    
    context("Testing graphics with motifs")
    expect_error(plot(psa, what='h'))
    expect_null(plot(psa, what='a'))
    expect_is(plot(psa[2,1], what='h'), 'data.frame')
    expect_is(plot(psa[c(1,3,5)], what='h'), 'data.frame')
    
    context("Testing heatmap options")
    expect_is(plotHeatmap(psa[1,], indi = FALSE), 'data.frame')
    
    context("Testing heatmap cluster report")
    expect_true( all(is.na( psa[1,]$plot('h', clusters=0)$ClusterID )) )
    expect_true( all(is.na( plotHeatmap(psa[1,], clstmethod='none' )$ClusterID )) )
    expect_true( all(is.na( psa[1,]$plot('h')$SortingOrder )) )
    
    context("Testing heatmap cluster report consistancy")
    meta <- psa[1,]$plot('h')
    expect_true(all( import.bed(bed1)$name == meta$metadata_name[order(meta$originalOrder)] ))
    
    context("Anchored features test")
    if(.Platform$OS.type == "windows" && .Machine$sizeof.pointer == 4) 
        skip('Skipping on Win 32bit')
    
    af <- getPlotSetArray(ms, c(bed1, bed2), 'ce10', type = 'af')
    expect_null(plot(af, what='a'))
    expect_is(plotHeatmap(af[[1]]), 'data.frame')
    expect_null(plotAverage(af, type = 'legend'))
    expect_null(plotAverage(af, type = 'legend', error.estimates=TRUE, legend_ext=TRUE))
    
    expect_is(plotHeatmap(af[[1]], indi=FALSE), 'data.frame')

    
})

test_that("helper functions", {
    
    context("Server deployment test")
    #expect_null( deployServerInstance(server=tempdir()) )
    #expect_error( run(root=tempdir(), shinyErrParam=TRUE) )
    
    context("Hepler functions")
    expect_equal(num2sci(100000), '100k')
    expect_null( imPlot2(matrix(rnorm(100), 10, 10), xinds=1, horizontal = TRUE) )
    expect_null( imPlot2(matrix(rnorm(100), 10, 10), xinds=1, add = TRUE) )
    expect_null( imPlot2(matrix(rnorm(100), 10, 10), xinds=1, legend.only = TRUE) )
    expect_null( imPlot2(matrix(rnorm(100), 10, 10), xinds=1, graphics.reset=TRUE) )
})