ropensci / taxadb
Showing 4 of 8 files from the diff.

@@ -36,7 +36,7 @@
Loading
36 36
#'
37 37
#' }
38 38
td_connect <- function(dbdir = taxadb_dir(),
39 -
                       driver = Sys.getenv("TAXADB_DRIVER"),
39 +
                       driver = Sys.getenv("TAXADB_DRIVER", "duckdb"),
40 40
                       read_only = FALSE){
41 41
42 42
  arkdb::local_db(dbdir = dbdir, driver = driver, readonly = read_only)

@@ -61,32 +61,47 @@
Loading
61 61
                    ...){
62 62
  format <- match.arg(format)
63 63
  n <- length(names)
64 +
  provider <- db
65 +
64 66
65 67
  # be compatible with common space delimiters
66 68
  names <- gsub("[_|-|\\.]", " ", names)
67 69
68 70
  df <- filter_name(name = names,
69 -
                provider = db,
71 +
                provider = provider,
70 72
                version = version,
71 73
                collect = TRUE,
72 74
                ignore_case = ignore_case,
73 75
                db = taxadb_db) %>%
74 76
    arrange(sort)
75 77
76 -
  df <- duplicate_as_unresolved(df)
78 +
  out <- vapply(names, function(x){
79 +
    df <- df[df$scientificName == x, ]
80 +
81 +
    if(nrow(df) < 1) return(NA_character_)
82 +
83 +
    # Unambiguous: one acceptedNameUsageID per name
84 +
    if(nrow(df)==1) return(df$acceptedNameUsageID[1])
85 +
86 +
    ## Drop infraspecies when not perfect match
87 +
    df <- df[is.na(df$infraspecificEpithet),]
77 88
78 -
  if(dim(df)[1] != n){
79 -
    stop(paste("Error in resolving possible duplicate names.",
80 -
               "Try the filter_name() function instead."),
81 -
         .call = FALSE)
82 -
  }
89 +
    ## If we resolve to a unique accepted ID, return that
90 +
    ids <- unique(df$acceptedNameUsageID)
91 +
    if(length(ids)==1){
92 +
      return(ids)
93 +
    } else {
94 +
      warning(paste0("  Found ", bb(length(ids)), " possible identifiers for ",
95 +
                     ibr(x),
96 +
                     ".\n  Returning ", bb('NA'), ". Try ",
97 +
                     bb(paste0("tl('", x, "', '", provider,"')")),
98 +
                     " to resolve manually.\n"),
99 +
              call. = FALSE)
100 +
      return(NA_character_)
101 +
    }
102 +
  },
103 +
  character(1L), USE.NAMES = FALSE)
83 104
84 -
  ##
85 -
  if("acceptedNameUsageID" %in% names(df)){
86 -
    out <- dplyr::pull(df, "acceptedNameUsageID")
87 -
  } else {
88 -
    out <- dplyr::pull(df, "taxonID")
89 -
  }
90 105
91 106
  ## Format ID as requested
92 107
  switch(format,
@@ -122,3 +137,12 @@
Loading
122 137
  replace_empty(out)
123 138
}
124 139
140 +
141 +
ibr <- function(...){
142 +
  if(!requireNamespace("crayon", quietly = TRUE)) return(paste(...))
143 +
  crayon::italic(crayon::bold(crayon::red(...)))
144 +
}
145 +
bb <- function(...){
146 +
  if(!requireNamespace("crayon", quietly = TRUE)) return(paste(...))
147 +
  crayon::bold(crayon::blue(...))
148 +
}

@@ -91,8 +91,8 @@
Loading
91 91
  sort <- "sort"   # avoid complaint about NSE.
92 92
                   #We could do sym("sort") but this is cleaner.
93 93
  suppress_msg({   # bc MonetDBLite whines about upper-case characters
94 -
    safe_right_join(x, y, by = by, copy = TRUE) %>%
95 -
      dplyr::arrange(sort)
94 +
    safe_right_join(x, y, by = by, copy = TRUE) #%>%
95 +
      #dplyr::arrange(sort)
96 96
  })
97 97
}
98 98

@@ -17,36 +17,8 @@
Loading
17 17
#' @return a dplyr tbl connection to the temporary table in the database
18 18
#' @importFrom dplyr tbl
19 19
#' @export
20 -
#' @examples
21 -
#' \donttest{
22 -
#'   \dontshow{
23 -
#'    ## All examples use a temporary directory
24 -
#'    Sys.setenv(TAXADB_HOME=tempfile())
25 -
#'    Sys.setenv(TAXADB_DRIVER="RSQLite")
26 -
#'    options("taxadb_default_provider"="itis_test")
27 20
#'
28 -
#'   }
29 21
#'
30 -
#'   #Clean a list of messy common names
31 -
#'   library(dplyr)
32 -
#'   names <- clean_names(c("Steller's jay", "coopers Hawk"),
33 -
#'                binomial_only = FALSE, remove_sp = FALSE, remove_punc = TRUE)
34 -
#'
35 -
#'   #Get cleaned common names from a provider and search for cleaned names in that table
36 -
#'   taxa_tbl(schema = "common") %>%
37 -
#'   mutate_db(clean_names, "vernacularName", "vernacularNameClean",
38 -
#'             binomial_only = FALSE, remove_sp = FALSE, remove_punc = TRUE) %>%
39 -
#'   filter(vernacularNameClean %in% names)
40 -
#'
41 -
#'   \dontshow{
42 -
#'    ## All examples use a temporary directory
43 -
#'    Sys.unsetenv("TAXADB_HOME")
44 -
#'    Sys.unsetenv("TAXADB_DRIVER")
45 -
46 -
#'   }
47 -
#'
48 -
#' }
49 -
50 22
mutate_db <- function(.data,
51 23
                      r_fn,
52 24
                      col,
Files Coverage
R 88.4%
Project Totals (16 files) 88.4%
1
comment: false
2

3
coverage:
4
  round: up
5
  precision: 1
6

7
  status:
8
    project:
9
      default:
10
        threshold: 1%
11
    patch:
12
      default:
13
        target: auto
14
        threshold: 5%
15
        only_pulls: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading