A generalised solution to deprecate switch functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: austraits
 Title: Helpful functions to access, summarise and wrangle austraits data
-Version: 2.2.3
+Version: 3.0.0.9000
 Authors@R:
     c(person(given = "Daniel",
              family = "Falster",
@@ -22,7 +22,7 @@ Encoding: UTF-8
 Language: en
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Depends: 
     R (>= 4.0.0),
     RefManageR
@@ -39,7 +39,9 @@ Imports:
     utils,
     magrittr,
     janitor,
-    lifecycle
+    lifecycle,
+    tibble,
+    cli
 Suggests: 
     ggplot2,
     ggpointdensity,

NEWS.md

@@ -1,2 +1,5 @@
-# austraits 2.2.1
+# austraits 3.0.0.9000
 - Updated dependencies, placing graphics related packages in Suggests
+- Added internal function to check the compatibility of databases
+- Added internal function notify users that some database versions will not be supported
+- No longer support AusTraits version <5.0.0 in `extract_*` functions

R/austraits-package.R

@@ -56,5 +56,7 @@ utils::globalVariables(c("..density..",
                        "x",
                        "y", 
                        "publication_date",
-                       "doi")
+                       "doi",
+                       "relation_type",
+                       "identifier")
 )

R/bind_trait_values.R

@@ -9,7 +9,7 @@
 #' @examples 
 #' \dontrun{
 #' traits <- austraits$traits %>% 
-#' dplyr::filter(dataset_id == "Falster_2005_1")
+#' dplyr::filter(dataset_id == "ABRS_1981")
 #' traits
 #' traits_bind <- bind_trait_values(traits)
 #' }
@@ -28,6 +28,7 @@ bind_trait_values <- function(trait_data) {
         .data %>% 
           dplyr::mutate(value = bind_x(.data$value),
                         value_type = bind_x(value_type),
+                        basis_of_value = bind_x(basis_of_value),
                         replicates = bind_x(replicates)) %>%
           dplyr::filter(dplyr::row_number()==1) 
       )
@@ -36,8 +37,8 @@ bind_trait_values <- function(trait_data) {
   }
 
   trait_data  %>% 
-    dplyr::group_by(observation_id, trait_name) %>% 
+    dplyr::group_by(dataset_id, observation_id, trait_name, method_id, method_context_id, repeat_measurements_id) %>% 
     bind_values_worker() %>% 
     dplyr::ungroup() %>% 
-    dplyr::arrange(observation_id, trait_name, value_type)
+    dplyr::arrange(dataset_id, observation_id, trait_name, value_type, method_id, method_context_id, repeat_measurements_id)
 }

R/check_compatibility.R

@@ -0,0 +1,41 @@
+#' @title Check compatibility
+#' @description Function to check whether the data object has been compiled by the traits.build workflow and 
+#' therefore has a data structure that is appropriate for use with austraits functions.
+#' @param austraits dataframe generated by traits build
+#'
+#' @return logical (T/F) output and messaging for uncompatible versions
+#'
+#' @examples
+#' \dontrun{
+#' check_compatibility(austraits)
+#' }
+#' @author Elizabeth Wenk - e.wenk@unsw.edu.au
+
+check_compatibility <- function(austraits) {
+
+  if (is.null(austraits$metadata)) {
+
+    compatible <- FALSE
+
+    # message("You are working with AusTraits version 3.0 or earlier. \nThis database structure is unsupported by the current version of this package. \nPlease see https://github.com/traitecoevo/austraits for details on installing old versions of the package.")
+
+  } else {
+
+    compiled_by_traits.build <-
+      austraits$metadata$related_identifiers %>% 
+      util_list_to_df2() %>%
+      filter(relation_type == "isCompiledBy", stringr::str_detect(identifier, "github.com/traitecoevo/traits.build"))
+
+    if(is.null(compiled_by_traits.build) | nrow(compiled_by_traits.build) > 0) {
+      compatible <- TRUE
+    } else{
+      compatible <- FALSE
+
+      # message("You are working with AusTraits version 4, which is unsupported by the current version of this package. \nPlease see https://github.com/traitecoevo/austraits for details on installing old versions of the package.")
+    }
+
+  }
+
+  invisible(compatible)
+
+}

R/extract_dataset.R

@@ -5,7 +5,7 @@
 #' @param austraits - A large list of tibbles built from austraits
 #' @param dataset_id - character string that matches a dataset_id in the data
 #' @return A large list of tibbles containing all austraits information for one particular dataset
-#'
+#' @details `extract_dataset()` no longer supports AusTraits version <= 5.0.0, see [this page](https://github.com/traitecoevo/austraits) for details. `r lifecycle::badge("deprecated")` 
 #' @examples
 #' \dontrun{
 #' extract_dataset(austraits, "Falster_2003")
@@ -15,10 +15,14 @@
 
 
 extract_dataset <- function(austraits, dataset_id) {
+
+  # Check compatability
+  status <- suppressMessages(check_compatibility(austraits))
+
   # Switch for different versions
   version <- what_version(austraits)
 
-  if(what_version(austraits) %in% c("4-series", "5-series")){
+  if(what_version(austraits) %in% "5-series" | status){
     version <- "new" 
   } else
     version <- "old"
@@ -29,43 +33,8 @@ extract_dataset <- function(austraits, dataset_id) {
   )
 }
 
-#' @title Extract specific dataset from austraits object for versions <=3.0.2
-#' @rdname extract_dataset
-extract_dataset1 <- function(austraits, dataset_id){
-  austraits$taxonomic_updates <-
-    tidyr::separate_rows(austraits$taxonomic_updates, dataset_id, sep=" ")
-
-  ret <- list()
-  for(v in c("traits", "sites", "contexts", "methods", "excluded_data", "taxonomic_updates",  "contributors"))
-    ret[[v]] <- austraits[[v]][ austraits[[v]][["dataset_id"]] %in% dataset_id,]
-  # NB: can't use dplyr::filter in the above as it doesn't behave when the variable name is the same as a column name
-
-  ret[["taxa"]] <- austraits[["taxa"]] %>% dplyr::filter(taxon_name %in% ret[["traits"]][["taxon_name"]])
-
-  ret[["definitions"]] <- austraits[["definitions"]]
-  ret[["build_info"]] <- austraits[["build_info"]]
-
-  keys <- dplyr::union(ret$methods$source_primary_key, 
-                       ret$methods$source_secondary_key %>% strsplit("; ") %>% unlist()) %>% 
-    unique() %>% stats::na.omit() %>% as.character()
-
-  ret[["sources"]] <- austraits$sources[keys]
-
-  ret[["sources"]] <- austraits[["sources"]][keys]
-
-  assertthat::are_equal(sort(names(austraits)), sort(names(ret)))
-
-  ret[names(austraits)]
-
-  # Assign class
-  attr(ret, "class") <- "austraits"
-
-  ret
-}
-
-
 #' @title Extract specific dataset from austraits object for versions >3.0.2
-#' @rdname extract_dataset
+#' @noRd 
 
 extract_dataset2 <- function(austraits, dataset_id){
   austraits$taxonomic_updates <-
@@ -82,6 +51,7 @@ extract_dataset2 <- function(austraits, dataset_id){
   ret[["definitions"]] <- austraits[["definitions"]]
   ret[["build_info"]] <- austraits[["build_info"]]
   ret[["schema"]] <- austraits[["schema"]]
+  ret[["metadata"]] <- austraits[["metadata"]]
 
   keys <- dplyr::union(ret$methods$source_primary_key, 
                        ret$methods$source_secondary_key %>% strsplit("; ") %>% unlist()) %>% 
@@ -100,3 +70,15 @@ extract_dataset2 <- function(austraits, dataset_id){
 
   ret
 }
+
+
+#' @title Extract specific dataset from austraits object for versions <=3.0.2
+#' @noRd
+
+extract_dataset1 <- function(austraits, dataset_id){
+
+  function_not_supported(austraits)
+
+  }
+
+

R/extract_taxa.R

@@ -16,22 +16,18 @@
 #' @export
 
 extract_taxa <- function(austraits, family = NULL, genus = NULL, taxon_name = NULL){
-  # Switch for different versions
-  version <- what_version(austraits)
+  # Check compatability
+  status <- check_compatibility(austraits)
 
-  if(what_version(austraits) %in% c("4-series", "5-series")){
-    version <- "new" 
+  # If compatible
+  if(status){
+    extract_taxa2(austraits, family, genus, taxon_name)
   } else
-    version <- "old"
-
-  switch (version,
-          'new' = extract_taxa2(austraits, family, genus, taxon_name),
-          'old' = extract_taxa1(austraits, family, genus, taxon_name),
-  )
+    function_not_supported(austraits)
 }
 
 
-#'Extract taxa >3.0.2
+#'Extract taxa for supported versions of databases
 #' @noRd
 #' @keywords internal
 extract_taxa2 <- function(austraits, family = NULL, genus = NULL, taxon_name = NULL){
@@ -98,75 +94,6 @@ extract_taxa2 <- function(austraits, family = NULL, genus = NULL, taxon_name = N
 }
 
 
-#'Extract taxa <=3.0.2
-#' @noRd
-#' @keywords internal
-extract_taxa1 <- function(austraits, family = NULL, genus = NULL, taxon_name = NULL){
-
-  ret <- austraits
-
-  if(missing(family) & missing(genus) & missing(taxon_name)){
-    abort("Either `family`, `genus` or `taxon_name`, must be supplied!")
-  }
-
-  if( ! is.null(family) ){
-    # Retrieving all taxon name that falls under family
-    target_in <- stringr::str_which(austraits$taxa$family, paste(family, collapse = "|"))
-    target_taxa <- austraits$taxa %>% dplyr::slice(target_in) %>% dplyr::pull(taxon_name) 
-  }
-
-  if( ! is.null(genus) ){
-    # Retrieving all taxon name that falls under genus
-    target_in <- stringr::str_which(austraits$taxa$genus, paste(genus, collapse = "|"))
-    target_taxa <- austraits$taxa %>% dplyr::slice(target_in) %>% dplyr::pull(taxon_name) 
-  }
-
-  if( ! is.null(taxon_name)){
-    target_taxa <- taxon_name
-  }
-
-  # Extract data for target_sp
-  ret[["traits"]] <- ret[["traits"]] %>% 
-    dplyr::filter(taxon_name %in% target_taxa)
-
-  ids <- ret[["traits"]][["dataset_id"]] %>% unique() %>% sort()
-
-  ret[["sites"]] <- austraits[["sites"]] %>% dplyr::filter(site_name %in% ret[["traits"]][["site_name"]], dataset_id %in% ids)
-
-  ret[["contexts"]] <- austraits[["contexts"]] %>% dplyr::filter(context_name %in% ret[["traits"]][["context_name"]], dataset_id %in% ids)
-
-  ret[["taxa"]] <- austraits[["taxa"]] %>% dplyr::filter(taxon_name %in% ret[["traits"]][["taxon_name"]])
-
-  ret[["taxonomic_updates"]] <- austraits[["taxonomic_updates"]] %>% dplyr::filter(taxon_name %in% ret[["traits"]][["taxon_name"]])
-  # Fix formatting for dataset ids
-  ret$taxonomic_updates <-
-    tidyr::separate_rows(austraits$taxonomic_updates, dataset_id, sep=" ")
-
-  ret[["excluded_data"]] <- austraits[["excluded_data"]] %>% dplyr::filter(taxon_name %in% target_taxa)
-
-  ret[["contributors"]] <- austraits[["contributors"]] %>% dplyr::filter(dataset_id %in% ids)
-
-  ret[["methods"]] <- austraits[["methods"]] %>% dplyr::filter(dataset_id %in%ids)
-
-  ret[["definitions"]] <- austraits[["definitions"]]
-
-  ret[["build_info"]] <- austraits[["build_info"]]
-
-  # if numeric, convert to numeric
-  suppressWarnings(
-    ret[["traits"]][["value"]] <- ifelse(! is.na(ret[["traits"]][["unit"]]), 
-                                       as.numeric(ret[["traits"]][["value"]]),
-                                       ret[["traits"]][["value"]])
-
-  )
-
-  # Assign class
-  attr(ret, "class") <- "austraits"
-
-  ret
-}
-
-