Merge pull request #236 from AtlasOfLivingAustralia/dev

Dev

.gitignore

@@ -12,3 +12,4 @@ docs/*
 /doc/
 /Meta/
 docs
+SECRETS.txt

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: galah
 Type: Package
 Title: Biodiversity Data from the GBIF Node Network
-Version: 2.0.1
+Version: 2.0.2
 Authors@R: 
     c(person(given = "Martin",
              family = "Westgate",
@@ -52,6 +52,7 @@ Suggests:
     knitr,
     magrittr,
     pkgdown,
+    reactable,
     rmarkdown,
     testthat
 License: MPL-2.0

NAMESPACE

@@ -57,6 +57,7 @@ export(galah_geolocate)
 export(galah_group_by)
 export(galah_identify)
 export(galah_polygon)
+export(galah_radius)
 export(galah_select)
 export(group_by)
 export(identify)
@@ -120,6 +121,7 @@ importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
 importFrom(dplyr,join_by)
+importFrom(dplyr,last_col)
 importFrom(dplyr,mutate)
 importFrom(dplyr,pull)
 importFrom(dplyr,relocate)
@@ -174,6 +176,7 @@ importFrom(rlang,caller_env)
 importFrom(rlang,enquo)
 importFrom(rlang,enquos)
 importFrom(rlang,eval_tidy)
+importFrom(rlang,expr_text)
 importFrom(rlang,f_lhs)
 importFrom(rlang,f_rhs)
 importFrom(rlang,format_error_bullets)
@@ -195,10 +198,12 @@ importFrom(rlang,quo_is_symbol)
 importFrom(rlang,quo_squash)
 importFrom(rlang,try_fetch)
 importFrom(rlang,warn)
+importFrom(sf,st_as_sf)
 importFrom(sf,st_as_sfc)
 importFrom(sf,st_as_text)
 importFrom(sf,st_bbox)
 importFrom(sf,st_cast)
+importFrom(sf,st_coordinates)
 importFrom(sf,st_crop)
 importFrom(sf,st_crs)
 importFrom(sf,st_geometry)
@@ -207,16 +212,19 @@ importFrom(sf,st_is_empty)
 importFrom(sf,st_is_simple)
 importFrom(sf,st_is_valid)
 importFrom(stringr,str_detect)
+importFrom(stringr,str_extract)
 importFrom(stringr,str_extract_all)
 importFrom(stringr,str_replace)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)
 importFrom(stringr,str_to_title)
+importFrom(stringr,str_trim)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
 importFrom(tidyr,drop_na)
 importFrom(tidyr,unnest_longer)
 importFrom(tidyselect,eval_select)
+importFrom(utils,URLdecode)
 importFrom(utils,URLencode)
 importFrom(utils,adist)
 importFrom(utils,unzip)

NEWS.md

@@ -1,3 +1,25 @@
+# galah 2.0.2
+
+### Minor improvements
+* Experimental `galah_geolocate(type = "radius")` added. Supports filtering by point location and radius (in km) (#216)
+* Support `galah_geolocate()` and associated sub-functions for GBIF queries
+* `galah_filter()` no longer fails when assertions are specified in `galah_filter()` (#199)
+* Improved behaviour and robustness of `atlas_species()`, particularly for other atlases (#234)
+* Improved behavior of `select()`, including supporting `atlas_species()` and adding new `group = "taxonomy"` option (#218)
+* Updated namematching services for SBDI (Sweden) (#210)
+* Add onLoad message so user is clear which organisation is being queried
+
+### Bug fixes
+* `collect_media()` no longer fails when a thumbnail is missing (#215)
+* `galah_filter()` parses apostrophes correctly in value names (#214)
+* `group_by() |> atlas_counts()` no longer truncates rows at 30 (#223, #198) 
+* Fix bug where `search_values()` did not return matched values
+* `show_values()` & `atlas_counts()` return correctly formatted values (#233)
+* `atlas_occurrences()` no longer overwrites returned field names with user-supplied ones
+* `galah_apply_profile()` now works as expected
+* List items are no longer truncated when using `show_values()` (#235)
+
+
 # galah 2.0.1
 
 ### Minor improvements

R/atlas_distributions.R

@@ -0,0 +1,37 @@
+#' Collect a set of expert distributions
+#' 
+#' Not exported yet as taxonomic queries are not yet optimized
+#' @param request optional `data_request` object: generated by a call to
+#' [galah_call()].
+#' @param identify `data.frame`: generated by a call to
+#' [galah_identify()].
+#' @param filter `data.frame`: generated by a call to
+#' [galah_filter()]
+#' @return An object of classes `sf`, `tbl`, `tbl_df` and `data.frame` 
+#' (aka a Simple feature collection) of distribution maps, with one column per
+#' map, and spatial data stored in the `geometry` column.
+#' @examples
+#' 
+#' x <- show_all(distributions) |>
+#'   slice_head(n = 4)
+#' 
+#' y <- galah_call() |>
+#'   filter(id == x$id) |>
+#'   atlas_distributions()
+#' ggplot() +
+#'   geom_sf(data = ozmap_country) +
+#'   geom_sf(data = st_as_sf(x))
+#' @noRd
+#' @keywords Internal
+atlas_distributions <- function(request = NULL, 
+                                filter = NULL,
+                                identify = NULL){
+  args <- as.list(environment()) # capture supplied arguments
+  .query <- check_atlas_inputs(args) # convert to `data_request` object
+  .query$type <- "distributions"
+  collect(.query)
+    # NOTE: 
+    # taxonomic queries *only* work for lsid's that specifically referenced;
+    # i.e. it acts more like `filter()` than `identify()`
+    # it could be made to act in a more 'taxonomic' way by calling `atlas_species()` first
+}

R/build.R

@@ -51,10 +51,21 @@ build_query <- function(identify = NULL,
     }
   }
   # merge
-  query <- list(fq = c(taxa_query, filter_query)) 
+  query <- list(fq = c(filter_query, taxa_query)) 
   # geographic stuff
   if (!is.null(location)) {
+    # if location is for a point radius vs polygon/bbox
+    if(!is.null(names(location))){
+      if(all(!is.null(location$radius))) { # `galah_radius()` will always pass radius argument
+        query$q <- paste0("*:*")
+        query$lon <- location$lon
+        query$lat <- location$lat
+        query$radius <- location$radius      
+    }else
+      query$wkt <- location
+    } else {
     query$wkt <- location
+    }
   }
   # add profiles information (ALA only)  
   if(pour("atlas", "region") == "Australia"){
@@ -68,11 +79,13 @@ build_query <- function(identify = NULL,
 }
 
 #' Build query list from constituent arguments for GBIF only
+#' @importFrom glue glue_data
+#' @importFrom potions pour
 #' @noRd
 #' @keywords Internal
-#' @importFrom potions pour
 build_query_gbif <- function(identify = NULL, 
-                             filter = NULL){
+                             filter = NULL,
+                             location = NULL){
   if(is.null(identify)) {
     taxa_query <- list(taxonKey = 1)
   }else{
@@ -91,8 +104,22 @@ build_query_gbif <- function(identify = NULL,
       filter_query <- build_filter_query(filter)
     }
   }
-  # return merged output
-  c(taxa_query, filter_query)
+  # merge
+  query <- c(taxa_query, filter_query)
+  # geographic stuff
+  if (!is.null(location)) {
+    # if location is for a point radius vs polygon/bbox
+    if(!is.null(names(location))){
+      if(all(!is.null(location$radius))) { # `galah_radius()` will always pass radius argument
+        query$geoDistance <- glue_data(location,
+                                       "{lat},{lon},{radius}km")
+      }else
+        query$geometry <- location
+    } else {
+      query$geometry <- location
+    }
+  }
+  query
 }
 
 #' collapse multiple fq args into one
@@ -101,8 +128,9 @@ build_query_gbif <- function(identify = NULL,
 build_single_fq <- function(query){
   if(any(names(query) == "fq")){
     # ensure all arguments from galah_filter are enclosed in brackets
+    # EXCEPT for assertions
     fq <- query$fq
-    missing_brackets <- !grepl("^\\(", fq)
+    missing_brackets <- !grepl("^\\(", fq) & !grepl("assertions", fq)
     if(any(missing_brackets)){
       fq[missing_brackets] <- paste0("(", fq[missing_brackets], ")")
     }
@@ -154,16 +182,6 @@ build_taxa_query <- function(ids) {
   }
 }
 
-#' Sub-function to convert assertions to logicals in `collect_occurrences()`
-#' @noRd
-#' @keywords Internal
-fix_assertion_cols <- function(df, assertion_cols) {
-  for (col in assertion_cols) {
-    df[[col]] <- as.logical(df[[col]])
-  }
-  df
-}
-
 #' Internal function to handle APIs that return complex outputs
 #' Currently only used by `collect_collection_values()`
 #' It is pretty messy, as:

R/build_checks.R

@@ -15,7 +15,7 @@ build_checks <- function(.query){
     # parse `data`, including supplied metadata
     # this assumes only one `data` field is available per `query_set`
     .query[[which(data_lookup)]] |>
-      add_metadata(metadata_results)     
+      add_metadata(metadata_results)
   }else if(any(names_vec %in% c("metadata/fields-unnest", 
                                 "metadata/profiles-unnest",
                                 "metadata/taxa-unnest"))){
@@ -43,7 +43,7 @@ parse_metadata <- function(names_vec, .query){
     !grepl("-unnest$", names_vec) # unnest functions only parse in collect()
   if(any(metadata_lookup)){
     metadata_names <- names_vec[metadata_lookup]
-    metadata_results <- lapply(.query[metadata_lookup], collect)
+    metadata_results <- lapply(.query[which(metadata_lookup)], collect)
     names(metadata_results) <- metadata_names   
     metadata_results
   }else{

R/build_predicates.R

@@ -2,30 +2,31 @@
 #' 
 #' predicates are JSON scripts for passing to GBIF offline downloads API.
 #' https://www.gbif.org/developer/occurrence
-#' @noRd
-#' @keywords Internal
 #' @importFrom potions pour
 #' @importFrom jsonlite toJSON 
 #' @importFrom jsonlite unbox
+#' @noRd
+#' @keywords Internal
 build_predicates <- function(
   df, # where df is returned by galah_filter()
+  location,
   format = "SIMPLE_CSV"
 ){ 
-
   if(nrow(df) < 1){
     return(NULL)
   }
 
-  predicates_list <- parse_predicates(df)
-  if(nrow(df) > 1){
+  predicates_list <- c(
+    parse_predicates(df),
+    parse_predicates_spatial(location))
+
+  if(length(predicates_list) > 1){
      predicates_list <- list(
       type = unbox("and"),
-      predicates = parse_predicates(df)
+      predicates = predicates_list
     )
-  }else{
-     predicates_list <- parse_predicates(df)[[1]]
   }
-
+  
   data_list <- list(
     creator = unbox(pour("user", "username", .pkg = "galah")),
     notificationAddresses = pour("user", "email", .pkg = "galah"),
@@ -37,7 +38,38 @@ build_predicates <- function(
   toJSON(data_list)
 }
 
-# parse galah_filter result into predicate format
+#' most code borrowed from `build_query_gbif()`
+#' @noRd
+#' @keywords Internal
+parse_predicates_spatial <- function(location){
+  if(!is.null(location)) {
+    # if location is for a point radius vs polygon/bbox
+    if(!is.null(names(location))){
+      if(all(!is.null(location$radius))) { # `galah_radius()` will always pass radius argument
+        list(type = unbox("geoDistance"),
+             latitude = unbox(location$lat),
+             longitude = unbox(location$lon),
+             distance = unbox(paste0(location$radius, "km"))) |>
+          list()
+      }else{
+        list(type = unbox("within"), 
+             geometry = unbox(location)) |>
+          list()
+      }
+    }else{
+      list(type = unbox("within"), 
+           geometry = unbox(location)) |>
+        list()
+    }
+  }else{
+    NULL
+  }
+}
+
+#' parse galah_filter result into predicate format
+#' @importFrom jsonlite unbox
+#' @noRd
+#' @keywords Internal
 parse_predicates <- function(df){
   json_text <- lapply(
     split(df, seq_len(nrow(df))),
@@ -58,8 +90,7 @@ parse_predicates <- function(df){
     names(json_text) <- NULL
     return(json_text)
 }
-# NOTE: currently missing: `within` (geolocate), `or`, `in`, `isNull`, `isNotNull`
-# Q: how to add taxonomic names to gbif schema?
+# NOTE: currently missing: `or`, `in`, `isNull`, `isNotNull`
 
 # test object:
 # df <- galah_filter(year == 1850)