R/collect_occurrences_count.R

In galah: Biodiversity Data from the GBIF Node Network

#' `collect()` for `type = "data/occurrences-count"`
#' @noRd
#' @keywords Internal
collect_occurrences_count <- function(.query){
  if(is_gbif()){
    collect_occurrences_count_gbif(.query)
  }else{
    collect_occurrences_count_la(.query)
  }
}

#' `collect()` for `type = "data/occurrences-count"` for gbif
#' @importFrom dplyr bind_rows
#' @importFrom httr2 url_parse
#' @importFrom purrr pluck
#' @noRd
#' @keywords Internal
collect_occurrences_count_gbif <- function(.query){
  result <- query_API(.query)
  if(length(result$facets) < 1 & !is.null(result$count)){ # first handle single values
    tibble(count = result$count)
  }else{
    # note: this only works for length(facets) == 1
    result_df <- result |>
      pluck(!!!list("facets", 1, "counts")) |>
      bind_rows()
    names(result_df)[1] <- .query$url |> 
      url_parse() |> 
      pluck("query", "facet")
    # names(result_df)[1] <- result |>
    #   pluck(!!!list("facets", 1, "field")) |>
    #   tolower()
    result_df
  }
}
  
#'  `collect()` for `type = "data/occurrences-count"` for living atlases
#' @importFrom dplyr bind_rows
#' @importFrom tibble tibble
#' @noRd
#' @keywords Internal
collect_occurrences_count_la <- function(.query){
  result <- query_API(.query)
  if(length(result$facetResults) < 1 & !is.null(result$totalRecords)){ # first handle single values
    tibble(count = result$totalRecords)
  }else{  # then when group_by() is specified
    clean_group_by(result, .query) |>
      bind_rows() |>
      clean_labels() |>
      arrange_counts(direction = .query$arrange$direction,
                     variable = .query$arrange$variable)
  }
}

#' Internal function to clean objects returned by group_by()
#' @importFrom dplyr bind_cols
#' @importFrom dplyr bind_rows
#' @importFrom dplyr select
#' @importFrom dplyr slice
#' @importFrom purrr pluck
#' @returns A list
#' @noRd
#' @keywords Internal
clean_group_by <- function(result, .query){
  access_list <- list(1, "fieldResult")
  if(inherits(.query$url, "data.frame")){
    added_cols <- select(.query$url, -url)  
    lapply(seq_along(result), function(a){
      # get list-cols and convert to df
      result_df <- pluck(result[[a]], !!!access_list) |> 
        bind_rows()
      # add supplied cols
      added_cols |>
        slice(a) |>
        bind_cols(result_df)      
    })
  }else{
    pluck(result, !!!access_list)
  }
}

#' Internal function to clean up columns when group_by() is specified
#' @importFrom dplyr all_of
#' @importFrom dplyr rename
#' @importFrom dplyr select
#' @noRd
#' @keywords Internal
clean_labels <- function(df){
  if(all(c("label", "i18nCode") %in% colnames(df))){
    dot_placement <- regexpr("\\.", df$i18nCode[1]) |>
      as.integer()
    field_name <- substr(df$i18nCode[1], 
                         start = 1, 
                         stop = dot_placement[1] - 1)
    col_lookup <- c("label")
    names(col_lookup) <- field_name
    df <- df |> 
      rename(all_of(col_lookup)) 
    df |> 
      select(-"fq", -"i18nCode")
  }else{
    # Some atlases (e.g. Estonia) only have "label" column
    if("label" %in% colnames(df) & !"i18nCode" %in% colnames(df)) {
      field_name <- stringr::str_extract(df$fq[1], "[^:]+") |> as.character()
      col_lookup <- c("label")
      names(col_lookup) <- field_name
      df <- df |>
        rename(all_of(col_lookup)) |>
        select(-"fq")
      df
    }
    df
  }
}

#' Internal function to arrange count df
#' @importFrom dplyr arrange
#' @importFrom dplyr desc
#' @noRd
#' @keywords Internal
arrange_counts <- function(df, 
                           direction = "descending",
                           variable = "count"){
  var_symbol <- as.symbol(variable)
  if(direction == "ascending" & variable == "count"){
    arrange(df, !!var_symbol)
  } else if(direction == "descending" & variable != "count"){
    arrange(df, dplyr::desc(!!var_symbol))
  } else {
    df
  }
}