ropensci / taxadb

Compare 979d9f8 ... +4 ... 008efed

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.

Showing 4 of 8 files from the diff.

@@ -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

@@ -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)

@@ -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,

Learn more Showing 1 files with coverage changes found.

Changes in R/handling-duplicates.R
-10
+10
Loading file...
Files Coverage
R -5.8% 88.4%
Project Totals (16 files) 88.4%
Loading