parse_results <- function(r, results = FALSE) {
if(results) r <- r$results
dplyr::as_tibble(r)
}
parse_request <- function(request) {
s <- tibblify::tspec_df(
.names_to = "request_id",
"request_origin" = tibblify::tib_chr("requestOrigin"),
"request_label" = tibblify::tib_chr("requestLabel"),
tibblify::tib_df(
"collection",
.names_to = "collection",
"status" = tibblify::tib_chr("approved"),
tibblify::tib_chr("nrecords"),
),
tibblify::tib_variant("filters")
)
tibblify::tibblify(request, spec = s) %>%
dplyr::mutate(filter = purrr::map_chr(.data$filters, filter_to_str)) %>%
dplyr::select(-"filters") %>%
tidyr::unnest("collection") %>%
dplyr::mutate(nrecords = as_numeric(.data$nrecords)) %>%
dplyr::arrange(.data$request_id) %>%
as.data.frame()
}
list_to_df <- function(l, type) {
df <- data.frame()
for(i in 1:length(l)) {
df <- dplyr::bind_rows(df, dplyr::mutate(dplyr::as_tibble(l[[i]]),
!!type := names(l)[i]))
}
df
}
null_to_na <- function(x) dplyr::if_else(is.null(x), as.character(NA), x)
progress_query <- function(current, max, by) {
to <- max - current
to <- ifelse(to > by, current + by, max)
message(" Records ", current + 1, " to ", to, " / ", max)
}
#' Convert to numeric if possible
#'
#' If possible, converts to numeric, otherwise returns unchanged.
#'
#' @param x Vector of values to be converted
#'
#' @keywords internal
as_numeric <- function(x) {
x1 <- suppressWarnings(as.numeric(as.character(x)))
if(any(!is.na(x[is.na(x1)]))) x1[is.na(x1)] <- x[is.na(x1)]
x1
}
capture_df <- function(x) {
o <- utils::capture.output(utils::head(as.data.frame(x)))
if(nrow(x) > 6) o <- c(o, "...")
paste0(o, collapse = "\n")
}
# Pipe operator -------------------------------
#' Pipe operator
#'
#' See \code{magrittr::\link[magrittr]{\%>\%}} for details.
#'
#' @name %>%
#' @rdname pipe
#' @keywords internal
#' @export
#' @importFrom magrittr %>% %T>%
#' @usage lhs \%>\% rhs
NULL
# Tidy eval helpers -------------------------
#' Tidy eval helpers
#'
#' @description
#'
#' * \code{\link[rlang]{sym}()} creates a symbol from a string and
#' \code{\link[rlang]{syms}()} creates a list of symbols from a
#' character vector.
#'
#' * \code{\link[rlang]{expr}()} and \code{\link[rlang]{quo}()} quote
#' one expression. `quo()` wraps the quoted expression in a quosure.
#'
#' The plural variants [rlang::exprs()] and
#' \code{\link[rlang]{quos}()} return a list of quoted expressions or
#' quosures.
#'
#' * \code{\link[rlang]{enexpr}()} and \code{\link[rlang]{enquo}()}
#' capture the expression supplied as argument by the user of the
#' current function (`enquo()` wraps this expression in a quosure).
#'
#' \code{\link[rlang]{enexprs}()} and \code{\link[rlang]{enquos}()}
#' capture multiple expressions supplied as arguments, including
#' `...`.
#'
#' `exprs()` is not exported to avoid conflicts with `Biobase::exprs()`,
#' therefore one should always use `rlang::exprs()`.
#'
#' To learn more about tidy eval and how to use these tools, visit
#' <http://rlang.r-lib.org> and the [Metaprogramming
#' section](https://adv-r.hadley.nz/meta.html) of [Advanced
#' R](https://adv-r.hadley.nz).
#'
#' @importFrom rlang .data := .env
#' @md
#' @name tidyeval
#' @keywords internal
#' @export .data
NULL
nc_deprecate <- function(new){
.Deprecated(msg = paste0(as.character(sys.call(sys.parent()))[1L],
" is deprecated, use ", new, " instead"))
}
have_auth <- function(){
Sys.getenv("naturecounts_steffilazerte2") != ""
}
#' Remove in-memory cache
#'
#' All server queries are cached for four hours to reduce server load. You can
#' reset the cache at any time by either restarting your R session or running
#' `nc_remove_cache()`.
#'
#' @return `TRUE` if it worked
#' @export
#'
#' @examples
#'
#' nc_remove_cache()
#'
nc_remove_cache <- function() {
memoise::forget(srv_query)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.