luomus / finbif

Compare 24ebd7f ... +60 ... 7062ec6

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 7 of 300 files from the diff.
Other files ignored by Codecov
CITATION.cff has changed.
docs/LICENSE.html has changed.
data-raw/status.R has changed.
R/filters.R has changed.
NAMESPACE has changed.
_pkgdown.yml has changed.
R/sysdata.rda has changed.
docs/index.html has changed.
.Rbuildignore has changed.
CRAN-RELEASE was deleted.
inst/NEWS.Rd has changed.
docs/404.html has changed.
docs/extra.css has changed.
docs/authors.html has changed.
docs/pkgdown.js has changed.
README.md has changed.
docs/search.json has changed.
docs/pkgdown.yml has changed.
NEWS.md has changed.
codemeta.json has changed.
README.Rmd has changed.
DESCRIPTION has changed.

@@ -1,8 +1,8 @@
Loading
1 1
#' @noRd
2 -
#' @importFrom lubridate as_date period rollback
2 +
#' @importFrom lubridate as_date period rollback int_end int_start
3 3
parse_date <- function(x) {
4 4
5 -
  if (is.null(x)) return(x)
5 +
  if (is.null(x) || identical(as.character(x), "")) return(x)
6 6
  if (grepl("^\\d{4}$", x)) return(structure(x, class = "y"))
7 7
  if (grepl("^\\d{4}-\\d{2}$", x)) return(structure(x, class = "ym"))
8 8
@@ -45,16 +45,25 @@
Loading
45 45
  x <- parse_date(x)
46 46
  y <- parse_date(y)
47 47
48 -
  if (is.null(x) || is.null(y) || inherits(x, class(y))) {
49 -
    if (inherits(x, "Date")) x <- format.Date(x, format)
50 -
    if (inherits(y, "Date")) y <- format.Date(y, format)
48 +
  if ("" %in% list(x, y) || is.null(x) || is.null(y) || inherits(x, class(y))) {
49 +
    x <- format_date(x, format)
50 +
    y <- format_date(y, format)
51 51
    return(paste(c(x, y), collapse = "/"))
52 52
  }
53 53
54 54
  date_range_ymd2(x, y, format)
55 55
56 56
}
57 57
58 +
#' @noRd
59 +
format_date <- function(x, format) {
60 +
61 +
  if (inherits(x, "Date")) x <- format.Date(x, format)
62 +
63 +
  x
64 +
65 +
}
66 +
58 67
#' @noRd
59 68
date_range_ymd2 <- function(x, y, format) {
60 69
  if (inherits(x, "y")) {

@@ -33,6 +33,11 @@
Loading
33 33
#'   `{tidyr}` packages are available.
34 34
#' @param type_convert_facts Logical. Should facts be converted from character
35 35
#'   to numeric or integer data where applicable?
36 +
#' @param drop_na_facts Logical. Should missing or "all `NA`" facts be dropped?
37 +
#'   Any value other than a length one logical vector with the value of TRUE
38 +
#'   will be interpreted as FALSE. Argument is ignored if `drop_na` is TRUE for
39 +
#'   all variables explicitly or via recycling. To only drop some
40 +
#'   missing/`NA`-data facts use `drop_na` argument.
36 41
#' @inheritParams finbif_records
37 42
#' @inheritParams finbif_occurrence
38 43
#' @return A `data.frame`, or if `count_only =  TRUE` an integer.
@@ -53,7 +58,8 @@
Loading
53 58
  file, select, n = -1, count_only = FALSE, quiet = FALSE,
54 59
  cache = getOption("finbif_use_cache"), dwc = FALSE, date_time_method,
55 60
  tzone = getOption("finbif_tz"), write_file = tempfile(), dt, keep_tsv = FALSE,
56 -
  facts = list(), type_convert_facts = TRUE, drop_na = FALSE
61 +
  facts = list(), type_convert_facts = TRUE, drop_na = FALSE,
62 +
  drop_na_facts = drop_na
57 63
) {
58 64
59 65
  file <- preprocess_data_file(file)
@@ -191,7 +197,8 @@
Loading
191 197
    )
192 198
193 199
    facts_df <- spread_facts(
194 -
      facts_df, facts[[fact_type]], fact_type, id, type_convert_facts
200 +
      facts_df, facts[[fact_type]], fact_type, id, type_convert_facts,
201 +
      drop_na_facts
195 202
    )
196 203
197 204
    select[["user"]] <- c(
@@ -210,12 +217,15 @@
Loading
210 217
211 218
    short_nms <- short_nms[names(df)]
212 219
213 -
    short_fcts <- unlist(facts)
220 +
    short_fcts <- grep("_fact__", names(df), value = TRUE)
214 221
215 -
    short_fcts <- gsub("http://tun.fi/", "", short_fcts)
222 +
    short_fcts <- sub("^.*_fact__", "", short_fcts)
223 +
224 +
    short_fcts <- sub("http://tun.fi/", "", short_fcts)
216 225
217 226
    short_fcts <- abbreviate(
218 -
      short_fcts, 8L, FALSE, strict = TRUE, method = "both.sides"
227 +
      short_fcts, 9 - ceiling(log10(length(short_fcts) + .1)), FALSE,
228 +
      strict = TRUE, method = "both.sides"
219 229
    )
220 230
    short_fcts <- paste0("f", seq_along(short_fcts), short_fcts)
221 231
@@ -249,13 +259,13 @@
Loading
249 259
250 260
  file <- as.character(file)
251 261
252 -
  ptrn <- "http://tun.fi/HBF."
262 +
  ptrn <- "^https?://.+?/HBF\\."
253 263
254 -
  is_url <- grepl(ptrn, file, fixed = TRUE)
264 +
  is_url <- grepl(ptrn, file)
255 265
256 266
  if (is_url) {
257 267
258 -
    file <- gsub(ptrn, "", file)
268 +
    file <- sub(ptrn, "", file)
259 269
260 270
  }
261 271
@@ -281,7 +291,7 @@
Loading
281 291
282 292
  if (grepl("^[0-9]*$", file)) {
283 293
284 -
    url <- sprintf("https://dw.laji.fi/download/HBF.%s", file)
294 +
    url <- sprintf("%s/HBF.%s", getOption("finbif_dl_url"), file)
285 295
286 296
    tsv <- sprintf("%sHBF.%s.tsv", tsv_prefix, file)
287 297
@@ -526,8 +536,18 @@
Loading
526 536
527 537
  Sys.sleep(1 / getOption("finbif_rate_limit"))
528 538
539 +
  query <- list()
540 +
541 +
  auth <- Sys.getenv("FINBIF_RESTRICTED_FILE_ACCESS_TOKEN")
542 +
543 +
  if (!identical(auth, "")) {
544 +
545 +
    query <- list(personToken = auth)
546 +
547 +
  }
548 +
529 549
  resp <- httr::RETRY(
530 -
    "GET", url, httr::write_disk(zip, overwrite = TRUE), progress
550 +
    "GET", url, httr::write_disk(zip, overwrite = TRUE), progress, query = query
531 551
  )
532 552
533 553
  if (!quiet) message("")
@@ -597,7 +617,7 @@
Loading
597 617
598 618
  args <- list(
599 619
    ..., nrows = 0, showProgress = quiet, data.table = dt, na.strings = "",
600 -
    quote = "\"", sep = "\t", fill = TRUE, check.names = FALSE, header = TRUE
620 +
    quote = "", sep = "\t", fill = TRUE, check.names = FALSE, header = TRUE
601 621
  )
602 622
603 623
  if (utils::hasName(args, "zip")) {
@@ -715,7 +735,7 @@
Loading
715 735
#' @noRd
716 736
rd_read <- function(x, file, tsv, n, select, keep_tsv) {
717 737
718 -
  df <- utils::read.delim(x, nrows = 1L, na.strings = "", quote = "\"")
738 +
  df <- utils::read.delim(x, nrows = 1L, na.strings = "", quote = "")
719 739
720 740
  cols <- fix_issue_vars(names(df))
721 741
@@ -772,7 +792,9 @@
Loading
772 792
}
773 793
774 794
#' @noRd
775 -
spread_facts <-  function(facts, select, type, id, type_convert_facts) {
795 +
spread_facts <-  function(
796 +
  facts, select, type, id, type_convert_facts, drop_na_facts
797 +
) {
776 798
777 799
  missing_facts <- character()
778 800
@@ -791,6 +813,8 @@
Loading
791 813
      " - could not be found in dataset", call. = FALSE
792 814
    )
793 815
816 +
    missing_facts <- missing_facts[!isTRUE(drop_na_facts)]
817 +
794 818
  }
795 819
796 820
  if (!all(is.na(ind))) {
@@ -836,7 +860,7 @@
Loading
836 860
837 861
  attr(facts, "id") <- id
838 862
839 -
  facts
863 +
  unique(facts)
840 864
841 865
}
842 866
@@ -1000,7 +1024,7 @@
Loading
1000 1024
1001 1025
  file <- tempfile(fileext = ".tsv")
1002 1026
1003 -
  write.table(df, file, quote = TRUE, sep = "\t", na = "", row.names = FALSE)
1027 +
  write.table(df, file, quote = FALSE, sep = "\t", na = "", row.names = FALSE)
1004 1028
1005 1029
  file
1006 1030

@@ -58,6 +58,21 @@
Loading
58 58
    col_md, col_count, by.x = "id", by.y = "aggregate_by", all.x = TRUE
59 59
  )
60 60
61 +
  collections[["data_description"]] <- collections[["description"]]
62 +
63 +
  collections[["description"]] <- ifelse(
64 +
    is.na(collections[["data_quality_description"]]),
65 +
    collections[["description"]],
66 +
    do.call(
67 +
      paste,
68 +
      list(
69 +
        collections[["description"]],
70 +
        collections[["data_quality_description"]],
71 +
        sep = "\nData_quality: "
72 +
      )
73 +
    )
74 +
  )
75 +
61 76
  row.names(collections) <- collections[["id"]]
62 77
  # Sometimes collections dont have a "has_children" field
63 78
  ind <- collections[["has_children"]]
@@ -182,7 +197,7 @@
Loading
182 197
183 198
get_swagger <- function(cache) {
184 199
185 -
  url <- "https://api.laji.fi/explorer/swagger.json"
200 +
  url <- paste0(getOption("finbif_api_url"), "/explorer/swagger.json")
186 201
187 202
  if (cache) {
188 203

@@ -179,16 +179,31 @@
Loading
179 179
    "aggregate"
180 180
  )
181 181
182 +
  abundance_vars <- c(
183 +
    "unit.interpretations.individualCount", "unit.abundanceString"
184 +
  )
185 +
186 +
  coordinates_uncertainty_vars <- c(
187 +
    "gathering.interpretations.coordinateAccuracy", "document.sourceId"
188 +
  )
189 +
190 +
  citation_vars <- c("document.documentId", "document.sourceId")
191 +
182 192
  if (missing(select)) {
183 193
184 194
    select <- row.names(default_vars)
185 195
    select_ <- default_vars[[var_type]]
186 196
    record_id_selected <- FALSE
187 197
188 198
    if (identical(aggregate, "none")) {
189 -
      # Missing 'select' implies default selection which implies date-time calc
190 -
      # needed
191 -
      select <- unique(c(select, row.names(date_time_vars)))
199 +
      # Missing 'select' implies default selection which implies date-time,
200 +
      # abundance and coord uncertainty calc needed
201 +
      select <- unique(
202 +
        c(
203 +
          select, row.names(date_time_vars), abundance_vars,
204 +
          coordinates_uncertainty_vars
205 +
        )
206 +
      )
192 207
      record_id_selected <- TRUE
193 208
    }
194 209
@@ -221,6 +236,42 @@
Loading
221 236
      select <- unique(c(select, date_time_vars[[var_type]]))
222 237
    }
223 238
239 +
    vars <- c(
240 +
      "abundance", "individualCount", "occurrence_status", "occurrenceStatus"
241 +
    )
242 +
243 +
    abundance <- any(vars %in% select)
244 +
245 +
    if (abundance) {
246 +
247 +
      select <- unique(c(select, var_names[abundance_vars, var_type]))
248 +
249 +
    }
250 +
251 +
    vars <- c("coordinates_uncertainty", "coordinateUncertaintyInMeters")
252 +
253 +
    coordinates_uncertainty <- any(vars %in% select)
254 +
255 +
    if (coordinates_uncertainty) {
256 +
257 +
      select <- unique(
258 +
        c(select, var_names[coordinates_uncertainty_vars, var_type])
259 +
      )
260 +
261 +
    }
262 +
263 +
    vars <- c("citation", "bibliographicCitation")
264 +
265 +
    citation <- any(vars %in% select)
266 +
267 +
    if (citation) {
268 +
269 +
      select <- unique(
270 +
        c(select, var_names[citation_vars, var_type])
271 +
      )
272 +
273 +
    }
274 +
224 275
    select_vars <- var_names[var_names[[select_type]], var_type, drop = FALSE]
225 276
    class(select_vars[[var_type]]) <- class(var_names[[var_type]])
226 277
    select <- translate(

@@ -101,14 +101,23 @@
Loading
101 101
102 102
#' @noRd
103 103
det_datetime_method <- function(method, n) {
104 +
104 105
  if (missing(method)) {
106 +
107 +
    method <- "none"
108 +
109 +
    n <- sum(ifelse(is.numeric(n) & n >= 0L, n, Inf))
110 +
105 111
    if (n < 1e5) {
112 +
106 113
      method <- "fast"
107 -
    } else {
108 -
      method <- "none"
114 +
109 115
    }
116 +
110 117
  }
118 +
111 119
  method
120 +
112 121
}
113 122
114 123
#' @noRd

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Everything is accounted for!

No changes detected that need to be reviewed.
What changes does Codecov check for?
Lines, not adjusted in diff, that have changed coverage data.
Files that introduced coverage data that had none before.
Files that have missing coverage data that once were tracked.

62 Commits

Hiding 1 contexual commits
+10
+10
Hiding 1 contexual commits
+1
+1
+7
+7
+18
+18
+1
+1
+3
+3
+2
+2
Hiding 1 contexual commits
-1
+1
-2
+8
+6
+2
+2
+2
+1
+1
Hiding 2 contexual commits
+20
+20
Hiding 8 contexual commits
+43
+43
Hiding 6 contexual commits Hiding 1 contexual commits Hiding 1 contexual commits Hiding 1 contexual commits Hiding 4 contexual commits
Hiding 3 contexual commits
+139
-139
+5
-134
+139
Hiding 1 contexual commits
Files Coverage
R 100.00%
Project Totals (19 files) 100.00%
Loading