tests/testthat/test-amExample1.R

In amregtest: Runs Allelematch Regression Tests

test_that("We are running the 3rd edition of testthat", code = {
    testthat::expect_gte(!!testthat::edition_get(), 3)
})

HTML=isTRUE(Sys.getenv("ART_GENERATE_HTML") == "TRUE") # Set with Sys.setenv(ART_GENERATE_HTML = "TRUE")

overwrite = FALSE # Use TRUE when creating new tests that need new *_expected data.

test_that("amExample1 from pg 5 in allelematchSuppDoc.pdf is 2.5.3 compatible", code = {

    # Prepare for printing large snapshot files:
    withr::local_options(width=200) # Allow longer lines for the summaries:

    # Follow the instructions from allelematchSuppDoc.pdf:
    # Test the results within curly brackets ("{ ... }") below the instructions.
    data("amExample1")
    expect_snapshot(
        example1 <- amDataset(amExample1, indexColumn="sampleId", ignoreColumn="knownIndividual", missingCode="-99")
    )
    {
        # Ensure that the result is still the same as that from 2.5.3:
        expect_snapshot_value(example1, style="deparse")
    }

    output <- capture.output(
        amUniqueProfile(example1, doPlot=TRUE)
    )
    {
        # Ensure that the result is still the same as that from 2.5.3:
        # cat("\nOutput from amUniqueProfile:\n", output, "\nEnd of output\n", sep="\n    ")

        testthat::expect_match(output, "missing data load for input dataset is 0.005 ", fixed=TRUE, all=FALSE)
        testthat::expect_match(output, "allelic diversity for input dataset is 6.1 ", fixed=TRUE, all=FALSE)
        testthat::expect_match(output, "Best guess for optimal parameter at alleleMismatch=2 OR matchThreshold=0.9 OR cutHeight=0.1", fixed=TRUE, all=FALSE)
        testthat::expect_match(output, "Best guess for optimal parameter at alleleMismatch=2 OR matchThreshold=0.9 OR cutHeight=0.1$", all=FALSE)
        testthat::expect_match(output, "Best guess for unique profile morphology: ZeroSecondMinimum", fixed=TRUE, all=FALSE)
    }

    expect_snapshot(
        uniqueExample1 <- amUnique(example1, alleleMismatch=2, verbose=FALSE), # TODO : Default of verbose changed in 2.5.4
    )
    {
        # testthat::expect_match(output, "allelematch:  assuming genotype columns are in pairs, representing 10 loci$", all=FALSE)

        # Ensure that the result is still the same as that from 2.5.3:
        expect_snapshot_value(uniqueExample1, style="deparse")
    }

    if(HTML) {
        ## Save to disk
        summary.amUnique(uniqueExample1, html=helpHtml("example1_1.html"))
        ## View in default browser
        ## summary.amUnique(uniqueExample1, html=TRUE)
    }

    expect_snapshot(
        summary.amUnique(uniqueExample1, csv=summaryFile <- tempfile("example1_1.csv"))
    )
    {
        # Note that the example from allelematchSuppDoc.pdf, summary(uniqueExample1, csv="example1_1.csv"),
        # doesn't work. summary.amUnique is needed.
        #
        # We add the "summaryFile <- tempfile("example1_1.csv")" to avoid that tests generate unwanted files in the workspace.

        # Ensure that the result is still the same as that from 2.5.3
        expect_snapshot_value(read.csv(summaryFile, colClasses="character"), style="deparse")
        file.remove(summaryFile)
    }

    summary.amUnique(uniqueExample1, csv=summaryFile <- tempfile("example1_2.csv"), uniqueOnly=TRUE)
    {
        # Ensure that the result is still the same as that from 2.5.3
        expect_snapshot_value(read.csv(file=summaryFile, colClasses="character"), style="deparse")
        file.remove(summaryFile)
    }

    example1chk <- amDataset(amExample1, indexColumn="sampleId",
      metaDataColumn="knownIndividual", missingCode="-99")
    {
        # Ensure that the result is still the same as that from 2.5.3:
        expect_snapshot_value(example1chk, style="deparse")
    }


    output = capture.output(
        uniqueExample1chk <- amUnique(example1chk, alleleMismatch=2)
    )
    {
        testthat::expect_match(output, "allelematch:  assuming genotype columns are in pairs, representing 10 loci$", all=FALSE)

        # Ensure that the result is still the same as that from 2.5.3:
        expect_snapshot_value(uniqueExample1chk, style="deparse")
    }

    if(HTML) {
        ## Save to disk
        summary.amUnique(uniqueExample1chk, html=helpHtml("example1_2.html"))
        ## View in default browser
        # summary.amUnique(uniqueExample1chk, html=TRUE)
    }
})