Fix remaining issues found by R CMD check

- rebuild links to stored datasets using `system.file()`
- correct link given in suggest_workflow() from galaxias to corella
- remove unused occurrence_exemplar.csv
- remove mytests.R

DESCRIPTION

@@ -33,7 +33,6 @@ Imports:
   uuid
 Suggests:
   gt,
-  here,
   knitr,
   nanoparquet,
   ozmaps,

R/check.R

@@ -435,11 +435,9 @@ check_mismatch_code_country <- function(.df,
   #   cli::cli_warn(bullets)
   # }
 
-
-
   lookup_country <- country_codes$country_name[country_codes$code %in% x]
   correct_country <- country_codes$country_name
-  if(lookup_country != df$countryCode[1]){
+  if(lookup_country != .df$countryCode[1]){
     bullets <- c("Country code in {.field {x}} does not correspond to country.",
                  i = "Did you mean {lookup_country}?"
     )

R/check_occurrences.R

@@ -54,8 +54,7 @@ check_dataset <- function(.df){
   invisible() # prevent df results from printing with headers
 
   # check all checkable fields, save fields & error messages
-  check_results <-
-    check_functions_names |>
+  check_results <- check_functions_names |>
     map(~ check_all(.x, .df, checkable_fields)) |>
     bind_rows()
 
@@ -81,7 +80,7 @@ check_dataset <- function(.df){
     results_split <- check_results |>
       unnest(.data$messages) |>
       mutate(
-        term = factor(term, levels = unique(term)) # maintain original term order
+        term = factor(.data$term, levels = unique(.data$term)) # maintain original term order
         ) |>
       group_split(.data$term)
 
@@ -264,13 +263,14 @@ check_min_req_dwc <- function(checkable_fields) {
   # message
   dwc_spinny_message(glue("Data meets minimum Darwin Core requirements"))
 
-  complies_text <- "Data meets minimum Darwin Core requirements"
   if(isTRUE(is_dwc_compliant)) {
+    complies_text <- "Data meets minimum Darwin Core requirements"
     cli::cli_status_clear()
     cat_line(glue("{col_green(symbol$tick)} {complies_text}"))
   } else {
+    noncomplies_text <- "Data does not meet minimum Darwin Core requirements"
     cli::cli_status_clear()
-    cat_line(glue("{col_red(symbol$cross)} {complies_text}"))
+    cat_line(glue("{col_red(symbol$cross)} {noncomplies_text}"))
     cli_bullets(c(i = "Use `suggest_workflow()` to see more information."))
   }
 

R/data_functions.R

@@ -12,14 +12,14 @@
 #' @rdname accepted_terms
 #' @export
 occurrence_terms <- function(){
-  darwin_core_terms |>
+  corella::darwin_core_terms |>
     dplyr::pull(.data$term)
 }
 
 #' @rdname accepted_terms
 #' @export
 event_terms <- function(){
-  darwin_core_terms |>
+  corella::darwin_core_terms |>
     dplyr::filter(.data$class %in% c("Generic", "Event", "Location")) |>
     dplyr::pull(.data$term)
 }

R/suggest_workflow.R

@@ -218,7 +218,8 @@ suggest_functions_message <- function(suggested_functions,
 
   # add pipe when there are multiple suggested functions
   if(length(suggested_functions) > 1) {
-    suggested_functions_piped <- c(paste0(head(suggested_functions, -1), " |> "), tail(suggested_functions, 1))
+    suggested_functions_piped <- c(paste0(utils::head(suggested_functions, -1), " |> "),
+                                   utils::tail(suggested_functions, 1))
   } else {
     suggested_functions_piped <- suggested_functions
   }
@@ -273,7 +274,7 @@ additional_functions_message <- function(optional_functions,
     cli_text(paste0("Based on your matched terms, you can also add to your pipe: ", "\n"))
     cli_bullets(c("*" = optional_functions_message))
   }
-  cli_bullets(c("i" = col_grey("See all `use_` functions at {.url https://galaxias.ala.org.au/reference/index.html#add-darin-core-terms}")))
+  cli_bullets(c("i" = col_grey("See all `use_` functions at http://corella.ala.org.au/reference/index.html#add-rename-or-edit-columns-to-match-darwin-core-terms")))
 }
 
 
@@ -407,41 +408,41 @@ build_req_terms_table <- function(req_terms) {
   # Unnest & concatenate terms by group
   missing_results <- req_terms |>
     select(-"matched") |>
-    unnest(cols = c(missing)) |>
+    unnest(cols = c(.data$missing)) |>
     group_by(.data$term_group) |>
     mutate( # glue names
-      missing = ansi_collapse(missing, sep = ", ", last = ", ")
+      missing = ansi_collapse(.data$missing, sep = ", ", last = ", ")
     ) |>
     unique()
 
   matched_results <- req_terms |>
     select(-"missing") |>
-    unnest(cols = c(matched)) |>
+    unnest(cols = c(.data$matched)) |>
     group_by(.data$term_group) |>
     mutate( # glue names
-      matched = ansi_collapse(matched, sep = ", ", last = ", ")
+      matched = ansi_collapse(.data$matched, sep = ", ", last = ", ")
     ) |>
     unique()
 
   req_terms_message <- missing_results |>
     full_join(matched_results,
-              join_by(term_group, result)) |>
+              join_by("term_group", "result")) |>
     # remove other Identifier terms if one or more are matched
     mutate(
       missing = case_when(
-        term_group == "Identifier (at least one)" & !is.na(matched) ~ NA,
-        .default = missing
+        .data$term_group == "Identifier (at least one)" & !is.na(.data$matched) ~ NA,
+        .default = .data$missing
         )) |>
     # add blank space for correct message formatting
     tidyr::replace_na(list(missing = stringr::str_pad("-", width = 16, side = "right"),
                            matched = stringr::str_pad("-", width = 16, side = "right")))
 
   # Group terms found vs missing
   pass <- req_terms_message |>
-    filter(result == "pass")
+    filter(.data$result == "pass")
 
   failed <- req_terms_message |>
-    filter(result == "fail")
+    filter(.data$result == "fail")
 
   pass_group <- glue("{pass$term_group}")
   pass_matched <- glue("{pass$matched}")
@@ -576,8 +577,8 @@ check_required_terms <- function(user_column_names) {
   # convert empty row value to NULL
   result <- all_terms |>
     mutate(
-      missing = lapply(missing, function(x) if(identical(x, character(0))) NULL else x),
-      matched = lapply(matched, function(x) if(identical(x, character(0))) NULL else x)
+      missing = lapply(.data$missing, function(x) if(identical(x, character(0))) NULL else x),
+      matched = lapply(.data$matched, function(x) if(identical(x, character(0))) NULL else x)
     )
 
   return(result)

R/use_abundance.R

@@ -116,9 +116,9 @@ check_individualCount <- function(.df,
 
         # make sure 0s are tagged as absences in occurrenceStatus
         absences <- .df |>
-          select(individualCount, occurrenceStatus) |>
-          filter(individualCount == 0) |>
-          mutate(match = individualCount == 0 & occurrenceStatus == "absent")
+          select("individualCount", "occurrenceStatus") |>
+          filter(.data$individualCount == 0) |>
+          mutate(match = .data$individualCount == 0 & .data$occurrenceStatus == "absent")
 
         if(any(absences$match == FALSE)) {
           n_unmatched <- absences |>
@@ -186,7 +186,7 @@ check_organismQuantityType <- function(.df,
   level <- match.arg(level)
   if(any(colnames(.df) == "organismQuantityType")){
     .df |>
-      select(organismQuantityType) |>
+      select("organismQuantityType") |>
       check_is_string(level = level)
 
     if (!any(colnames(.df) == "organismQuantity")) {

R/use_measurements.R

@@ -38,11 +38,9 @@ use_measurements <- function(
 
   nested_df <- .df |>
     # add row number for id
-    mutate(
-      padded_row_number = stringr::str_pad(row_number(), floor(log10(row_number())) + 1, pad = '0')
-      ) |>
+    mutate(padded_row_number = sequential_id()) |>
     # NOTE: Must use group_split to preserve grouping by row, not an unexpected grouping (ie force rowwise)
-    group_split(row_number(), .keep = FALSE) |>
+    group_split(dplyr::row_number(), .keep = FALSE) |>
     purrr::map_dfr( ~ .x |>
                       nest(measurementOrFact = c(padded_row_number, !!!fn_quos)))
 
@@ -53,7 +51,7 @@ use_measurements <- function(
   result <- nested_df |>
     dplyr::mutate(
       measurementOrFact = purrr::map(
-        measurementOrFact,
+        .data$measurementOrFact,
         ~ .x |>
           pivot_longer(names_to = "column_name",
                        values_to = "measurementValue",

R/use_sf.R

@@ -39,8 +39,7 @@ use_sf <- function(
   names(fn_quos) <- fn_args
 
   fn_quo_is_null <- fn_quos |>
-    purrr::map(\(user_arg)
-               rlang::quo_is_null(user_arg)) |>
+    map(.f = rlang::quo_is_null) |>
     unlist()
 
   # detect sf and handle sf objects
@@ -59,28 +58,28 @@ use_sf <- function(
 
     } else {
 
-    # if geometry arg has been named, save the name
-    if(!any(fn_quo_is_null)) {
+      # if geometry arg has been named, save the name
+      if(!any(fn_quo_is_null)) {
 
-      col_name_sfc <- paste0(get_expr(fn_quos$geometry)) # save name
+        col_name_sfc <- paste0(get_expr(fn_quos$geometry)) # save name
 
-      # check if column name is in the dataframe
-      if(!col_name_sfc %in% colnames(.df)) {
-        bullets <- c(
-          "Must specify an existing 'geometry' column.",
-          x = "Column '{col_name_sfc}' doesn't exist."
-        ) |> cli_bullets() |> cli_fmt()
+        # check if column name is in the dataframe
+        if(!col_name_sfc %in% colnames(.df)) {
+          bullets <- c(
+            "Must specify an existing 'geometry' column.",
+            x = "Column '{col_name_sfc}' doesn't exist."
+          ) |> cli_bullets() |> cli_fmt()
 
-        cli_abort(bullets)
-      }
+          cli_abort(bullets)
+        }
 
-    } else {
+      } else {
 
-      # get column name that holds 'geometry'
-      col_name_sfc <- .df |>
-        select(which(sapply(.df, class) == 'sfc_POINT')) |> # might be overcomplicating `select(geometry)`
-        colnames()
-    }
+        # get column name that holds 'geometry'
+        col_name_sfc <- .df |>
+          select(which(sapply(.df, class) == 'sfc_POINT')) |> # might be overcomplicating `select(geometry)`
+          colnames()
+      }
     }
   }
 
@@ -94,7 +93,10 @@ use_sf <- function(
   # Add sf coords if valid
   check_coords(.df, level = "abort")
 
-  result <- col_sf_to_dwc(.df, col_name_sfc, level = level) |>
+  result <- col_sf_to_dwc(.df,
+                          col_name_sfc
+                          # level = level
+                          ) |>
     st_drop_geometry()
 
   cli_warn("{.field {col_name_sfc}} dropped from data frame.")
@@ -133,7 +135,7 @@ check_is_sf <- function(.df,
       "No geometry detected.",
       i = "Must supply {.code use_sf()} a dataframe with an {.pkg sf} geometry (i.e. {.code st_POINT})."
     ) |> cli_bullets() |> cli_fmt()
-    cli_abort(bullets)
+    cli_abort(bullets) # FIXME: this ignores 'level' argument
   }
   .df
 }
@@ -150,8 +152,7 @@ check_is_point <- function(.df,
   # enforce POINT geometry
   if (any(st_geometry_type(.df, by_geometry = FALSE) != "POINT")) {
     sf_type <- st_geometry_type(.df, by_geometry = FALSE)
-    cli_abort(".df geometry must be of type 'POINT', not '{sf_type}'.")
-
+    cli_abort(".df geometry must be of type 'POINT', not '{sf_type}'.") # FIXME: this ignores 'level' argument
   }
   .df
 }
@@ -193,7 +194,7 @@ check_has_crs <- function(.df,
 #' @keywords Internal
 col_sf_to_dwc <- function(.df,
                           col_name,
-                          level = c("inform", "warn", "abort"),
+                          # level = c("inform", "warn", "abort"), # unused
                           call = caller_env()
                           ){
   result <- .df |>