R/tools-tests.R

In 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, 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
# }