File: is_in_tree.R

package info (click to toggle)
r-cran-rotl 3.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,384 kB
  • sloc: sh: 9; makefile: 5
file content (58 lines) | stat: -rw-r--r-- 2,189 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
##' Some valid taxonomic names do not occur in the Synthetic
##' Tree. This convenience function allows you to check whether a
##' given Open Tree Taxonomy identifier (OTT id) is in the tree. A taxonomic
##' name may not occur in the synthetic tree because (1) it is an
##' extinct or invalid taxon, or (2) it is part of a group that is not
##' monophyletic in the tree.
##'
##' @title Check that OTT ids occur in the Synthetic Tree
##' @param ott_ids a vector of Open Tree Taxonomy identifiers
##' @param ...  additional arguments to customize the API request (see
##'     \code{\link{rotl}} package documentation).
##' @return A named logical vector. \code{TRUE} indicates that the OTT
##'     id is in the synthetic tree, and \code{FALSE} that it is not.
##' @examples
##' \dontrun{
##'   plant_families <- c("Asteraceae", "Solanaceae", "Poaceae", "Amaranthaceae",
##'                       "Zamiaceae", "Araceae", "Juncaceae")
##'   matched_names <- tnrs_match_names(plant_families)
##'   ## This fails because some ott ids are not in the tree
##'   ## plant_tree <- tol_induced_subtree(ott_id(matched_names))
##'   ## So let's check which ones are actually in the tree first:
##'   in_tree <- is_in_tree(ott_id(matched_names))
##'   ## This now works:
##'   plant_tree <- tol_induced_subtree(ott_id(matched_names)[in_tree])
##' }
##'
##' @export
is_in_tree <- function(ott_ids, ...) UseMethod("is_in_tree")


##' @export
is_in_tree.otl_ott_id <- function(ott_ids, ...) {
  in_tree <- vapply(ott_ids, function(ottid) {
    test <- try(tol_node_info(ottid, ...), silent = TRUE)
    if (inherits(test, "try-error")) {
      if (grepl("was not found", test) &&
        grepl(paste0("'ott", ottid, "'"), test)) {
      } else {
        warning("something seems off, check your internet connection?")
      }
      return(FALSE)
    } else {
      ott_id(test)[[1]] == ottid
    }
  }, logical(1), USE.NAMES = TRUE)

  in_tree
}

##' @export
is_in_tree.default <- function(ott_ids, ...) {
  chk_ids <- vapply(ott_ids, check_numeric, logical(1))
  if (all(chk_ids)) {
    is_in_tree.otl_ott_id(ott_ids)
  } else {
    stop("Invalid format for ott_ids (they should look like numbers)")
  }
}