test-studies.R
In rotl: Interface to the 'Open Tree of Life' API

if (FALSE) {
  context("test of studies")

  ############################################################################
  ## studies_properties                                                     ##
  ############################################################################

  test_that("studies_properties is a list with 2 elements (if breaks, need to update documentation)", {
    skip_on_cran()
    expect_true(all(names(studies_properties() %in% c("tree_properties", "study_properties"))))
  })


  ############################################################################
  ## get_study                                                              ##
  ############################################################################

  test_that("get_study returns an error when asking for a study that doesn't exist", {
    skip_on_cran()
    expect_error(get_study("tt_666666"))
  })

  test_that("get_study generates a phylo object", {
    skip_on_cran()
    tr <- get_study("pg_719", object_format = "phylo")
    expect_true(inherits(tr, "multiPhylo"))
    expect_equal(length(tr), 3)
    expect_true(length(tr[[1]]$tip.label) > 1)
  })

  test_that("get_study returns an error if file is specied but file_format is not", {
    skip_on_cran()
    expect_error(
      get_study("pg_719", file = "test"),
      "must be specified"
    )
  })

  test_that("get_study generates a nexml object", {
    skip_on_cran()
    tr <- get_study("pg_719", object_format = "nexml")
    expect_true(inherits(tr, "nexml"))
  })

  test_that("get_study generates a newick file", {
    skip_on_cran()
    ff <- tempfile()
    tr <- get_study("pg_719", file_format = "newick", file = ff)
    expect_true(tr)
    expect_true(grepl("^\\(", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study generates a nexus file", {
    skip_on_cran()
    ff <- tempfile()
    tr <- get_study("pg_719", file_format = "nexus", file = ff)
    expect_true(tr)
    expect_true(grepl("^#NEXUS", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study generates a nexml file", {
    skip_on_cran()
    ff <- tempfile()
    tr <- get_study("pg_719", file_format = "nexml", file = ff)
    expect_true(tr)
    expect_true(grepl("^<\\?xml", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study generates a json file", {
    skip_on_cran()
    ff <- tempfile()
    tr <- get_study("pg_719", file_format = "json", file = ff)
    expect_true(tr)
    expect_true(grepl("^\\{", readLines(ff, n = 1, warn = FALSE)))
  })



  ############################################################################
  ## get_study_tree                                                         ##
  ############################################################################

  test_that("get_study_tree returns error when tree doesn't exist", {
    skip_on_cran()
    expect_error(get_study_tree("2655", "tree5555"))
  })

  test_that("get_study_tree returns error when study doesn't exist", {
    skip_on_cran()
    expect_error(get_study_tree("5555555", "tree555555"))
  })


  test_that("get_study_tree generates nexus file", {
    skip_on_cran()
    ff <- tempfile(fileext = ".nex")
    tt <- get_study_tree("pg_1144", "tree2324",
      file_format = "nexus",
      file = ff
    )
    expect_true(tt)
    expect_true(grepl("^#NEXUS", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study_tree generates newick file", {
    skip_on_cran()
    ff <- tempfile(fileext = ".tre")
    tt <- get_study_tree("pg_1144", "tree2324",
      file_format = "newick",
      file = ff
    )
    expect_true(tt)
    expect_true(grepl("^\\(", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study_tree generates json file", {
    skip_on_cran()
    ff <- tempfile(fileext = ".json")
    tt <- get_study_tree("pg_1144", "tree2324",
      file_format = "json",
      file = ff
    )
    expect_true(tt)
    expect_true(grepl("^\\{", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study_tree returns a phylo object", {
    skip_on_cran()
    tt <- get_study_tree("pg_1144", "tree2324", object_format = "phylo")
    expect_true(inherits(tt, "phylo"))
    expect_true(length(tt$tip.label) > 1)
  })

  ### Test types of labels with phylo objects

  test_that("get_study_tree returns a phylo object and ott_id for tip labels", {
    skip_on_cran()
    tt <- get_study_tree("pg_1144", "tree2324",
      object_format = "phylo",
      tip_label = "ott_id"
    )
    expect_true(inherits(tt, "phylo"))
    expect_true(length(tt$tip.label) > 1)
    expect_true(grepl("^[0-9]+$", tt$tip.label[1]))
  })

  test_that("get_study_tree returns a phylo object and ott_taxon_names for tip labels", {
    skip_on_cran()
    tt <- get_study_tree("pg_1144", "tree2324",
      object_format = "phylo",
      tip_label = "ott_taxon_name"
    )
    expect_true(inherits(tt, "phylo"))
    expect_true(length(tt$tip.label) > 1)
    expect_true(sum(!grepl("^[A-Za-z]+(_[a-z]+)?$", tt$tip.label)) < 3)
  })

  test_that("get_study_tree returns a phylo object and original labels for tip labels", {
    skip_on_cran()
    tt <- get_study_tree("pg_1144", "tree2324",
      object_format = "phylo",
      tip_label = "original_label"
    )
    expect_true(inherits(tt, "phylo"))
    expect_true(length(tt$tip.label) > 1)
    expect_equal(sum(!grepl("^[A-Za-z]+_[a-z]+$", tt$tip.label)), 45)
  })

  ### Test types of labels with files (skipping json for now because there is no good way of doing it)

  test_that("get_study_tree returns an error if file is given but file format is not", {
    skip_on_cran()
    expect_error(
      get_study_tree(study_id = "pg_1144", tree_id = "tree2324", file = "test"),
      "must be specified"
    )
  })

  test_that("get_study_tree returns nexus file and ott_id for tip labels", {
    skip_on_cran()
    ff <- tempfile(fileext = ".nex")
    tt <- get_study_tree("pg_1144", "tree2324",
      file_format = "nexus",
      tip_label = "ott_id", file = ff
    )
    expect_true(tt)
    tr <- rncl::read_nexus_phylo(ff)
    expect_true(length(tr$tip.label) > 1)
    expect_true(grepl("^[0-9]+$", tr$tip.label[1]))
  })

  test_that("get_study_tree returns a phylo object and ott_taxon_names for tip labels", {
    skip_on_cran()
    ff <- tempfile(fileext = ".tre")
    tt <- get_study_tree("pg_1144", "tree2324",
      file_format = "newick",
      tip_label = "ott_taxon_name", file = ff
    )
    expect_true(tt)
    tr <- rncl::read_newick_phylo(ff)
    expect_true(length(tr$tip.label) > 1)
    expect_true(sum(!grepl("^[A-Za-z]+(_[a-z]+)?$", tr$tip.label)) < 3)
  })



  ############################################################################
  ## get_study_subtree                                                      ##
  ############################################################################

  test_that("get_study_subtree returns an error when study_id doesn't exist", {
    skip_on_cran()
    expect_error(get_study_subtree("pg_55555", "tree55555", subtree_id = "node555555"))
  })

  test_that("get_study_subtree returns an error when tree_id doesn't exist", {
    skip_on_cran()
    expect_error(get_study_subtree("pg_1144", "tree55555", subtree_id = "node555555"))
  })

  test_that("get_study_subtree returns an error when the subtree_id is invalid", {
    skip_on_cran()
    expect_error(get_study_subtree("pg_1144", "tree2324", "foobar"))
  })

  test_that("get_study_subtree returns a phylo object", {
    skip_on_cran()
    tt <- get_study_subtree("pg_420", "tree522",
      subtree_id = "ingroup",
      object_format = "phylo"
    )
    sub_tt <- get_study_subtree("pg_420", "tree522",
      subtree_id = "node208580",
      object_format = "phylo"
    )
    expect_true(inherits(tt, "phylo"))
    expect_true(length(tt$tip.label) > 1)
    expect_true(inherits(sub_tt, "phylo"))
    expect_true(length(sub_tt$tip.label) > 1)
    expect_true(length(tt$tip.label) > length(sub_tt$tip.label))
  })

  test_that("get_study_subtree fails if file name is given but no file format", {
    skip_on_cran()
    expect_error(get_study_subtree("pg_420", "tree522",
      subtree_id = "ingroup",
      file = "test"
    ), "must be specified")
  })

  test_that("get_study_subtree returns a nexus file", {
    skip_on_cran()
    ff <- tempfile(fileext = ".nex")
    tt <- get_study_subtree("pg_420", "tree522",
      subtree_id = "ingroup",
      file_format = "nexus", file = ff
    )
    expect_true(tt)
    expect_true(grepl("^#NEXUS", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study_subtree returns a newick file", {
    skip_on_cran()
    ff <- tempfile(fileext = ".tre")
    tt <- get_study_subtree("pg_420", "tree522",
      subtree_id = "ingroup",
      file_format = "newick", file = ff
    )
    expect_true(tt)
    expect_true(grepl("^\\(", readLines(ff, n = 1, warn = FALSE)))
  })

  test_that("get_study_subtree can deduplicate labels", {
    skip_on_cran()
    expect_warning(
      get_study_subtree(
        study_id = "pg_710", tree_id = "tree1277",
        tip_label = "ott_taxon_name",
        subtree_id = "ingroup", deduplicate = TRUE
      ),
      "and have been modified"
    )
  })

  test_that("get_study_subtree fails with duplicate labels", {
    skip_on_cran()
    expect_error(
      get_study_subtree(
        study_id = "pg_710", tree_id = "tree1277",
        tip_label = "ott_taxon_name",
        subtree_id = "ingroup", deduplicate = FALSE
      ),
      "has already been encountered"
    )
  })




  ############################################################################
  ## get_study_meta                                                         ##
  ############################################################################

  if (identical(Sys.getenv("NOT_CRAN"), "true")) {
    sm <- get_study_meta("pg_719")
  }

  test_that("get_study meta returns a study_meta object", {
    skip_on_cran()
    expect_true(inherits(sm, "study_meta"))
  })

  test_that("get_tree_ids method for study_meta", {
    skip_on_cran()
    expect_equal(get_tree_ids(sm), c("tree1294", "tree1295", "tree1296"))
  })

  test_that("get_publication method for study_meta", {
    skip_on_cran()
    expect_equal(attr(get_publication(sm), "DOI"), "http://dx.doi.org/10.1600/036364411X605092")
  })

  test_that("candidate_for_synth method for study_meta", {
    skip_on_cran()
    expect_true(candidate_for_synth(sm) %in% get_tree_ids(sm))
  })

  test_that("get_study_year method for study_meta", {
    skip_on_cran()
    expect_equal(get_study_year(sm), 2011)
  })

  ############################################################################
  ## tol_about                                                              ##
  ############################################################################

  test_that("tol_about returns class tol_summary", {
    skip_on_cran()
    expect_true(inherits(tol_about(), "tol_summary"))
  })

  test_that("study_about", {
    skip_on_cran()
    ta <- source_list(tol_about(TRUE))
    expect_true(inherits(ta, "data.frame"))
    expect_true(nrow(ta) > 100)
    expect_equal(names(ta), c("study_id", "tree_id", "git_sha"))
  })

  ############################################################################
  ## studies_find_studies                                                   ##
  ############################################################################

  test_that("single study detailed=TRUE", {
    skip_on_cran()
    res <- studies_find_studies(
      property = "ot:studyId",
      value = "ot_248", detailed = TRUE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_true(all(names(res) %in% c(
      "study_ids", "n_trees", "tree_ids",
      "candidate", "study_year", "title",
      "study_doi"
    )))
    expect_true(nrow(res) >= 1L)
    expect_equal(res[["study_ids"]], "ot_248")
    expect_equal(res[["n_trees"]], "1")
    expect_equal(res[["candidate"]], "Tr76302")
    expect_equal(res[["study_year"]], "2014")
    expect_equal(res[["study_doi"]], "http://dx.doi.org/10.1016/j.cub.2014.06.060")
    expect_equal(res[["title"]], "'Phylogenomic Resolution of the Class Ophiuroidea Unlocks a Global Microfossil Record'")
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("single study detailed=FALSE", {
    skip_on_cran()
    res <- studies_find_studies(
      property = "ot:studyId",
      value = "ot_248", detailed = FALSE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "study_ids"))
    expect_true(inherits(res, "matched_studies"))
    expect_match(attr(res, "found_trees"), "list of the trees associated")
    expect_equal(names(res), "study_ids")
    expect_equal(res[1, 1], "ot_248")
    expect_equal(nrow(res), 1L)
    expect_equal(ncol(res), 1L)
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("multiple studies detailed=TRUE", {
    skip_on_cran()
    res <- studies_find_studies(
      property = "ot:focalCladeOTTTaxonName",
      value = "mammalia", detailed = TRUE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_true(all(names(res) %in% c(
      "study_ids", "n_trees", "tree_ids",
      "candidate", "study_year",
      "title", "study_doi"
    )))
    expect_true(nrow(res) >= 8L)
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("multiple studies detailed=FALSE", {
    skip_on_cran()
    res <- studies_find_studies(
      property = "ot:focalCladeOTTTaxonName",
      value = "mammalia", detailed = FALSE
    )
    expect_true(inherits(res, "study_ids"))
    expect_true(inherits(res, "matched_studies"))
    expect_true(inherits(res, "data.frame"))
    expect_equal(ncol(res), 1L)
    expect_true(nrow(res) >= 8)
    expect_equal(names(res), "study_ids")
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })


  ############################################################################
  ## studies_find_trees                                                     ##
  ############################################################################

  test_that("studies_find_trees single study detailed=FALSE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:studyId",
      value = "ot_248", detailed = FALSE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_match(attr(res, "found_trees")[[1]], "Tr76302")
    expect_equal(names(res), c(
      "study_ids",
      "n_matched_trees",
      "match_tree_ids"
    ))
    expect_equal(res[1, 1], "ot_248")
    expect_equal(nrow(res), 1L)
    expect_equal(ncol(res), 3L)
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("studies_find_trees single study detailed=TRUE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:studyId",
      value = "ot_248", detailed = TRUE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_equal(names(res), c(
      "study_ids", "n_trees",
      "tree_ids", "candidate",
      "study_year", "title",
      "study_doi",
      "n_matched_trees",
      "match_tree_ids"
    ))
    expect_equal(nrow(res), 1L)
    expect_equal(res[["study_ids"]], "ot_248")
    expect_equal(res[["n_trees"]], "1")
    expect_equal(res[["candidate"]], "Tr76302")
    expect_equal(res[["study_year"]], "2014")
    expect_equal(res[["study_doi"]], "http://dx.doi.org/10.1016/j.cub.2014.06.060")
    expect_equal(res[["title"]], "'Phylogenomic Resolution of the Class Ophiuroidea Unlocks a Global Microfossil Record'")
    expect_equal(res[["tree_ids"]], "Tr76302")
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("studies_find_trees multiple studies detailed=TRUE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:ottTaxonName",
      value = "Echinodermata", detailed = TRUE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_equal(names(res), c(
      "study_ids", "n_trees",
      "tree_ids", "candidate",
      "study_year", "title",
      "study_doi",
      "n_matched_trees",
      "match_tree_ids"
    ))
    expect_true(nrow(res) >= 5L)
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })

  test_that("studies_find_trees multiple studies detailed=FALSE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:ottTaxonName",
      value = "Echinodermata", detailed = FALSE
    )
    expect_true(inherits(res, "data.frame"))
    expect_true(inherits(res, "matched_studies"))
    expect_equal(names(res), c(
      "study_ids",
      "n_matched_trees",
      "match_tree_ids"
    ))
    expect_true(nrow(res) >= 5L)
    expect_true(length(attr(res, "metadata")) > 0)
    expect_true(length(attr(res, "found_trees")) > 0)
  })


  ############################################################################
  ## list_trees                                                             ##
  ############################################################################

  test_that("list_trees with studies_find_studies and detailed = FALSE", {
    skip_on_cran()
    expect_match(
      list_trees(studies_find_studies(
        property = "ot:focalCladeOTTTaxonName",
        value = "Aves", detailed = FALSE
      )),
      "If you want to get a list of the trees associated with the studies"
    )
  })

  test_that("list_trees with studies_find_studies and detailed = TRUE", {
    skip_on_cran()
    res <- studies_find_studies(
      property = "ot:focalCladeOTTTaxonName",
      value = "mammalia", detailed = TRUE
    )
    expect_true(inherits(list_trees(res), "list"))
    expect_true(length(list_trees(res)) >= 8)
    expect_true(sum(names(list_trees(res)) %in% c(
      "pg_2647", "ot_308",
      "pg_2812", "ot_109",
      "pg_2582", "pg_1428",
      "ot_755", "pg_2550"
    )) >= 8)
  })

  test_that("list_trees with studies_find_trees and detailed=FALSE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:ottTaxonName",
      value = "Echinodermata", detailed = FALSE
    )
    lt <- list_trees(res)
    expect_true(inherits(lt, "list"))
    expect_true(length(names(lt)) >= 5L)
    expect_true(all(sapply(lt, length) >= 1L))
  })

  test_that("list_trees with studies_find_trees and detailed=TRUE", {
    skip_on_cran()
    res <- studies_find_trees(
      property = "ot:ottTaxonName",
      value = "Echinodermata", detailed = TRUE
    )
    lt <- list_trees(res)
    expect_true(inherits(lt, "list"))
    expect_true(length(names(lt)) >= 5L)
    expect_true(all(sapply(lt, length) >= 1L))
  })
}