R/tools-tests.R

In ropensci/phylotaR: Automated Phylogenetic Sequence Cluster Identification from 'GenBank'

# Tools for running tests
#' @title Return test data directory
#' @description Returns the file path to the test data directory.
#' @param subdir Subdirectory within the datadir
#' @return filepath, character
#' @noRd
datadir_get <- function(subdir = "") {
  wd <- getwd()
  if (grepl("testthat", wd)) {
    datadir <- "data"
  } else {
    # for running test at package level
    datadir <- file.path("tests", "testthat", "data")
  }
  file.path(datadir, subdir)
}

#' @title Return random phylota object
#' @description Returns example Phylota object generated from demos.
#' @return Phylota
#' @noRd
random_phylota <- function() {
  # randomly choose one of the example phylota objects
  pssbls <- c(
    "aotus", "bromeliads", "cycads", "dragonflies", "sturgeons",
    "tinamous", "tardigrades"
  )
  rndm <- sample(pssbls, 1)
  # list.files('data')
  data_env <- new.env()
  do.call(what = utils::data, args = list(rndm, envir = data_env))
  assign(x = "phylota", value = data_env[[rndm]])
  rm(data_env)
  phylota
}

#' @title Remove all test files and folders
#' @description Any folders and files generated by tests will be
#' deleted.
#' @return NULL
#' @noRd
cleanup <- function(wd) {
  # remove any test generated datasets
  cch_dir <- file.path(wd, "cache")
  if (dir.exists(cch_dir)) {
    unlink(cch_dir, recursive = TRUE)
  }
  fls <- c(
    "log.txt", "log.log", "test.fasta", "session_info.txt",
    "blast_versions.txt"
  )
  fls <- file.path(wd, fls)
  fls <- c(fls, datadir_get(file.path("blast", "testdb")))
  for (fl in fls) {
    if (file.exists(fl)) {
      file.remove(fl)
    }
  }
}

#' @title Run cmdln for BLAST checking
#' @description Use command arg to control returned output and testing function
#' responses.
#' @return list
#' @noRd
cmdln_blastcheck <- function(cmd, args, ps, lgfl = NULL) {
  if (grepl("makeblastdb", cmd)) {
    out <- "makeblastdb: 2.7.1+\nPackage: blast 2.7.1, build [date]"
  }
  if (grepl("blastn", cmd)) {
    out <- "blastn: 2.7.1+\nPackage: blast 2.7.1, build [date]"
  }
  if (grepl("wrngvrsn", cmd)) {
    out <- "blastn: 1.6.1+\nPackage: blast 1.6.1, build [date]"
  }
  list(status = 0, stdout = charToRaw(out), stderr = charToRaw(""))
}

#' @title Generate fake SeqArc
#' @description Generate fake sequence archive for testing.
#' @param n Number of sequences
#' @param l Length of sequences
#' @return SeqArc
#' @noRd
testsqs_gen <- function(n = 100, l = 1000) {
  sqs <- NULL
  for (i in 1:n) {
    itext <- as.character(i)
    sqstrng <- sample(c("A", "T", "C", "G"), size = l, replace = TRUE)
    sqstrng <- paste(sqstrng, collapse = "")
    sqs <- c(seqrec_gen(
      accssn = itext, nm = itext, txid = itext,
      sq = sqstrng, dfln = "deflin", orgnsm = "",
      ml_typ = "DNA", rec_typ = "full",
      vrsn = itext, age = 1L
    ), sqs)
  }
  seqarc_gen(sqs)
}

# efetch_mock <- function(db, rettype, id) {
#   fasta_rand <- function() {
#     seq <- sample(c('A', 'T', 'C', 'G'), size = 1000,
#                   replace = TRUE)
#     seq <- paste(seq, collapse = '')
#     paste0('> rand0m.name.--jg82-5969\n', seq, '\n')
#   }
#   seqs <- ''
#   for (i in 1:length(id)) {
#     seqs <- paste0(seqs, fasta_rand())
#   }
#   seqs
# }

# esummary_mock <- function(db, id) {
#   summary_rand <- function() {
#     list(uid = NA, txid = NA, caption = NA,
#          accessionversion = NA,
#          slen = NA, createdate = NA, title = NA)
#   }
#   if (n == 1) {
#     return(summary_rand())
#   }
#   summ <- vector('list', length = n)
#   for (i in 1:length(id)) {
#     summ[[i]] <- summary_rand()
#   }
#   summ
# }

# sids_get_mock <- function(...) {
#   if (n == 0) {
#     ids <- NULL
#   } else {
#     ids <- as.character(1:n)
#   }
#   ids
# }