tests/testthat/test-tomtom.R

In snystrom/memes: motif matching, comparison, and de novo discovery using the MEME Suite

skip_if(!meme_is_installed(), "MEME is not installed")

# Setup
withr::local_options(list("meme_db" = NULL))

db <- system.file(
  "extdata/flyFactorSurvey_cleaned.meme",
  package = "memes",
  mustWork = TRUE
)
fa <- system.file("extdata/fasta_ex/fa1.fa", package = "memes", mustWork = TRUE)
dreme_out <- runDreme(fa, "shuffle", e = 39, outdir = tempdir())

fa2 <- universalmotif::create_sequences(
  seqnum = 2,
  seqlen = 100,
  rng.seed = 123
)
names(fa2) <- seq_along(fa2)
meme_out <- runMeme(fa2, parse_genomic_coord = FALSE)
####
test_that("tomtom target PWM and target metadata correctly assigned to eachother", {
  # NOTE: don't change dist from "pearson" this is needed downstream for the NULL match class test
  suppressMessages(
    tt_out <<- runTomTom(dreme_out, database = db, dist = "pearson")
  )
  expect_equal(tt_out$best_match_motif[[2]]@name, tt_out$best_match_name[[2]])

  # Ensure that results are correctly sorted by descending p-value
  expect_true(all(
    tt_out$tomtom[[2]]$match_pval == sort(tt_out$tomtom[[2]]$match_pval)
  ))
  # Ensure that results are correctly sorted by descending q-value
  expect_true(all(
    tt_out$tomtom[[2]]$match_qval == sort(tt_out$tomtom[[2]]$match_qval)
  ))
})

test_that("tomtom error checking suggests alternatives", {
  expect_error(
    suppressMessages(runTomTom(dreme_out, database = db, intternal = TRUE)),
    "internal",
    class = "error"
  )
  expect_error(
    suppressMessages(runTomTom(
      dreme_out,
      database = db,
      incomplete_score = TRUE
    )),
    "incomplete_scores",
    class = "error"
  )

  # Make sure norc = TRUE imports work correctly
  expect_error(
    runTomTom(
      system.file("extdata/example.meme", package = "memes", mustWork = TRUE),
      database = db,
      norc = TRUE
    ),
    NA
  )
})

# Test return vals
## best_match_motif list has names?
## motif list has names
test_that("tomtom returns correct data types", {
  motifs <- universalmotif::to_list(dreme_out, extrainfo = TRUE)
  ## Test that returns NA cols if all motifs no match
  ## Set impossibly low threshold to guarantee no match
  suppressMessages(expect_message(
    nomatch <<- runTomTom(motifs[[1]], database = db, thresh = 1e-08),
    "detected no matches"
  ))
  expect_true(is.na(nomatch$tomtom))
  expect_true(is.na(nomatch$best_match_motif))

  suppressMessages(expect_message(
    nomatch_multi <- runTomTom(motifs[c(1, 3)], database = db, thresh = 1e-08),
    "detected no matches"
  ))
  expect_true(all(is.na(nomatch_multi$tomtom)))
  expect_true(all(is.na(nomatch_multi$best_match_motif)))

  ## Test that returns NULL + real value if some motifs no match
  classes <- unique(vapply(
    tt_out$best_match_motif,
    function(x) {
      class(x)
    },
    character(1)
  ))
  expect_true(identical(c("NULL", "universalmotif"), sort(classes)))
})

test_that("view_tomtom_hits works", {
  # correctly returns "noMatch" instead of error msg
  # Just check for list output, since it's easier...
  expect_type(view_tomtom_hits(tt_out), "list")

  # warning when no motifs match but input is >1 length
  suppressMessages(
    x <- runTomTom(dreme_out[c(1, 3), ], database = db, thresh = 1e-8)
  )
  # should succeed making "no match" plots as well
  expect_s3_class(view_tomtom_hits(x)[[1]], c("gg", "ggplot"))
  expect_s3_class(view_tomtom_hits(x)[[2]], c("gg", "ggplot"))
})

# Input tests
test_that("all input types are accepted", {
  expect_success(tt_out <- runTomTom(dreme_out, database = db))
  expect_success(runTomTom(
    system.file("extdata/example.meme", package = "memes", mustWork = TRUE),
    database = db
  ))
  # universalmotif
  expect_success(
    tt_um <- runTomTom(
      universalmotif::create_motif("CCAAAA", altname = "alt"),
      database = db
    )
  )
  # universalmotif (no alt name)
  expect_success(
    tt_um_noalt <- runTomTom(
      universalmotif::create_motif("CCAAAA"),
      database = db
    )
  )
  motifs <- c(
    universalmotif::create_motif("CCAAAA"),
    universalmotif::create_motif("TTTAAAA")
  )
  expect_success(runTomTom(motifs, database = db))
  # runMeme output as input
  expect_success(runTomTom(meme_out, database = db))
})

test_that("tomtom works w/ nonstandard db inputs", {
  db1 <- universalmotif::create_motif("CRAW", name = "motif_1", altname = "1")
  db2 <- universalmotif::create_motif(
    "CCRAAAW",
    name = "motif_2",
    altname = "2"
  )
  motif <- universalmotif::create_motif("CCAAAAW", name = "test_motif")
  # expect warning that db is too small:
  suppressMessages(expect_message(
    runTomTom(motif, database = list(db1, db2)),
    "database size too small"
  ))
  # expect warning re <50 motifs inaccurate p-value
  suppressMessages(expect_message(
    runTomTom(motif, database = list(db1, db2)),
    "at least 50"
  ))
  # "too small" warning should increment as entries are added
  suppressMessages(expect_message(
    runTomTom(motif, database = list(db1, db2)),
    "(2)"
  ))
  suppressMessages(expect_message(
    runTomTom(motif, database = list(db1, db2, db2)),
    "(3)"
  ))
  expect_message(
    runTomTom(
      motif,
      database = purrr::map(
        1:51,
        ~ {
          db1
        }
      )
    ),
    NA
  )

  # TODO: Fix tests below
  # expect warning re discarded motifs
  dup_db <- system.file(
    "extdata",
    "flyFactor_dups.meme",
    package = "memes",
    mustWork = TRUE
  )
  suppressMessages(expect_message(
    runTomTom(motif, database = dup_db),
    "duplicated in the database"
  ))

  # TODO:
  # runTomTom doesn't throw duplicate motif error
  # when using universalmotif db as input...
  #flyFactor_data %>%
  #  dplyr::filter(consensus == "MMCACCTGYYV") %>%
  #  to_list() %>%
  #  {runTomTom(motif, database = ., silent = F)} -> x
})

test_that("Unusual db formats work", {
  skip_if(TRUE, "Need to implement tests below here")
  db1 <- universalmotif::create_motif("CRAW", name = "motif_1", altname = "1")
  db2 <- universalmotif::create_motif(
    "CCRAAAW",
    name = "motif_2",
    altname = "2"
  )
  motif <- universalmotif::create_motif("CCAAAAW", name = "test_motif")

  # db w/ no altname
  #db1["altname"] <- NA_character_
  #runTomTom(motif, database = list(db1, db1), silent = F)
  #expect_message(runTomTom(motif, database = list(db1, db1), silent = F), "duplicated in the database")
  # Goal here is warn if there is no altname? Does tomtom warn about this?
  # I think this is needed to ensure that altname exists for join operation to parse data
  # What I really need to do is fix the tomtom import functions to create an empty altname for the merge,
  # or only use altname column if it exists for the join.
  # I'll leave this failing test as a reminder.
  expect_message(
    runTomTom(motif, database = list(motif)),
    "some inputs are missing an altname. Using the motif name as altname."
  )

  # TODO:
  # warn if > 1 db with identical values Not sure what the error message will be
  # here Also not sure if this is needed. The idea would be to help users figure
  # out which db contributed the duplicated motifs. However, it looks like
  # tomtom won't catch this so I'd have to check for it before writing out the
  # data, which doesn't quite work with the current framework.
  #expect_true(FALSE)
})

test_that("Jagged tomtom xml can be parsed", {
  # from: https://github.com/snystrom/memes/issues/123
  xml <- system.file(
    "extdata/tomtom_jagged_evalue.xml",
    package = "memes",
    mustWork = TRUE
  )
  expect_s3_class(importTomTomXML(xml), "data.frame")
})