Merge pull request #97 from data-mermaid/v1.0.4

mermaidr 1.0.4

.Rbuildignore

@@ -13,3 +13,4 @@ vignettes/
 ^import-demo$
 ^examples$
 ^scratch$
+_auth0.yml

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mermaidr
 Title: Interface to the 'MERMAID' API
-Version: 1.0.3
+Version: 1.0.4
 Authors@R: 
     c(person(given = "Sharla",
            family = "Gelfand",

NEWS.md

@@ -1,3 +1,7 @@
+# mermaidr 1.0.4
+
+* Add `project_id`, `site_id`, and `management_id` to `mermaid_get_summary_sampleevents()`
+
 # mermaidr 1.0.3
 
 * Fix bug with refreshing token in authentication flow, introduced in 1.0.2

R/mermaid_get_summary_sampleevents.R

@@ -17,7 +17,7 @@ mermaid_get_summary_sampleevents <- function(limit = NULL) {
   unpack_protocols(res)
 }
 
-summary_sampleevents_columns <- c("project", "tags", "country", "site", "latitude", "longitude", "reef_type", "reef_zone", "reef_exposure", "management", "sample_date", "data_policy_beltfish", "data_policy_benthiclit", "data_policy_benthicpit", "data_policy_benthicpqt", "data_policy_habitatcomplexity", "data_policy_bleachingqc", "project_notes", "site_notes", "management_notes", "contact_link", "protocols")
+summary_sampleevents_columns <- c("project_id", "project", "tags", "country", "site_id", "site", "latitude", "longitude", "reef_type", "reef_zone", "reef_exposure", "management_id", "management", "sample_date", "data_policy_beltfish", "data_policy_benthiclit", "data_policy_benthicpit", "data_policy_benthicpqt", "data_policy_habitatcomplexity", "data_policy_bleachingqc", "project_notes", "site_notes", "management_notes", "contact_link", "protocols")
 
 unpack_protocols <- function(x) {
   protocols_cols <- names(x[["protocols"]])

R/zzz_get_endpoint.R

@@ -10,7 +10,7 @@ get_endpoint <- function(endpoint = c("benthicattributes", "choices", "fishfamil
   res <- mermaid_GET(endpoint, limit = limit, filter = filter, ...)
 
   res_lookups <- purrr::map2(res, names(res), lookup_choices)
-  res_strip_name_suffix <- purrr::map(res_lookups, strip_name_suffix)
+  res_strip_name_suffix <- purrr::imap(res_lookups, strip_name_suffix)
 
   res_columns <- purrr::map2(res_strip_name_suffix, names(res_strip_name_suffix), construct_endpoint_columns)
 
@@ -128,7 +128,7 @@ construct_endpoint_columns <- function(x, endpoint) {
   dplyr::select(x, mermaid_endpoint_columns[[endpoint]])
 }
 
-strip_name_suffix <- function(results, covariates = FALSE) {
+strip_name_suffix <- function(results, endpoint, covariates = FALSE) {
   res_names <- names(results)
   # Remove any _name suffixes, except score_name since we want to keep both score and score_name
   # Convert score_name to score_NAME first (so _name isn't removed from it)
@@ -142,11 +142,22 @@ strip_name_suffix <- function(results, covariates = FALSE) {
 
   names(results) <- res_names
 
+  # Remove IDs, except project ID, sample event/unit ID, site ID (if covariates), or any other IDs included in the requested endpoint
+  results[, (!grepl("_id$", names(results))) | (names(results) %in% allowed_ids(endpoint, covariates = covariates))]
+}
+
+allowed_ids <- function(endpoint, covariates = FALSE) {
+  ids <- c("project_id", "sample_event_id", "sample_unit_id")
+
+  if (endpoint %in% names(mermaid_endpoint_columns)) {
+    ids <- c(ids, mermaid_endpoint_columns[[endpoint]][grepl("_id$", mermaid_endpoint_columns[[endpoint]])])
+  }
+
   if (covariates) {
-    results[, !grepl("_id$", names(results)) | names(results) %in% c("project_id", "site_id") | names(results) == "sample_event_id" | names(results) == "sample_unit_id"]
-  } else {
-    results[, !grepl("_id$", names(results)) | names(results) == "project_id" | names(results) == "sample_event_id" | names(results) == "sample_unit_id"]
+    ids <- c(ids, "site_id")
   }
+
+  unique(ids)
 }
 
 # Defined in respective function files

R/zzz_get_project_endpoint.R

@@ -73,7 +73,7 @@ get_project_single_endpoint <- function(endpoint, full_endpoint, limit = NULL, t
   }
 
   res_lookups <- lookup_choices(res, endpoint, endpoint_type = "project")
-  res_strip_suffix <- strip_name_suffix(res_lookups, covariates)
+  res_strip_suffix <- strip_name_suffix(res_lookups, endpoint, covariates)
   res <- construct_project_endpoint_columns(res_strip_suffix, endpoint, multiple_projects = length(initial_res) > 1, covariates = covariates)
 
   # Combine sample date year, month, day, into single field, place after management_rules