From 17e3492138de701a65a0feff614f107d9dcf6010 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Fri, 1 Dec 2023 17:57:07 +0100 Subject: [PATCH 01/35] Refactor code and documentation. --- DESCRIPTION | 9 +- NAMESPACE | 113 +++---- R/assets-funs.R | 85 +++-- R/assets-utils.R | 20 ++ R/check-utils.R | 66 ++-- R/collections-query.R | 66 +--- R/conformance-query.R | 36 +- R/cql2-adv_comp.R | 4 +- R/cql2-funs.R | 4 +- R/cql2-text.R | 2 +- R/cql2-types.R | 62 ++++ R/deprec-funs.R | 160 --------- R/doc-funs.R | 117 +++++++ R/document-funs.R | 70 ---- R/ext_filter.R | 56 ++-- R/ext_query.R | 64 +--- R/extensions.R | 100 +++--- R/items-funs.R | 442 ++++++++----------------- R/items-query.R | 105 ++---- R/items-utils.R | 82 +---- R/links-funs.R | 21 ++ R/parse-utils.R | 91 +---- R/preview-utils.R | 2 +- R/print.R | 142 +++++--- R/query-funs.R | 75 ++--- R/queryables-query.R | 45 +-- R/request.R | 121 ++----- R/rstac-funs.R | 15 + R/rstac.R | 6 +- R/{stac_search.R => search-query.R} | 82 ++--- R/signatures.R | 58 ++-- R/stac-funs.R | 46 +++ R/stac-query.R | 38 +-- R/stac_version.R | 22 -- R/url-utils.R | 149 +++++---- man/RSTACDocument.Rd | 26 -- man/assets_filter.Rd | 29 -- man/assets_functions.Rd | 60 ++-- man/collections.Rd | 4 +- man/conformance.Rd | 6 +- man/doc_query.Rd | 19 -- man/ext_filter.Rd | 7 +- man/ext_query.Rd | 8 +- man/extensions.Rd | 75 ++--- man/items.Rd | 4 +- man/items_functions.Rd | 164 +++++---- man/print.Rd | 66 ++-- man/queryables.Rd | 4 +- man/request.Rd | 11 +- man/rstac.Rd | 6 +- man/sign_bdc.Rd | 2 +- man/sign_planetary_computer.Rd | 2 +- man/stac.Rd | 2 +- man/stac_search.Rd | 8 +- man/stac_version.Rd | 10 +- tests/testthat/test-assets_functions.R | 92 ++--- tests/testthat/test-examples.R | 18 +- tests/testthat/test-ext_filter.R | 20 +- tests/testthat/test-internals.R | 16 +- tests/testthat/test-items_functions.R | 60 ++-- tests/testthat/test-rstac_objs.R | 99 ++---- tests/testthat/test-signatures.R | 8 +- 62 files changed, 1382 insertions(+), 2020 deletions(-) create mode 100644 R/doc-funs.R delete mode 100644 R/document-funs.R create mode 100644 R/links-funs.R create mode 100644 R/rstac-funs.R rename R/{stac_search.R => search-query.R} (75%) create mode 100644 R/stac-funs.R delete mode 100644 R/stac_version.R delete mode 100644 man/RSTACDocument.Rd delete mode 100644 man/assets_filter.Rd delete mode 100644 man/doc_query.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 01565a7b..42e21e84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -65,13 +65,14 @@ Collate: 'conformance-query.R' 'collections-query.R' 'deprec-funs.R' - 'document-funs.R' + 'doc-funs.R' 'ext_filter.R' 'ext_query.R' 'extensions.R' 'items-funs.R' 'items-utils.R' 'items-query.R' + 'links-funs.R' 'message-utils.R' 'preview-utils.R' 'print.R' @@ -80,10 +81,12 @@ Collate: 'request.R' 'signatures.R' 'stac-query.R' - 'stac_search.R' - 'stac_version.R' + 'search-query.R' + 'stac-funs.R' + 'static-funs.R' 'url-utils.R' 'utils.R' 'rstac.R' + 'rstac-funs.R' Roxygen: list(markdown = TRUE) VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 0863c341..1f3fb9fb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(after_response,RSTACQuery) S3method(after_response,collection_id) S3method(after_response,collections) S3method(after_response,conformance) @@ -12,21 +11,18 @@ S3method(after_response,queryables) S3method(after_response,search) S3method(after_response,stac) S3method(as.character,cql2_filter) -S3method(assets_download,STACItem) -S3method(assets_download,STACItemCollection) S3method(assets_download,default) -S3method(assets_filter,STACItem) -S3method(assets_filter,STACItemCollection) -S3method(assets_rename,STACItem) -S3method(assets_rename,STACItemCollection) +S3method(assets_download,doc_item) +S3method(assets_download,doc_items) S3method(assets_rename,default) -S3method(assets_select,STACItem) -S3method(assets_select,STACItemCollection) +S3method(assets_rename,doc_item) +S3method(assets_rename,doc_items) S3method(assets_select,default) -S3method(assets_url,STACItem) -S3method(assets_url,STACItemCollection) +S3method(assets_select,doc_item) +S3method(assets_select,doc_items) S3method(assets_url,default) -S3method(before_request,RSTACQuery) +S3method(assets_url,doc_item) +S3method(assets_url,doc_items) S3method(before_request,collection_id) S3method(before_request,collections) S3method(before_request,conformance) @@ -37,76 +33,66 @@ S3method(before_request,items) S3method(before_request,queryables) S3method(before_request,search) S3method(before_request,stac) -S3method(check_subclass,RSTACDocument) -S3method(check_subclass,RSTACQuery) -S3method(endpoint,RSTACQuery) -S3method(endpoint,collection_id) -S3method(endpoint,collections) -S3method(endpoint,conformance) -S3method(endpoint,ext_filter) -S3method(endpoint,ext_query) -S3method(endpoint,item_id) -S3method(endpoint,items) -S3method(endpoint,queryables) -S3method(endpoint,search) -S3method(endpoint,stac) S3method(get_spatial,GEOMETRYCOLLECTION) S3method(get_spatial,character) S3method(get_spatial,list) S3method(get_spatial,sf) S3method(get_spatial,sfc) S3method(get_spatial,sfg) -S3method(has_assets,STACItem) -S3method(has_assets,STACItemCollection) S3method(has_assets,default) -S3method(items_as_sf,STACItem) -S3method(items_as_sf,STACItemCollection) -S3method(items_assets,STACItem) -S3method(items_assets,STACItemCollection) +S3method(has_assets,doc_item) +S3method(has_assets,doc_items) +S3method(items_as_sf,doc_item) +S3method(items_as_sf,doc_items) S3method(items_assets,default) -S3method(items_bbox,STACItem) -S3method(items_bbox,STACItemCollection) +S3method(items_assets,doc_item) +S3method(items_assets,doc_items) S3method(items_bbox,default) -S3method(items_compact,STACItemCollection) -S3method(items_datetime,STACItem) -S3method(items_datetime,STACItemCollection) +S3method(items_bbox,doc_item) +S3method(items_bbox,doc_items) +S3method(items_compact,doc_items) S3method(items_datetime,default) -S3method(items_fetch,STACItemCollection) -S3method(items_fields,STACItem) -S3method(items_fields,STACItemCollection) +S3method(items_datetime,doc_item) +S3method(items_datetime,doc_items) +S3method(items_fetch,doc_items) S3method(items_fields,default) -S3method(items_filter,STACItemCollection) -S3method(items_length,STACItem) -S3method(items_length,STACItemCollection) +S3method(items_fields,doc_item) +S3method(items_fields,doc_items) +S3method(items_filter,doc_items) S3method(items_length,default) -S3method(items_matched,STACItem) -S3method(items_matched,STACItemCollection) +S3method(items_length,doc_item) +S3method(items_length,doc_items) S3method(items_matched,default) -S3method(items_next,STACItemCollection) -S3method(items_reap,STACItem) -S3method(items_reap,STACItemCollection) +S3method(items_matched,doc_item) +S3method(items_matched,doc_items) +S3method(items_next,doc_items) S3method(items_reap,default) -S3method(items_sign,STACItem) -S3method(items_sign,STACItemCollection) +S3method(items_reap,doc_item) +S3method(items_reap,doc_items) S3method(items_sign,default) +S3method(items_sign,doc_item) +S3method(items_sign,doc_items) S3method(parse_params,ext_filter) S3method(parse_params,ext_query) S3method(parse_params,items) S3method(parse_params,search) -S3method(print,Conformance) -S3method(print,Queryables) -S3method(print,RSTACQuery) -S3method(print,STACCatalog) -S3method(print,STACCollection) -S3method(print,STACCollectionList) -S3method(print,STACItem) -S3method(print,STACItemCollection) S3method(print,cql2_filter) -S3method(stac_version,RSTACDocument) -S3method(stac_version,RSTACQuery) -S3method(stac_version,STACCollectionList) -S3method(subclass,RSTACDocument) -S3method(subclass,RSTACQuery) +S3method(print,doc_catalog) +S3method(print,doc_collection) +S3method(print,doc_collections) +S3method(print,doc_conformance) +S3method(print,doc_item) +S3method(print,doc_items) +S3method(print,doc_link) +S3method(print,doc_links) +S3method(print,doc_queryables) +S3method(print,rstac_query) +S3method(stac_version,doc_collections) +S3method(stac_version,doc_items) +S3method(stac_version,rstac_doc) +S3method(stac_version,rstac_query) +S3method(subclass,rstac_doc) +S3method(subclass,rstac_query) S3method(text_not_op,cql2_between_op) S3method(text_not_op,cql2_in_op) S3method(text_not_op,cql2_isnull_op) @@ -176,7 +162,6 @@ export(asset_eo_bands) export(asset_key) export(asset_raster_bands) export(assets_download) -export(assets_filter) export(assets_rename) export(assets_select) export(assets_url) @@ -201,7 +186,6 @@ export(items_datetime) export(items_fetch) export(items_fields) export(items_filter) -export(items_group) export(items_length) export(items_matched) export(items_next) @@ -213,6 +197,7 @@ export(queryables) export(sign_bdc) export(sign_planetary_computer) export(stac) +export(stac_read) export(stac_search) export(stac_version) importFrom(crayon,bold) diff --git a/R/assets-funs.R b/R/assets-funs.R index d28c6af6..c85fd038 100644 --- a/R/assets-funs.R +++ b/R/assets-funs.R @@ -1,8 +1,8 @@ #' @title Assets functions #' #' @description -#' These functions provide support to work with `STACItemCollection` and -#' `STACItem` item objects. +#' These functions provide support to work with `doc_items` and +#' `doc_item` item objects. #' #' \itemize{ #' \item `assets_download()`: Downloads the assets provided by the STAC API. @@ -23,7 +23,7 @@ #' asset using a named list or a function. #' } #' -#' @param items a `STACItem` or `STACItemCollection` object +#' @param items a `doc_item` or `doc_items` object #' representing the result of `/stac/search`, #' \code{/collections/{collectionId}/items} or #' \code{/collections/{collectionId}/items/{itemId}} endpoints. @@ -55,18 +55,18 @@ #' HTTP/HTTPS files, S3 (AWS S3) and GS (Google Cloud Storage). #' #' @param create_json a `logical` indicating if a JSON file with item -#' metadata (`STACItem` or `STACItemCollection`) must be created in the +#' metadata (`doc_item` or `doc_items`) must be created in the #' output directory. #' #' @param select_fn a `function` to select assets an item -#' (`STACItem` or `STACItemCollection`). This function receives as parameter +#' (`doc_item` or `doc_items`). This function receives as parameter #' the asset element and, optionally, the asset name. Asset elements #' contain metadata describing spatial-temporal objects. Users can provide #' a function to select assets based on this metadata by returning a #' logical value where `TRUE` selects the asset, and `FALSE` discards it. #' #' @param mapper either a named `list` or a `function` to rename assets -#' of an item (`STACItem` or `STACItemCollection`). In the case of a named +#' of an item (`doc_item` or `doc_items`). In the case of a named #' list, use ` = ` to rename the assets. The function #' can be used to rename the assets by returning a `character` string using #' the metadata contained in the asset object. @@ -104,17 +104,17 @@ #' #' \itemize{ #' \item `assets_download()`: returns the same input object item -#' (`STACItem` or `STACItemCollection`) where `href` properties point to +#' (`doc_item` or `doc_items`) where `href` properties point to #' the download assets. #' #' \item `assets_url()`: returns a character vector with all assets `href` -#' of an item (`STACItem` or `STACItemCollection`). +#' of an item (`doc_item` or `doc_items`). #' #' \item `assets_select()`: returns the same input object item -#' (`STACItem` or `STACItemCollection`) with the selected assets. +#' (`doc_item` or `doc_items`) with the selected assets. #' #' \item `assets_rename()`: returns the same input object item -#' (`STACItemCollection` or `STACItem`) with the assets renamed. +#' (`doc_items` or `doc_item`) with the assets renamed. #' } #' #' @examples @@ -199,7 +199,7 @@ assets_download <- function(items, #' @rdname assets_functions #' #' @export -assets_download.STACItem <- function(items, +assets_download.doc_item <- function(items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., @@ -242,7 +242,7 @@ assets_download.STACItem <- function(items, #' @rdname assets_functions #' #' @export -assets_download.STACItemCollection <- function(items, +assets_download.doc_items <- function(items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., @@ -259,44 +259,35 @@ assets_download.STACItemCollection <- function(items, ) download_fn <- fn } - # remove empty items items <- items_compact(items) items_max <- max(0, min(items_length(items), items_max)) - # verify if progress bar can be shown progress <- progress && items_max > 1 - if (progress) { pb <- utils::txtProgressBar(max = items_max, style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) } - items$features <- items$features[seq_len(items_max)] for (i in seq_len(items_max)) { - if (progress) { + if (progress) utils::setTxtProgressBar(pb, i) - } - items$features[[i]] <- assets_download( items = items$features[[i]], asset_names = asset_names, output_dir = output_dir, overwrite = overwrite, create_json = FALSE, download_fn = download_fn, ... ) } - # close progress bar - if (progress) { - close(pb) - } - if (create_json) { + if (create_json) cat(to_json(items), file = file.path(output_dir, "items.json")) - } - return(items) + items } #' @rdname assets_functions #' #' @export -assets_download.default <- assets_download.STACItem +assets_download.default <- assets_download.doc_item #' @rdname assets_functions #' @@ -308,7 +299,7 @@ assets_url <- function(items, asset_names = NULL, append_gdalvsi = FALSE) { #' @rdname assets_functions #' #' @export -assets_url.STACItem <- function(items, +assets_url.doc_item <- function(items, asset_names = NULL, append_gdalvsi = FALSE) { if (is.null(asset_names)) { @@ -332,7 +323,7 @@ assets_url.STACItem <- function(items, #' @rdname assets_functions #' #' @export -assets_url.STACItemCollection <- function(items, +assets_url.doc_items <- function(items, asset_names = NULL, append_gdalvsi = FALSE) { if (is.null(asset_names)) { @@ -357,7 +348,7 @@ assets_url.STACItemCollection <- function(items, #' @rdname assets_functions #' #' @export -assets_url.default <- assets_url.STACItem +assets_url.default <- assets_url.doc_item #' @rdname assets_functions #' @@ -369,33 +360,28 @@ assets_select <- function(items, ..., asset_names = NULL, select_fn = NULL) { #' @rdname assets_functions #' #' @export -assets_select.STACItem <- function(items, ..., +assets_select.doc_item <- function(items, ..., asset_names = NULL, select_fn = NULL) { exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) - + init_length <- length(items$assets) if (!is.null(asset_names)) { asset_names <- intersect(names(items$assets), asset_names) items$assets <- items$assets[asset_names] } - if (length(exprs) > 0) { if (!is.null(names(exprs))) .error("Select expressions cannot be named.") - for (i in seq_along(exprs)) { sel <- map_lgl(names(items$assets), function(key) { - val <- select_eval(key = key, asset = items$assets[[key]], - expr = exprs[[i]]) - return(val) + select_eval(key = key, asset = items$assets[[key]], expr = exprs[[i]]) }) items$assets <- items$assets[sel] } } - if (!is.null(select_fn)) { sel <- map_lgl(names(items$assets), function(key) { val <- select_exec(key = key, asset = items$assets[[key]], @@ -404,14 +390,17 @@ assets_select.STACItem <- function(items, ..., }) items$assets <- items$assets[sel] } - - return(items) + if (length(items$assets) == 0 && init_length > 0) + .warning(paste("Filter criteria did not match any asset.\n", + "Please, see `?assets_select` for more details on", + "how expressions are evaluated by `assets_select()`.")) + items } #' @rdname assets_functions #' #' @export -assets_select.STACItemCollection <- function(items, ..., +assets_select.doc_items <- function(items, ..., asset_names = NULL, select_fn = NULL) { items <- foreach_item( @@ -424,7 +413,7 @@ assets_select.STACItemCollection <- function(items, ..., #' @rdname assets_functions #' #' @export -assets_select.default <- assets_select.STACItem +assets_select.default <- assets_select.doc_item #' @rdname assets_functions #' @@ -436,7 +425,7 @@ assets_rename <- function(items, mapper = NULL, ...) { #' @rdname assets_functions #' #' @export -assets_rename.STACItem <- function(items, mapper = NULL, ...) { +assets_rename.doc_item <- function(items, mapper = NULL, ...) { dots <- list(...) if (is.function(mapper)) { new_names <- as.list(map_chr(items$assets, mapper, use_names = TRUE)) @@ -466,14 +455,14 @@ assets_rename.STACItem <- function(items, mapper = NULL, ...) { #' @rdname assets_functions #' #' @export -assets_rename.STACItemCollection <- function(items, mapper = NULL, ...) { +assets_rename.doc_items <- function(items, mapper = NULL, ...) { return(foreach_item(items, assets_rename, mapper = mapper, ...)) } #' @rdname assets_functions #' #' @export -assets_rename.default <- assets_rename.STACItem +assets_rename.default <- assets_rename.doc_item #' @rdname assets_functions #' @@ -485,7 +474,7 @@ has_assets <- function(items) { #' @rdname assets_functions #' #' @export -has_assets.STACItem <- function(items) { +has_assets.doc_item <- function(items) { if (!"assets" %in% names(items)) .error("Parameter `items` is not a valid.") return(length(items$assets) > 0) @@ -494,14 +483,14 @@ has_assets.STACItem <- function(items) { #' @rdname assets_functions #' #' @export -has_assets.STACItemCollection <- function(items) { +has_assets.doc_items <- function(items) { map_lgl(items$features, has_assets) } #' @rdname assets_functions #' #' @export -has_assets.default <- has_assets.STACItem +has_assets.default <- has_assets.doc_item #' @rdname assets_functions #' diff --git a/R/assets-utils.R b/R/assets-utils.R index 932d2fe3..ade3f611 100644 --- a/R/assets-utils.R +++ b/R/assets-utils.R @@ -52,3 +52,23 @@ select_exec <- function(key, asset, select_fn) { select_check_eval(val) return(val) } + +asset_download <- function(asset, + output_dir, + overwrite, ..., + download_fn = NULL) { + if (!is.null(download_fn)) + return(download_fn(asset)) + # create a full path name + path <- url_get_path(asset$href) + out_file <- path_normalize(output_dir, path) + dir_create(out_file) + make_get_request( + url = asset$href, + httr::write_disk(path = out_file, overwrite = overwrite), + ..., + error_msg = "Error while downloading" + ) + asset$href <- path + asset +} diff --git a/R/check-utils.R b/R/check-utils.R index 174ec588..f2200e04 100644 --- a/R/check-utils.R +++ b/R/check-utils.R @@ -19,49 +19,61 @@ #' #' @noRd .check_rfc_3339 <- function(datetime) { - # Standard regexp of RFC 3339 pattern_rfc <- "^\\d{4}-\\d{2}-\\d{2}?(T\\d{2}:\\d{2}:\\d{2}Z)?$" check_pattern <- grepl(pattern_rfc, datetime, perl = TRUE) - return(check_pattern) } -#' @title Utility functions -#' -#' @param obj an `object` to compare. -#' -#' @param expected a `character` with the expected classes. -#' -#' @noRd -.check_obj <- function(obj, expected) { - - obj_name <- as.character(substitute(obj, env = environment())) +check_link <- function(link) { + if (!is.list(link) || is.null(names(link))) + .error("Invalid doc_link object.") + if (!"href" %in% names(link)) + .error("Invalid doc_link object. Expecting `href` key.") + link +} - if (!inherits(obj, expected)) - .error("Invalid %s value in `%s` param.", - paste0("`", expected, "`", collapse = " or "), obj_name) +check_item <- function(items) { + if (!is.list(items) || is.null(names(items))) + .error("Invalid doc_item object.") + if (!"type" %in% names(items) || items$type != "Feature") + .error("Invalid doc_item object. Expecting 'type': 'Feature' key value.") + if (!"geometry" %in% names(items)) + .error("Invalid doc_item object. Expecting `geometry` key.") + if (!"properties" %in% names(items)) + .error("Invalid doc_item object. Expecting `properties` key") + items } check_items <- function(items) { - UseMethod("check_items", items) + if (!is.list(items) || is.null(names(items))) + .error("Invalid doc_items object.") + if (!"type" %in% names(items) || items$type != "FeatureCollection") + .error("Invalid doc_items object. Expecting ", + "'type': 'FeatureCollection' key value.") + if (!"features" %in% names(items)) + .error("Invalid doc_items object. Expecting `features` key") + items } -check_items.STACItem <- function(items) { - if (!(is.list(items) && "assets" %in% names(items))) { - .error("Invalid STACItem object.") - } +check_catalog <- function(catalog) { + if (!is.list(catalog) || is.null(names(catalog))) + .error("Invalid doc_catalog object.") + if (!"links" %in% names(catalog)) + .error("Invalid doc_catalog object. Expecting `links` key.") + catalog } -check_items.STACItemCollection <- function(items) { - if (!(is.list(items) && "features" %in% names(items))) { - .error("Invalid STACItemCollection object.") - } +check_collection <- function(collection) { + if (!is.list(collection) || is.null(names(collection))) + .error("Invalid doc_collection object.") + if (!"id" %in% names(collection)) + .error("Invalid doc_collection object. Expecting `id` key.") + if (!"links" %in% names(collection)) + .error("Invalid doc_collection object. Expecting `links` key.") + collection } -check_items.default <- check_items.STACItem - - check_character <- function(x, msg, ...) { if (!is.character(x)) .error(msg, ...) diff --git a/R/collections-query.R b/R/collections-query.R index 9533561b..82d2a4f3 100644 --- a/R/collections-query.R +++ b/R/collections-query.R @@ -14,7 +14,7 @@ #' Collection object #' } #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param collection_id a `character` collection id to be retrieved. @@ -23,7 +23,7 @@ #' [get_request()], [post_request()], [items()] #' #' @return -#' A `RSTACQuery` object with the subclass `collections` for +#' A `rstac_query` object with the subclass `collections` for #' `/collections/` endpoint, or a `collection_id` subclass for #' \code{/collections/{collection_id}} endpoint, containing all search field #' parameters to be provided to STAC API web service. @@ -41,77 +41,43 @@ #' #' @export collections <- function(q, collection_id = NULL) { - - # check q parameter - check_subclass(q, "stac") - + check_query(q, "stac") params <- list() - subclass <- "collections" if (!is.null(collection_id)) { - if (length(collection_id) != 1) .error("Parameter `collection_id` must be a single value.") - - params[["collection_id"]] <- collection_id - + params$collection_id <- collection_id subclass <- "collection_id" } - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = subclass) -} - -#' @export -endpoint.collections <- function(q) { - - return("/collections") + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = subclass + ) } #' @export before_request.collections <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - return(q) + set_query_endpoint(q, endpoint = "./collections") } #' @export after_response.collections <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "STACCollectionList") -} - -#' @export -endpoint.collection_id <- function(q) { - return(paste("/collections", q$params[["collection_id"]], sep = "/")) + content <- content_response_json(res) + doc_collections(content) } #' @export before_request.collection_id <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - - # don't send 'collection_id' in url's query string or content body - q <- omit_query_params(q, names = "collection_id") - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s", params = "collection_id") } #' @export after_response.collection_id <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, - subclass = c("STACCollection", "STACCatalog")) + content <- content_response_json(res) + doc_collection(content) } diff --git a/R/conformance-query.R b/R/conformance-query.R index 39ce790a..7e05a44d 100644 --- a/R/conformance-query.R +++ b/R/conformance-query.R @@ -1,16 +1,16 @@ -#' @title Conformance endpoint +#' @title doc_conformance endpoint #' #' @description #' The conformance endpoint provides the capabilities of #' the service. #' This endpoint is accessible from the provider's catalog (`/conformance`). #' -#' @param q a `RSTACQuery` object expressing a STAC query criteria. +#' @param q a `rstac_query` object expressing a STAC query criteria. #' #' @seealso [get_request()], [stac()], [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `conformance` for `/conformance` +#' A `rstac_query` object with the subclass `conformance` for `/conformance` #' endpoint. #' #' @examples @@ -21,33 +21,23 @@ #' #' @export conformance <- function(q) { - # check q parameter - check_subclass(q, "stac") - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = q$params, - subclass = unique(c("conformance", subclass(q)))) -} - -#' @export -endpoint.conformance <- function(q) { -return("/conformance") + check_query(q, "stac") + rstac_query( + version = q$version, + base_url = q$base_url, + params = q$params, + subclass = "conformance" + ) } #' @export before_request.conformance <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - return(q) + set_query_endpoint(q, endpoint = "./conformance") } #' @export after_response.conformance <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "Conformance") + content <- content_response_json(res) + doc_conformance(content) } diff --git a/R/cql2-adv_comp.R b/R/cql2-adv_comp.R index 8a2f1f61..e81b8fe3 100644 --- a/R/cql2-adv_comp.R +++ b/R/cql2-adv_comp.R @@ -96,8 +96,8 @@ get_spatial.character <- function(x) { get_spatial.list <- function(x) { if (!all(c("type", "coordinates") %in% names(x))) .error("Not a valid GeoJSON geometry.") - if (!x[["type"]] %in% spatial_types) - .error("GeoJSON type '%s' is not supported.", x[["type"]]) + if (!x$type %in% spatial_types) + .error("GeoJSON type '%s' is not supported.", x$type) class(x) <- c("cql2_spatial", "list") x } diff --git a/R/cql2-funs.R b/R/cql2-funs.R index 9d198eaf..9f171623 100644 --- a/R/cql2-funs.R +++ b/R/cql2-funs.R @@ -47,10 +47,10 @@ cql2_crs <- function(obj) { } cql2_filter <- function(obj) { - obj[["filter"]] + obj$filter } `cql2_filter<-` <- function(obj, value) { - obj[["filter"]] <- value + obj$filter <- value obj } diff --git a/R/cql2-text.R b/R/cql2-text.R index eda3485c..4c31f324 100644 --- a/R/cql2-text.R +++ b/R/cql2-text.R @@ -253,7 +253,7 @@ wkt_spatial_type <- function(x) { if (!"type" %in% names(x) || !any(c("coordinates", "geometries") %in% names(x))) .error("Not a valid GeoJSON geometry.") - x[["type"]] + x$type } wkt_spatial_switch <- function(x, ...) { diff --git a/R/cql2-types.R b/R/cql2-types.R index 98d91ab6..980a3b2a 100644 --- a/R/cql2-types.R +++ b/R/cql2-types.R @@ -30,6 +30,68 @@ is_spatial <- function(x) { # input check ---- +iso_3339_date_fullyear <- "[0-9]{4}" + +iso_3339_date_month <- "(1[0-2]|0[1-9])" + +iso_3339_date_mday <- "(3[01]|[12][0-9]|0[1-9])" + +iso_3339_time_hour <- "(2[0-3]|[01][0-9])" + +iso_3339_time_minute <- "([0-5][0-9])" + +iso_3339_time_second <- "(60|[0-5][0-9])" + +iso_3339_time_secfrac <- "(\\.[0-9]+)?" + +iso_3339_time_numoffset <- paste0( + "[+-]", + paste( + iso_3339_time_hour, + iso_3339_time_minute, + sep = ":" + ) +) + +iso_3339_time_offset <- paste0( + "(Z|", iso_3339_time_numoffset, ")" +) + +iso_3339_partial_time <- paste0( + paste( + iso_3339_time_hour, + iso_3339_time_minute, + iso_3339_time_second, + sep = ":" + ), + iso_3339_time_secfrac +) + +iso_3339_full_date <- paste( + iso_3339_date_fullyear, + iso_3339_date_month, + iso_3339_date_mday, + sep = "-" +) + +iso_3339_full_time <- paste0( + iso_3339_partial_time, + iso_3339_time_offset +) +iso_3339_date_time <- paste0( + iso_3339_full_date, + "T", + iso_3339_full_time +) + +grep_iso_3339_date <- function(x) { + grepl(paste0("^", iso_3339_full_date, "$"), x) +} + +grep_iso_3339_date_time <- function(x) { + grepl(paste0("^", iso_3339_date_time, "$"), x) +} + # check timestamp instant is_time <- function(x) { is_str(x) && grep_iso_3339_date_time(x) || diff --git a/R/deprec-funs.R b/R/deprec-funs.R index c8ad3cd2..e69de29b 100644 --- a/R/deprec-funs.R +++ b/R/deprec-funs.R @@ -1,160 +0,0 @@ -#' @title Assets filter (Deprecated) -#' -#' @description `r lifecycle::badge('deprecated')` -#' -#' @param items a `STACItemCollection` object representing -#' the result of `/stac/search`, \code{/collections/{collectionId}/items}. -#' -#' @param ... additional arguments. See details. -#' -#' @param filter_fn a `function` that will be used to filter the -#' attributes listed in the properties. -#' -#' @return a `list` with the attributes of date, bands and paths. -#' -#' @name assets_filter -#' -#' @export -assets_filter <- function(items, ..., filter_fn = NULL) { - UseMethod("assets_filter", items) -} - -#' @rdname assets_filter -#' -#' @export -assets_filter.STACItemCollection <- function(items, ..., filter_fn = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::assets_filter()", - with = "rstac::assets_select()" - ) - dots <- substitute(list(...), env = environment())[-1] - - if (length(dots) > 0) { - if (!is.null(names(dots))) .error("Invalid filter arguments.") - - for (i in seq_along(dots)) { - - items$features <- lapply(items$features, function(item) { - - sel <- vapply(item$assets, function(asset) { - - tryCatch({ - eval(dots[[i]], envir = asset, enclos = baseenv()) - }, error = function(e) { NA }) - }, logical(1)) - - if (all(is.na(sel))) - .error("Invalid condition arguments.") - - sel[is.na(sel)] <- FALSE - - item$assets <- item$assets[sel] - - item - }) - } - } - - if (!is.null(filter_fn)) { - items$features <- lapply(items$features, function(item) { - - sel <- vapply(item$assets, filter_fn, logical(1)) - - item$assets <- item$assets[sel] - item - }) - } - - items -} - -#' @rdname assets_filter -#' -#' @export -assets_filter.STACItem <- function(items, ..., filter_fn = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::assets_filter()", - with = "rstac::assets_select()" - ) - dots <- substitute(list(...), env = environment())[-1] - - if (length(dots) > 0) { - if (!is.null(names(dots))) .error("Invalid filter arguments.") - - for (i in seq_along(dots)) { - sel <- vapply(items$assets, function(asset) { - tryCatch({ - eval(dots[[i]], envir = asset, enclos = baseenv()) - }, error = function(e) { NA }) - }, logical(1)) - - if (all(is.na(sel))) .error("Invalid condition arguments.") - - sel[is.na(sel)] <- FALSE - items$assets <- items$assets[sel] - } - } - - if (!is.null(filter_fn)) { - sel <- vapply(items$assets, filter_fn, logical(1)) - items$assets <- items$assets[sel] - } - - items -} - -#' @rdname items_functions -#' -#' @export -items_group <- function(items, ..., field = NULL, index = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::items_group()" - ) - - # checks if the object is STACItemCollections - if (items_length(items) == 0) return(list(items)) - - dots <- substitute(list(...), env = environment())[-1] - if (!is.character(dots)) dots <- as.character(dots) - - if (length(index) == 0 && length(field) == 0 && length(dots) == 0) - .error(paste("Either parameters 'index', 'field' or '...' parameters must", - "be supplied.")) - - if (length(index) > 0 && (length(field) > 0 || length(dots) > 0)) - .error(paste("Only one of the parameters '...','index' or 'field' should", - "be supplied.")) - - if (is.null(index)) { - index <- items_reap(items, ..., field = field) - - if (!is.atomic(index)) - .error("The field must be atomic vector.") - } else { - - if (items_matched(items) > items_length(items)) - .warning(paste("The number of matched items is greater than the number", - "of items length on your object. Considere to use", - "the 'items_fetch()' function before this operation.")) - } - - if (items_length(items) != length(index)) - .error(paste("The length of the field provided for grouping must contain", - "the same size as the length of the items.")) - - features <- unname(tapply(X = items$features, - INDEX = index, - FUN = c, simplify = FALSE)) - - lapply(features, function(x){ - items$features <- x - - items - }) -} diff --git a/R/doc-funs.R b/R/doc-funs.R new file mode 100644 index 00000000..84790dd5 --- /dev/null +++ b/R/doc-funs.R @@ -0,0 +1,117 @@ +rstac_doc <- function(x, subclass) { + structure(x, class = c(subclass, "list"), query = NULL) +} + +#' @export +stac_version.rstac_doc <- function(x, ...) { + default_version <- "0.8.0" + if (!is.null(x$stac_version)) + return(x$stac_version) + default_version +} + +#' @export +stac_version.doc_collections <- function(x, ...) { + if (length(x$collections) > 0) + stac_version(x$collections[[1]]) +} + +#' @export +stac_version.doc_items <- function(x, ...) { + if (!is.null(x$stac_version)) + return(x$stac_version) + if ("features" %in% names(x) && length(x$features) > 0) + stac_version(x$features[[1]]) +} + +#' @export +subclass.rstac_doc <- function(x) { + class(x)[[1]] +} + +as_rstac_doc <- function(x, base_url = NULL) { + subclass <- stac_subclass(x) + switch( + subclass, + doc_conformance = doc_conformance(x), + doc_catalog = doc_catalog(x, base_url = base_url), + doc_collection = doc_collection(x, base_url = base_url), + doc_collections = doc_collections(x, base_url = base_url), + doc_item = doc_item(x, base_url = base_url), + doc_items = doc_items(x, base_url = base_url) + ) +} + +doc_conformance <- function(x) { + if (!is.list(x) || !"conformsTo" %in% names(x)) + .error("Invalid Conformance object.") + rstac_doc(x, subclass = c("doc_conformance", "rstac_doc")) +} + +doc_queryables <- function(x) { + rstac_doc(x, subclass = c("doc_queryables", "rstac_doc")) +} + +doc_link <- function(x, base_url = NULL) { + if (!is.list(x) || !"href" %in% names(x) || !"rel" %in% names(x)) + .error("Invalid Link object.") + if (!is.null(base_url)) + x[["rstac:base_url"]] <- base_url + rstac_doc(x, subclass = c("doc_link")) +} + +doc_links <- function(x, base_url = NULL) { + if (is.null(x)) + x <- list() + if (!is.list(x)) + .error("Invalid Links object.") + x <- lapply(x, doc_link, base_url = base_url) + rstac_doc(x, subclass = c("doc_links")) +} + +doc_catalog <- function(x, base_url = NULL) { + if (!is.list(x) || !"links" %in% names(x)) + .error("Invalid Catalog object.") + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_catalog", "rstac_doc")) +} + +doc_collection <- function(x, base_url = NULL) { + if (!is.list(x) || !"links" %in% names(x)) + .error("Invalid Collection object.") + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_collection", "rstac_doc")) +} + +doc_collections <- function(x, base_url = NULL) { + if (!is.list(x) || !"collections" %in% names(x)) + .error("Invalid Collections object.") + x$links <- doc_links(x$links, base_url = base_url) + x$collections <- lapply(x$collections, doc_collection) + rstac_doc(x, subclass = c("doc_collections", "rstac_doc")) +} + +doc_item <- function(x, base_url = NULL) { + if (!is.list(x) || !"type" %in% names(x)) + .error("Invalid Item object.") + if (x$type != "Feature") + .error("Invalid Item object. Type '%s' is not supported.", x$type) + if ("links" %in% names(x)) + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_item", "rstac_doc")) +} + +doc_items <- function(x, base_url = NULL, query = NULL) { + if (!is.list(x) || !"type" %in% names(x)) + .error("Invalid Items object.") + if (x$type != "FeatureCollection") + .error("Invalid Items object. Type '%s' is not supported.", x$type) + if (!"features" %in% names(x)) + .error("Invalid Items object. Expecting 'features' key.") + x$features <- lapply(x$features, doc_item) + if ("links" %in% names(x)) + x$links <- doc_links(x$links, base_url = base_url) + items <- rstac_doc(x, subclass = c("doc_items", "rstac_doc")) + attr(items, "query") <- query + items +} diff --git a/R/document-funs.R b/R/document-funs.R deleted file mode 100644 index 820da76f..00000000 --- a/R/document-funs.R +++ /dev/null @@ -1,70 +0,0 @@ -#' @title Document development functions -#' -#' @param content a `list` data structure representing the JSON file -#' received in HTTP response (see [content_response()] function) -#' -#' @param q a `RSTACQuery` object expressing the STAC query used -#' to retrieve the document. -#' -#' @param subclass a `character` corresponding to the subclass of the -#' document to be created. -#' -#' @return -#' The `RSTACDocument()` function returns a `RSTACDocument` object -#' with subclass defined by `subclass` parameter. -#' -#' @keywords internal -RSTACDocument <- function(content, q = NULL, subclass = NULL) { - structure( - content, - query = q, - class = c(subclass, "RSTACDocument", "list") - ) -} - -#' @export -subclass.RSTACDocument <- function(x) { - - class(x)[[1]] -} - -#' @export -check_subclass.RSTACDocument <- function(x, subclasses) { - - if (!all(subclass(x) %in% subclasses)) - .error("Expecting %s document(s).", - paste0("`", subclasses, "`", collapse = " or ")) -} - -#' @title Document utils functions -#' -#' @param d an `RSTACDocument` object -#' -#' @return a `RSTACQuery` object with the predecessor subclass with the -#' fields used in the request. -#' -#' @keywords internal -doc_query <- function(d) { - - .check_obj(d, "RSTACDocument") - - attr(d, "query") -} - -#' @export -stac_version.RSTACDocument <- function(x, ...) { - - if (is.null(x$stac_version)) - return(stac_version(doc_query(x))) - x$stac_version -} - -#' @export -stac_version.STACCollectionList <- function(x, ...) { - - q <- doc_query(x) - if (!is.null(q)) - return(stac_version(q)) - if (length(x$collections) > 0) - return(x$collections[[1]]$stac_version) -} diff --git a/R/ext_filter.R b/R/ext_filter.R index e3afbf73..aa32d68f 100644 --- a/R/ext_filter.R +++ b/R/ext_filter.R @@ -19,7 +19,7 @@ #' filter criteria using R language. For more details on how to create #' CQL2 expressions in `rstac`. See the details section. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' @param expr a valid R expression to be translated to CQL2 (see details). #' @param lang a character value indicating which CQL2 representation @@ -101,11 +101,10 @@ #' for example `"date"`. #' #' @seealso [ext_query()], [stac_search()], [post_request()], -#' [endpoint()], [before_request()], -#' [after_response()], [content_response()] +#' [before_request()], [after_response()], [content_response()] #' #' @return -#' A `RSTACQuery` object with the subclass `ext_filter` containing +#' A `rstac_query` object with the subclass `ext_filter` containing #' all request parameters to be passed to `get_request()` or #' `post_request()` function. #' @@ -211,45 +210,36 @@ #' #' @export ext_filter <- function(q, expr, lang = NULL, crs = NULL) { - # check parameter - check_subclass(q, c("stac", "search", "items")) + check_query(q, c("stac", "search", "items")) check_lang(lang) - # get expression expr <- unquote( expr = substitute(expr = expr, env = environment()), env = parent.frame() ) params <- cql2(expr, lang = lang, crs = crs) - - if (any(c("seach", "items") %in% subclass(q))) - class <- unique(c("ext_filter", subclass(q))) + if (any(c("search", "items") %in% subclass(q))) + subclass <- unique(c("ext_filter", subclass(q))) else - class <- unique(c("ext_filter", "search", subclass(q))) - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = modify_list(q$params, params), - subclass = class) + subclass <- unique(c("ext_filter", "search", subclass(q))) + rstac_query( + version = q$version, + base_url = q$base_url, + params = modify_list(q$params, params), + subclass = subclass + ) } check_lang <- function(lang) { if (!is.null(lang) && !lang[[1]] %in% c("cql2-json", "cql2-text")) - .error("Value '%s' lang is not supported", lang[[1]]) -} - -#' @export -endpoint.ext_filter <- function(q) { - # using endpoint from search or items document - if (any(c("stac", "search") %in% subclass(q))) - return(endpoint.search(q)) - return(endpoint.items(q)) + .error("Language '%s' is not supported", lang[[1]]) } #' @export before_request.ext_filter <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) + # call super class + q <- NextMethod("before_request", q) if (q$verb == "GET") { # transform list into string to provide as querystring in GET if (!is.null(cql2_lang(q$params)) && cql2_lang(q$params) == "cql2-json") { @@ -265,12 +255,7 @@ before_request.ext_filter <- function(q) { cql2_lang(q$params) <- "cql2-json" } } - - if ("items" %in% subclass(q)) { - # don't send 'collection_id' in url's query string or content body - q <- omit_query_params(q, names = "collection_id") - } - return(q) + q } #' @export @@ -280,14 +265,11 @@ after_response.ext_filter <- function(q, res) { #' @export parse_params.ext_filter <- function(q, params) { - # call super class params <- NextMethod("parse_params") - params } - #' @rdname ext_filter #' @export cql2_json <- function(expr) { @@ -297,7 +279,7 @@ cql2_json <- function(expr) { ) filter_expr <- to_json(cql2(expr, lang = "cql2-json")) cat(filter_expr) - return(invisible(filter_expr)) + invisible(filter_expr) } #' @rdname ext_filter @@ -309,5 +291,5 @@ cql2_text <- function(expr) { ) filter_expr <- to_text(cql2(expr, lang = "cql2-text")) cat(filter_expr) - return(invisible(filter_expr)) + invisible(filter_expr) } diff --git a/R/ext_query.R b/R/ext_query.R index effd85fd..407e7e1f 100644 --- a/R/ext_query.R +++ b/R/ext_query.R @@ -34,24 +34,22 @@ #' Besides this function, the following S3 generic methods were implemented #' to get things done for this extension: #' \itemize{ -#' \item The `endpoint()` for subclass `ext_query` #' \item The `before_request()` for subclass `ext_query` #' \item The `after_response()` for subclass `ext_query` #' } #' See source file `ext_query.R` for an example of how to implement new #' extensions. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param ... entries with format ` `. #' #' @seealso [ext_filter()], [stac_search()], [post_request()], -#' [endpoint()], [before_request()], -#' [after_response()], [content_response()] +#' [before_request()], [after_response()], [content_response()] #' #' @return -#' A `RSTACQuery` object with the subclass `ext_query` containing +#' A `rstac_query` object with the subclass `ext_query` containing #' all request parameters to be passed to `post_request()` function. #' #' @examples @@ -64,13 +62,9 @@ #' #' @export ext_query <- function(q, ...) { - - # check s parameter - check_subclass(q, "search") - + check_query(q, "search") # get the env parent env_parent <- parent.frame() - params <- list() if (!is.null(substitute(list(...), env = environment())[-1])) { dots <- substitute(list(...), env = environment())[-1] @@ -79,11 +73,9 @@ ext_query <- function(q, ...) { keys <- lapply(dots, function(x) as.character(x[[2]])) values <- lapply(dots, function(x) eval(x[[3]], env_parent)) }, error = function(e) { - .error("Invalid query expression.") }) } - ops <- lapply(ops, function(op) { if (op == "==") return("eq") if (op == "!=") return("neq") @@ -97,46 +89,32 @@ ext_query <- function(q, ...) { if (op == "%in%") return("in") .error("Invalid operator '%s'.", op) }) - uniq_keys <- unique(keys) entries <- lapply(uniq_keys, function(k) { - res <- lapply(values[keys == k], c) names(res) <- ops[keys == k] - res <- lapply(names(res), .parse_values_op, res) names(res) <- ops[keys == k] return(res) }) - if (length(entries) == 0) return(q) - names(entries) <- uniq_keys - params[["query"]] <- entries - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = unique(c("ext_query", subclass(q)))) -} - -#' @export -endpoint.ext_query <- function(q) { - - # using endpoint from search document - endpoint.search(q) + params$query <- entries + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = unique(c("ext_query", subclass(q))) + ) } #' @export before_request.ext_query <- function(q) { - - msg <- paste0("Query extension param is not supported by HTTP GET", - "method. Try use `post_request()` method instead.") - - check_query_verb(q, verbs = "POST", msg = msg) - - return(q) + error_msg <- paste0("Query extension is not supported by HTTP GET", + "method. Please, use `post_request()` method instead.") + check_query_verb(q, verbs = "POST", msg = error_msg) + before_request.search(q) } #' @export @@ -146,12 +124,9 @@ after_response.ext_query <- function(q, res) { #' @export parse_params.ext_query <- function(q, params) { - # call super class params <- NextMethod("parse_params") - params$query <- .parse_values_keys(params$query) - params } @@ -164,13 +139,11 @@ parse_params.ext_query <- function(q, params) { #' #' @noRd .parse_values_op <- function(op, values) { - if (op == "in") { if (length(values[[op]]) == 1) return(list(values[[op]])) return(values[[op]]) } - if (length(values[[op]]) > 1) .warning(paste("Only the first value of '%s' operation was considered", "in 'ext_query()' function."), op) @@ -185,24 +158,17 @@ parse_params.ext_query <- function(q, params) { #' #' @noRd .parse_values_keys <- function(query) { - uniq_keys <- names(query) - entries <- lapply(uniq_keys, function(k) { ops <- names(query[[k]]) - values <- lapply(ops, function(op){ query[[k]][[op]] }) - names(values) <- ops - res <- lapply(ops, .parse_values_op, values) names(res) <- ops return(res) }) - names(entries) <- uniq_keys - entries } diff --git a/R/extensions.R b/R/extensions.R index b2c2974d..9351fb9c 100644 --- a/R/extensions.R +++ b/R/extensions.R @@ -3,11 +3,11 @@ #' @description #' Currently, there are five STAC documents defined in STAC spec: #' \itemize{ -#' \item `STACCatalog` -#' \item `STACCollection` -#' \item `STACCollectionList` -#' \item `STACItem` -#' \item `STACItemCollection` +#' \item `doc_catalog` +#' \item `doc_collection` +#' \item `doc_collections` +#' \item `doc_item` +#' \item `doc_items` #' } #' #' Each document class is associated with STAC API endpoints. @@ -44,22 +44,18 @@ #' extensions. An extension must define a subclass name and implement all the #' following S3 generic methods for that subclass: #' \itemize{ -#' \item `endpoint()`: returns the endpoint value of the extension. -#' Endpoints that vary between STAC API versions can be properly returned by -#' checking the `version` field of `RSTACQuery` object. #' \item `before_request()`: allows handling query parameters before -#' submit them to the HTTP server; +#' submit them to the HTTP server, usually sets up the query endpoint; #' \item `after_request()`: allows to check and parse document received #' by the HTTP server; #' } #' -#' These methods will work 'behind the scenes' when a `RSTACQuery` object +#' These methods will work 'behind the scenes' when a `rstac_query` object #' representing a user query are passed to a request function #' (e.g. `get_request()` or `post_request()`). The calling order is: #' \enumerate{ #' \item begin of `get_request()` or `post_request()` #' \item if STAC API version is not defined, try detect it -#' \item call `endpoint()` #' \item call `before_request()` #' \item send HTTP request #' \item receive HTTP response @@ -68,13 +64,13 @@ #' } #' #' Besides that, the extension must expose a function to receive user -#' parameters and return a `RSTACQuery` object with a subclass +#' parameters and return a `rstac_query` object with a subclass #' associated with the above S3 methods. This function must accept as its -#' first parameter a `RSTACQuery` object representing the actual query. +#' first parameter a `rstac_query` object representing the actual query. #' To keep the command flow consistency, the function needs to check the #' subclass of the input query. After that, it must set new or changes the #' input query parameters according to the user input and, finally, -#' return the new query as a `RSTACQuery` object. +#' return the new query as a `rstac_query` object. #' #' You can see examples on how to implement an STAC API extension by looking at #' `stac.R`, `collections.R`, `items.R`, `stac_search.R`, @@ -85,15 +81,14 @@ #' section bellow that can help the extension development. #' #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param res a `httr` `response` object. #' @param params a `list` with params to add in request. #' #' @return -#' A `character` endpoint value for `endpoint()` function. -#' A `RSTACQuery` object for `before_request()` and +#' A `rstac_query` object for `before_request()` and #' `after_response()` functions. #' #' @seealso [ext_query()] @@ -103,14 +98,6 @@ #' @keywords internal NULL -#' @title Extension development functions -#' -#' @rdname extensions -endpoint <- function(q) { - - UseMethod("endpoint", q) -} - #' @title Extension development functions #' #' @rdname extensions @@ -186,7 +173,7 @@ content_response <- function(res, status_codes, content_types, key_message) { #' verbs are allowed. It is useful for establishing which verbs will be #' supported by an extension. #' -#' @param q a `RSTACQuery` object. +#' @param q a `rstac_query` object. #' #' @param verbs a `character` vector with allowed HTTP request methods #' @@ -202,36 +189,57 @@ check_query_verb <- function(q, verbs, msg = NULL) { } #' @describeIn extensions -#' The `check_subclass()` function specifies which type of query -#' objects (`RSTACQuery`) or document objects (`RSTACDocument`) -#' are expected in the function extension. +#' The `check_query()` function specifies which type of query +#' object (`rstac_query`) is expected in the function extension. #' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. +#' @param x a `rstac_query` object expressing a STAC query +#' criteria. #' -#' @param subclasses a `character` vector with all allowed S3 subclasses -check_subclass <- function(x, subclasses) { - UseMethod("check_subclass", x) +#' @param classes a `character` vector with all allowed S3 sub-classes +check_query <- function(x, classes = NULL) { + if (!inherits(x, "rstac_query")) + .error("Invalid rstac_query value.") + if (!is.null(classes) && !any(classes %in% subclass(x))) + .error("Expecting %s query.", paste0("`", classes, "`", collapse = " or ")) } #' @describeIn extensions #' The `subclass()` function returns a `character` representing the -#' subclass name of either `RSTACQuery` or `RSTACDocument` S3 classes. +#' subclass name of `rstac_query` objects. subclass <- function(x) { UseMethod("subclass", x) } #' @describeIn extensions -#' The `omit_query_params()` function was created to omit the paths that -#' are defined as query parameters to simplify the creation of a query. -#' Therefore, use this method only in endpoints that specify a parameter in -#' their paths. -#' -#' @param q a `RSTACQuery` object. -#' -#' @param names a `character` vector with the names do omit. -omit_query_params <- function(q, names) { - .check_obj(names, "character") - q$omitted <- unname(names) +#' The `set_query_endpoint()` function defines the endpoint of a query. +#' If `params` parameter is passed, each value must be an entry of params +#' field of the given query. The corresponding param value will be used as +#' value replacement of `%s` occurrences in the `endpoint` string. After +#' the replacement, all params in this list will be removed. +#' +#' @param q a `rstac_query` object. +#' +#' @param endpoint a `character` vector with the format string with the +#' endpoint url. +#' +#' @param params a `character` vector with the params entries to replace +#' all `%s` occurrences in the endpoint string. +#' +set_query_endpoint <- function(q, endpoint, params = NULL) { + if (any(!params %in% names(q$params))) + .error("Invalid param(s) %s.", + paste("`", setdiff(params, names(q$params)), "`", collapse = ", ")) + values <- unname(q$params[params]) + q$endpoint <- do.call(sprintf, args = c(list(fmt = endpoint), values)) + q$params[params] <- NULL q } + +content_response_json <- function(res) { + content_response( + res = res, + status_codes = "200", + content_types = "application/.*json", + key_message = c("message", "description", "detail") + ) +} diff --git a/R/items-funs.R b/R/items-funs.R index 4252bf3d..df0b844b 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -2,11 +2,11 @@ #' #' @description #' These functions provide support to work with -#' `STACItemCollection` and `STACItem` objects. +#' `doc_items` and `doc_item` objects. #' #' \itemize{ #' \item `items_length()`: shows how many items there are in -#' the `STACItemCollection` object. +#' the `doc_items` object. #' #' \item `items_matched()`: shows how many items matched the #' search criteria. It supports `search:metadata` (v0.8.0), @@ -18,32 +18,30 @@ #' \item `items_next()`: fetches a new page from STAC service. #' #' \item `items_datetime()`: retrieves the `datetime` -#' field in `properties` from `STACItemCollection` and -#' `STACItem` objects. +#' field in `properties` from `doc_items` and +#' `doc_item` objects. #' #' \item `items_bbox()`: retrieves the `bbox` -#' field of a `STACItemCollection` or a `STACItem` object. +#' field of a `doc_items` or a `doc_item` object. #' #' \item `item_assets()`: returns the assets name from -#' `STACItemCollection` and `STACItem` objects. +#' `doc_items` and `doc_item` objects. #' #' \item `items_filter()`: selects only items that match some criteria #' (see details section). #' #' \item `items_reap()`: extract key values by traversing all items -#' in a `STACItemCollection` object. +#' in a `doc_items` object. #' #' \item `items_fields()`: lists field names inside an item. #' -#' \item `items_group()`: `r lifecycle::badge('deprecated')` organizes -#' items as elements of a list using some criteria. -#' #' \item `items_sign()`: allow access assets by preparing its url. #' -#' \item `items_as_sf()`: `r lifecycle::badge('experimental')` convert items to `sf` object. +#' \item `items_as_sf()`: `r lifecycle::badge('experimental')` convert items +#' to `sf` object. #' } #' -#' @param items a `STACItemCollection` object. +#' @param items a `doc_items` object. #' #' @param matched_field a `character` vector with the path #' where the number of items returned in the named list is located starting @@ -54,8 +52,6 @@ #' @param progress a `logical` indicating if a progress bar must be #' shown or not. Defaults to `TRUE`. #' -#' @param simplify `r lifecycle::badge('deprecated')` no side-effect -#' #' @param field a `character` with the names of the field to #' get the subfields values. #' @@ -83,11 +79,8 @@ #' methods, such as [add_headers][httr::add_headers] or #' [set_cookies][httr::set_cookies]. #' -#' \item `items_fields()`: ellipsis parameter is deprecated in version -#' 0.9.2 of rstac. Please, use `field` parameter instead. -#' #' \item `items_filter()`: ellipsis is used to pass logical -#' expressions to be evaluated against a `STACItem` field as filter criteria. +#' expressions to be evaluated against a `doc_item` field as filter criteria. #' #' **WARNING:** the evaluation of filter expressions changed in `rstac` 0.9.2. #' Older versions of `rstac` used `properties` field to evaluate filter @@ -118,7 +111,7 @@ #' \item `items_matched()`: returns an `integer` value if the STAC web server #' does support this extension. Otherwise returns `NULL`. #' -#' \item `items_fetch()`: a `STACItemCollection` with all matched items. +#' \item `items_fetch()`: a `doc_items` with all matched items. #' #' \item `items_next()`: fetches a new page from STAC service. #' @@ -129,16 +122,16 @@ #' \item `item_assets()`: Returns a `character` value with all assets names #' of the all items. #' -#' \item `items_filter()`: a `STACItemCollection` object. +#' \item `items_filter()`: a `doc_items` object. #' #' \item `items_reap()`: a `vector` if the supplied field is atomic, #' otherwise or a `list`. #' #' \item `items_fields()`: a `character` vector. #' -#' \item `items_group()`: a `list` of `STACItemCollection` objects. +#' \item `items_group()`: a `list` of `doc_items` objects. #' -#' \item `items_sign()`: a `STACItemCollection` object with signed assets url. +#' \item `items_sign()`: a `doc_items` object with signed assets url. #' #' \item `items_as_sf()`: a `sf` object. #' @@ -148,7 +141,7 @@ #' \dontrun{ #' x <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% #' stac_search(collections = "CB4-16D-2") %>% -#' stac_search(limit = 500) %>% +#' stac_search(datetime = "2020-01-01/2021-01-01", limit = 500) %>% #' get_request() #' #' x %>% items_length() @@ -162,7 +155,7 @@ #' # Defining BDC token #' Sys.setenv("BDC_ACCESS_KEY" = "token-123") #' -#' # STACItem object +#' # doc_item object #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -172,7 +165,7 @@ #' } #' #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -191,7 +184,7 @@ #' } #' #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -214,15 +207,15 @@ items_length <- function(items) { #' @rdname items_functions #' #' @export -items_length.STACItem <- function(items) { - check_items(items) +items_length.doc_item <- function(items) { + check_item(items) return(1) } #' @rdname items_functions #' #' @export -items_length.STACItemCollection <- function(items) { +items_length.doc_items <- function(items) { check_items(items) return(length(items$features)) } @@ -230,7 +223,7 @@ items_length.STACItemCollection <- function(items) { #' @rdname items_functions #' #' @export -items_length.default <- items_length.STACItem +items_length.default <- items_length.doc_item #' @rdname items_functions #' @@ -242,42 +235,35 @@ items_matched <- function(items, matched_field = NULL) { #' @rdname items_functions #' #' @export -items_matched.STACItem <- function(items, matched_field = NULL) { - check_items(items) +items_matched.doc_item <- function(items, matched_field = NULL) { + check_item(items) return(1) } #' @rdname items_functions #' #' @export -items_matched.STACItemCollection <- function(items, matched_field = NULL) { +items_matched.doc_items <- function(items, matched_field = NULL) { check_items(items) matched <- NULL - # try by the matched_field provided by user. This allow users specify a # non-standard field for matched items. - if (is.character(matched_field) && matched_field %in% names(items)) { - matched <- as.numeric(items[[matched_field]]) - } - if (is.null(matched)) { - if (stac_version(items) < "0.9.0") - # STAC API < 0.9.0 extensions - matched <- items$`search:metadata`$matched - else - # STAC API >= 0.9.0 extensions - matched <- items$`context`$matched - - # try the last resort: OGC features core spec - if (is.null(matched)) - matched <- items$numberMatched - } - return(matched) + if (is.character(matched_field) && matched_field %in% names(items)) + matched <- as.numeric(items[[matched_field]]) + if (is.null(matched) && "search:metadata" %in% names(items)) + matched <- items$`search:metadata`$matched + if (is.null(matched) && "context" %in% names(items)) + matched <- items$`context`$matched + # try the last resort: OGC features core spec + if (is.null(matched)) + matched <- items$numberMatched + matched } #' @rdname items_functions #' #' @export -items_matched.default <- items_matched.STACItem +items_matched.default <- items_matched.doc_item #' @rdname items_functions #' @@ -289,55 +275,46 @@ items_fetch <- function(items, ...) { #' @rdname items_functions #' #' @export -items_fetch.STACItemCollection <- function(items, ..., - progress = TRUE, - matched_field = NULL) { +items_fetch.doc_items <- function(items, ..., + progress = TRUE, + matched_field = NULL) { check_items(items) matched <- items_matched(items, matched_field) - # verify if progress bar can be shown progress <- progress & (!is.null(matched) && (items_length(items) < matched)) - if (progress) + if (progress) { pb <- utils::txtProgressBar( min = items_length(items), max = matched, style = 3 ) - + # close progress bar when exit + on.exit({ + if (progress) { + utils::setTxtProgressBar(pb, matched) + close(pb) + } + }) + } while (TRUE) { - # check if features is complete if (!is.null(matched) && (items_length(items) == matched)) break - # protect against infinite loop if (!is.null(matched) && (items_length(items) > matched)) .error(paste("Length of returned items (%s) is different", "from matched items (%s)."), items_length(items), matched) - - content <- tryCatch({ + new_items <- tryCatch({ items_next(items, ...) - }, - next_error = function(e) NULL - ) - - if (!is.null(content)) - items <- content - else + }, next_error = function(e) NULL) + if (is.null(new_items)) break - + items$features <- c(items$features, new_items$features) # update progress bar if (progress) - utils::setTxtProgressBar(pb, length(content)) + utils::setTxtProgressBar(pb, length(new_items)) } - - # close progress bar - if (progress) { - utils::setTxtProgressBar(pb, matched) - close(pb) - } - - return(items) + items } #' @rdname items_functions @@ -350,103 +327,47 @@ items_next <- function(items, ...) { #' @rdname items_functions #' #' @export -items_next.STACItemCollection <- function(items, ...) { +items_next.doc_items <- function(items, ...) { check_items(items) - matched <- items_matched(items) - - q <- doc_query(items) - if (is.null(q)) { - .error("Cannot get next link URL", class = "next_error") - } - # get url of the next page - next_url <- Filter(function(x) x$rel == "next", items$links) - if (length(next_url) == 0) - .error("Cannot get next link URL", class = "next_error") - - next_url <- next_url[[1]] - - # create a new stac object with params from the next url + rel <- NULL + next_link <- links(items, rel == "next") + if (length(next_link) == 0) + .error("Cannot get next link URL.", class = "next_error") + next_link <- next_link[[1]] # check for body implementation in next link - if (q$verb == "POST" && all(c("body", "method") %in% names(next_url))) { - - # TODO: check if spec can enforce that the same provided base url - # must be used to proceed pagination. - # For security concerns, here, the original base_url will be used in - # subsequent requests of pagination - - # # update query base_url and verb to the returned one - # q$base_url <- next_url$href - - # erase current parameters if merge == FALSE - if (!is.null(next_url$merge) && !next_url$merge) { - q$params <- list() + verb <- "GET" + if ("method" %in% names(next_link) && next_link$method %in% c("GET", "POST")) + verb <- next_link$method + q <- NULL + if (verb == "POST") { + # POST + q <- attr(items, "query") + if (!is.null(q)) { + # merge content body to next body field + if ("merge" %in% names(next_link) && next_link$merge) + next_link$body <- modify_list(q$params, next_link$body) + next_link$body <- parse_params(q, next_link$body) } - - # get parameters - params <- next_url$body - - } else { - - # TODO: check if spec can enforce that the same provided base url - # must be used to proceed pagination. - # For security concerns, here, the original base_url will be used in - # subsequent requests of pagination - - # # update query base_url and verb to the returned one - # q$base_url <- gsub("^([^?]+)(\\?.*)?$", "\\1", next_url$href) - - # get next link parameters from url - params <- .querystring_decode(substring( - gsub("^([^?]+)(\\?.*)?$", "\\2", next_url$href), 2) + res <- make_post_request( + url = next_link$href, + body = next_link$body, + headers = next_link$headers, + ..., + error_msg = "Error while requesting next page" + ) + } else if (verb == "GET") { + # GET + res <- make_get_request( + url = next_link$href, + headers = next_link$headers, + ..., + error_msg = "Error while requesting next page" ) - - # verify if query params is valid - params <- .validate_query(params = params) - } - - # parse params - params <- parse_params(q, params = params) - - next_stac <- RSTACQuery(version = q$version, - base_url = q$base_url, - params = modify_list(q$params, params), - subclass = subclass(q)) - - # call request - if (q$verb == "GET") { - - content <- get_request(next_stac, ...) - } else if (q$verb == "POST") { - - content <- post_request(next_stac, ..., encode = q$encode) - } else { - .error("Invalid HTTP method.") - } - - # check content response - check_subclass(content, "STACItemCollection") - - # check pagination length - if (!is.null(q$params[["limit"]]) && - items_length(content) > as.numeric(q$params[["limit"]])) { - .error("STAC invalid retrieved page length.") - } - - # check if result length is valid - if (!is.null(matched) && !is.null(q$params[["limit"]]) && - (items_length(content) != as.numeric(q$params[["limit"]])) && - (items_length(content) + items_length(items) != matched)) { - .error("STAC pagination error.") } - - # merge features result into resulting content - content$features <- c(items$features, content$features) - - # prepares next iteration - items <- content - - return(items) + content <- content_response_json(res) + # return items + doc_items(content, query = q) } #' @rdname items_functions @@ -459,26 +380,26 @@ items_datetime <- function(items) { #' @rdname items_functions #' #' @export -items_datetime.STACItem <- function(items) { - check_items(items) +items_datetime.doc_item <- function(items) { + check_item(items) if (!"datetime" %in% names(items$properties)) { .error("Parameter `items` is invalid.") } - return(items$properties$datetime) + items$properties$datetime } #' @rdname items_functions #' #' @export -items_datetime.STACItemCollection <- function(items) { +items_datetime.doc_items <- function(items) { check_items(items) - return(map_chr(items$features, items_datetime)) + map_chr(items$features, items_datetime) } #' @rdname items_functions #' #' @export -items_datetime.default <- items_datetime.STACItem +items_datetime.default <- items_datetime.doc_item #' @rdname items_functions #' @@ -490,15 +411,15 @@ items_bbox <- function(items) { #' @rdname items_functions #' #' @export -items_bbox.STACItem <- function(items) { - check_items(items) +items_bbox.doc_item <- function(items) { + check_item(items) return(items$bbox) } #' @rdname items_functions #' #' @export -items_bbox.STACItemCollection <- function(items) { +items_bbox.doc_items <- function(items) { check_items(items) return(items_reap(items, field = "bbox")) } @@ -506,42 +427,35 @@ items_bbox.STACItemCollection <- function(items) { #' @rdname items_functions #' #' @export -items_bbox.default <- items_bbox.STACItem +items_bbox.default <- items_bbox.doc_item #' @rdname items_functions #' #' @export -items_assets <- function(items, simplify = deprecated()) { - if (!missing(simplify)) { - deprec_parameter( - deprec_var = "simplify", - deprec_version = "0.9.2", - msg = "By default, the return will be simplified." - ) - } +items_assets <- function(items) { UseMethod("items_assets", items) } #' @rdname items_functions #' #' @export -items_assets.STACItem <- function(items, simplify = deprecated()) { - check_items(items) - return(items_fields(items, field = "assets")) +items_assets.doc_item <- function(items) { + check_item(items) + items_fields(items, field = "assets") } #' @rdname items_functions #' #' @export -items_assets.STACItemCollection <- function(items, simplify = deprecated()) { +items_assets.doc_items <- function(items) { check_items(items) - return(sort(unique(unlist(lapply(items$features, items_assets.STACItem))))) + sort(unique(unlist(lapply(items$features, items_assets.doc_item)))) } #' @rdname items_functions #' #' @export -items_assets.default <- items_assets.STACItem +items_assets.default <- items_assets.doc_item #' @rdname items_functions #' @@ -553,52 +467,30 @@ items_filter <- function(items, ..., filter_fn = NULL) { #' @rdname items_functions #' #' @export -items_filter.STACItemCollection <- function(items, ..., filter_fn = NULL) { +items_filter.doc_items <- function(items, ..., filter_fn = NULL) { check_items(items) + init_length <- items_length(items) exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) - if (length(exprs) > 0) { if (!is.null(names(exprs))) .error("Filter expressions cannot be named.") - - show_warning <- TRUE for (i in seq_along(exprs)) { - if (show_warning && check_old_expression(items, exprs[[i]])) { - # NOTE: this warning will be removed in next versions. We will no - # longer support the old way of filter evaluation - .warning(paste( - "In version 0.9.2, rstac changed how filter expressions are", - "evaluated. In future versions, the expression '%s' will be", - "evaluated against each feature in items intead of `properties`", - "field.\nSee ?items_filter for more details on how to change", - "your expression." - ), deparse(exprs[[i]])) - show_warning <- FALSE - } sel <- map_lgl(items$features, eval_filter_expr, expr = exprs[[i]]) + items$features <- items$features[sel] } - items$features <- items$features[sel] } - if (!is.null(filter_fn)) { - if (check_old_fn(items, filter_fn)) { - # NOTE: this warning will be removed in next versions. We will no - # longer support the old way of filter evaluation - .warning(paste( - "In version 0.9.2, rstac changed how filter function is", - "evaluated. In future versions, the `filter_fn` parameter will be", - "evaluated against each feature in items instead of `properties`", - "field.\nSee ?items_filter for more details on how to change your", - "function." - )) - } sel <- map_lgl(items$features, eval_filter_fn, filter_fn = filter_fn) items$features <- items$features[sel] } - return(items) + if (items_length(items) == 0 && init_length > 0) + .warning(paste("Filter criteria did not match any item.\n", + "Please, see `?items_filter` for more details on", + "how expressions are evaluated by `items_filter()`.")) + items } #' @rdname items_functions @@ -611,7 +503,7 @@ items_compact <- function(items) { #' @rdname items_functions #' #' @export -items_compact.STACItemCollection <- function(items) { +items_compact.doc_items <- function(items) { check_items(items) items_filter(items, filter_fn = has_assets) } @@ -619,57 +511,38 @@ items_compact.STACItemCollection <- function(items) { #' @rdname items_functions #' #' @export -items_reap <- function(items, field, ..., pick_fn = identity) { +items_reap <- function(items, field, pick_fn = identity) { UseMethod("items_reap", items) } #' @rdname items_functions #' #' @export -items_reap.STACItem <- function(items, field, ..., pick_fn = identity) { - check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } - values <- apply_deeply(items, i = field, fn = pick_fn) - return(values) +items_reap.doc_item <- function(items, field, pick_fn = identity) { + check_item(items) + apply_deeply(items, i = field, fn = pick_fn) } #' @rdname items_functions #' #' @export -items_reap.STACItemCollection <- function(items, - field, ..., - pick_fn = identity) { +items_reap.doc_items <- function(items, field, pick_fn = identity) { check_items(items) if (items_length(items) == 0) return(NULL) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } - val <- lapply(items$features, items_reap.STACItem, field = field, - pick_fn = pick_fn) - if (is.null(names(val)) && - all(vapply(val, function(x) is.atomic(x) && length(x) == 1, logical(1)))) - return(unlist(val)) - return(val) + values <- lapply(items$features, items_reap.doc_item, field = field, + pick_fn = pick_fn) + is_atomic <- all(vapply(values, function(x) { + is.atomic(x) && length(x) == 1 + }, logical(1))) + if (is_atomic) + return(unlist(values)) + values } #' @rdname items_functions #' #' @export -items_reap.default <- items_reap.STACItem +items_reap.default <- items_reap.doc_item #' @rdname items_functions #' @@ -681,17 +554,8 @@ items_fields <- function(items, field = NULL, ...) { #' @rdname items_functions #' #' @export -items_fields.STACItem <- function(items, field = NULL, ...) { - check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } +items_fields.doc_item <- function(items, field = NULL) { + check_item(items) if (length(field) == 0) { fields <- names(items) } else { @@ -699,35 +563,24 @@ items_fields.STACItem <- function(items, field = NULL, ...) { items, i = field, fn = names ), use.names = FALSE)) } - return(sort(fields)) + sort(fields) } #' @rdname items_functions #' #' @export -items_fields.STACItemCollection <- function(items, field = NULL, ...) { +items_fields.doc_items <- function(items, field = NULL) { check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } if (items_length(items) == 0) return(NULL) - - fields <- lapply(items$features, items_fields.STACItem, field = field) - - return(sort(unique(unlist(unname(fields))))) + fields <- lapply(items$features, items_fields.doc_item, field = field) + sort(unique(unlist(unname(fields)))) } #' @rdname items_functions #' #' @export -items_fields.default <- items_fields.STACItem +items_fields.default <- items_fields.doc_item #' @rdname items_functions #' @@ -739,23 +592,23 @@ items_sign <- function(items, sign_fn) { #' @rdname items_functions #' #' @export -items_sign.STACItem <- function(items, sign_fn) { - check_items(items) - return(sign_fn(items)) +items_sign.doc_item <- function(items, sign_fn) { + check_item(items) + sign_fn(items) } #' @rdname items_functions #' #' @export -items_sign.STACItemCollection <- function(items, sign_fn) { +items_sign.doc_items <- function(items, sign_fn) { check_items(items) - return(foreach_item(items, sign_fn)) + foreach_item(items, sign_fn) } #' @rdname items_functions #' #' @export -items_sign.default <- items_sign.STACItem +items_sign.default <- items_sign.doc_item #' @rdname items_functions #' @@ -767,15 +620,14 @@ items_as_sf <- function(items) { #' @rdname items_functions #' #' @export -items_as_sf.STACItem <- function(items) { - check_items(items) +items_as_sf.doc_item <- function(items) { + check_item(items) geojsonsf::geojson_sf(to_json(items)) } #' @rdname items_functions #' #' @export -items_as_sf.STACItemCollection <- function(items) { - check_items(items) - geojsonsf::geojson_sf(to_json(items)) +items_as_sf.doc_items <- function(items) { + items_as_sf.doc_item(items) } diff --git a/R/items-query.R b/R/items-query.R index 9925bd85..50020f60 100644 --- a/R/items-query.R +++ b/R/items-query.R @@ -16,7 +16,7 @@ #' The endpoint \code{/collections/\{collectionId\}/items} accepts the same #' filters parameters of [stac_search()] function. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param feature_id a `character` with item id to be fetched. @@ -66,7 +66,7 @@ #' [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `items` for +#' A `rstac_query` object with the subclass `items` for #' \code{/collections/{collection_id}/items} endpoint, or a #' `item_id` subclass for #' \code{/collections/{collection_id}/items/{feature_id}} endpoint, @@ -87,112 +87,63 @@ #' } #' #' @export -items <- function(q, feature_id = NULL, - datetime = NULL, - bbox = NULL, +items <- function(q, feature_id = NULL, datetime = NULL, bbox = NULL, limit = NULL) { - - # check q parameter - check_subclass(q, c("collection_id", "items")) - + check_query(q, c("collection_id", "items")) params <- list() - if (!is.null(datetime)) - params[["datetime"]] <- .parse_datetime(datetime) - + params$datetime <- .parse_datetime(datetime) if (!is.null(bbox)) - params[["bbox"]] <- .parse_bbox(bbox) - + params$bbox <- .parse_bbox(bbox) if (!is.null(limit) && !is.null(limit)) - params[["limit"]] <- .parse_limit(limit) - + params$limit <- .parse_limit(limit) # set subclass subclass <- "items" if (!is.null(feature_id)) { - - params[["feature_id"]] <- .parse_feature_id(feature_id) - + params$feature_id <- .parse_feature_id(feature_id) subclass <- "item_id" } - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = subclass) + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = subclass + ) } #' @export parse_params.items <- function(q, params) { - if (!is.null(params[["datetime"]])) - params[["datetime"]] <- .parse_datetime(params[["datetime"]]) - - if (!is.null(params[["bbox"]])) - params[["bbox"]] <- .parse_bbox(params[["bbox"]]) - - if (!is.null(params[["limit"]])) - params[["limit"]] <- .parse_limit(params[["limit"]]) - + if (!is.null(params$datetime)) + params$datetime <- .parse_datetime(params$datetime) + if (!is.null(params$bbox)) + params$bbox <- .parse_bbox(params$bbox) + if (!is.null(params$limit)) + params$limit <- .parse_limit(params$limit) params } -#' @export -endpoint.items <- function(q) { - - return(paste("/collections", q$params[["collection_id"]], "items", sep = "/")) -} - #' @export before_request.items <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - # don't send 'collection_id' in url's query string or content body - q <- omit_query_params(q, names = "collection_id") - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s/items", + params = "collection_id") } #' @export after_response.items <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - if ("features" %in% names(content)) { - content$features <- lapply(content$features, RSTACDocument, - subclass = "STACItem") - } - RSTACDocument(content = content, q = q, subclass = "STACItemCollection") -} - -#' @export -endpoint.item_id <- function(q) { - - return(paste("/collections", q$params[["collection_id"]], "items", - q$params[["feature_id"]], sep = "/")) + content <- content_response_json(res) + doc_items(content, query = q) } #' @export before_request.item_id <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - # don't send 'collection_id' and 'feature_id' in - # url's query string or content body - q <- omit_query_params(q, names = c("collection_id", "feature_id")) - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s/items/%s", + params = c("collection_id", "feature_id")) } #' @export after_response.item_id <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "STACItem") + content <- content_response_json(res) + doc_item(content) } diff --git a/R/items-utils.R b/R/items-utils.R index a5a02329..9a839a89 100644 --- a/R/items-utils.R +++ b/R/items-utils.R @@ -1,79 +1,21 @@ eval_filter_expr <- function(f, expr) { - # NOTE: this tryCatch will be removed in next versions. - # We will no longer support the old way of filter evaluation - val <- tryCatch({ - f$properties$properties <- NULL - eval(expr, envir = f$properties, - enclos = parent.env(parent.frame())) + value <- tryCatch({ + eval(expr, envir = f, enclos = parent.env(parent.frame())) }, error = function(e) { - return(NULL) + return(FALSE) }) - - if (length(val) == 0) { - val <- tryCatch({ - eval(expr, envir = f, enclos = parent.env(parent.frame())) - }, error = function(e) { - return(FALSE) - }) - } - - if (length(val) == 0) { - val <- FALSE - } - return(val) + if (length(value) == 0) + value <- FALSE + value } eval_filter_fn <- function(f, filter_fn) { - # NOTE: this tryCatch will be removed in next versions. - # We will no longer support the old way of filter evaluation - val <- tryCatch({ - f$properties$properties <- NULL - filter_fn(f$properties) + value <- tryCatch({ + filter_fn(f) }, error = function(e) { - return(NULL) - }) - - if (length(val) == 0) { - val <- tryCatch({ - filter_fn(f) - }, error = function(e) { - return(FALSE) - }) - } - - if (length(val) == 0) { - val <- FALSE - } - return(val) -} - -# NOTE: this function will be removed in next versions. -# We will no longer support the old way of filter evaluation -check_old_expression <- function(items, expr) { - val <- map_lgl(items$features, function(f) { - f$properties$properties <- NULL - tryCatch({ - val <- eval(expr, envir = f$properties, - enclos = parent.env(parent.frame())) - is.logical(val) && length(val) > 0 - }, error = function(e) { - return(FALSE) - }) - }) - return(any(val)) -} - -# NOTE: this function will be removed in next versions. -# We will no longer support the old way of filter evaluation -check_old_fn <- function(items, fn) { - val <- map_lgl(items$features, function(f) { - f$properties$properties <- NULL - tryCatch({ - val <- fn(f$properties) - is.logical(val) && length(val) > 0 - }, error = function(e) { - return(FALSE) - }) + return(FALSE) }) - return(any(val)) + if (length(value) == 0) + value <- FALSE + value } diff --git a/R/links-funs.R b/R/links-funs.R new file mode 100644 index 00000000..c48cd4e6 --- /dev/null +++ b/R/links-funs.R @@ -0,0 +1,21 @@ +links <- function(x, ...) { + exprs <- as.list(substitute(list(...)))[-1] + sel <- !logical(length(x$links)) + for (expr in exprs) { + sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) + } + structure(x$links[sel], class = c("doc_links", "list")) +} + +link_open <- function(link) { + if (is.list(link)) { + check_link(link) + url <- link$href + if ("rstac:base_url" %in% names(link)) + url <- resolve_url(link[["rstac:base_url"]], url) + } else if (is.character(link)) + url <- link + content <- jsonlite::read_json(url) + # create an rstac doc from content and return + as_rstac_doc(content) +} diff --git a/R/parse-utils.R b/R/parse-utils.R index 1e86c80d..c8652beb 100644 --- a/R/parse-utils.R +++ b/R/parse-utils.R @@ -17,26 +17,19 @@ #' #' @noRd .parse_bbox <- function(bbox) { - if (is.character(bbox)) bbox <- strsplit(bbox, ",")[[1]] - if (!length(bbox) %in% c(4, 6)) .error("Param `bbox` must have 4 or 6 numbers, not %s.", length(bbox)) - if (length(bbox) == 4) { - if (bbox[[2]] > bbox[[4]]) bbox <- bbox[c(1, 4, 3, 2)] } else { - if (bbox[[2]] > bbox[[5]]) bbox <- bbox[c(1, 5, 3, 4, 2, 6)] - if (bbox[[3]] > bbox[[6]]) bbox <- bbox[c(1, 2, 6, 4, 5, 3)] } - return(bbox) } @@ -50,17 +43,12 @@ #' #' @noRd .parse_limit <- function(limit) { - if (length(limit) != 1) .error("Parameter `limit` must be a single value.") - limit <- as.character(limit) - limit_int <- suppressWarnings(as.integer(limit)) - if (any(is.na(as.integer(limit))) || as.character(limit_int) != limit) .error("Param `limit` must be an integer.") - return(limit) } @@ -75,10 +63,8 @@ #' #' @noRd .parse_feature_id <- function(feature_id) { - if (length(feature_id) != 1) .error("Parameter `feature_id` must be a single value.") - return(feature_id) } @@ -92,19 +78,15 @@ #' #' @noRd .parse_collections <- function(collections) { - - if (is.list(collections)) - for (e in collections) - check_character(e, "Collection name must be a character value.") - else + if (is.list(collections)) { + for (col in collections) + check_character(col, "Collection name must be a character value.") + } else check_character(collections, "Collection name must be a character value.") - if (is.character(collections) && length(collections) == 1) collections <- strsplit(collections, ",")[[1]] - if (is.character(collections)) collections <- as.list(collections) - return(collections) } @@ -117,7 +99,6 @@ #' #' @noRd .parse_ids <- function(ids) { - if (is.list(ids)) { ids <- lapply(ids, function(id) { if (is.numeric(id)) @@ -133,7 +114,6 @@ ids <- strsplit(ids, ",")[[1]] ids <- as.list(ids) } - return(ids) } @@ -174,109 +154,48 @@ #' #' @noRd .parse_datetime <- function(datetime) { - # check if the date time provided is an open interval check_interval <- grepl("(?=^(\\..\\/.*)).+|(.*/\\..)", datetime, perl = TRUE) - if (check_interval) { # regex to separate the open interval elements split_datetime <- strsplit(datetime, "(\\/\\..)|(\\..\\/)", perl = TRUE) split_datetime <- split_datetime[[1]][which(unlist(split_datetime) != "")] - # checking if date time is in the RFC standards match_rfc <- .check_rfc_3339(split_datetime) - if (!match_rfc) .error(paste("The interval date time provided is not in RFC format,", "please check the RFC 3339 rules.")) - return(datetime) } else { - # Splits the vector elements with the dates by the backslash split_datetime <- strsplit(datetime, "/", perl = TRUE) split_datetime <- unlist(split_datetime) - # In case the vector has two elements it is a closed date time if (length(split_datetime) == 2) { # Checks if there is FALSE value in vector if (!all(.check_rfc_3339(split_datetime))) .error(paste0("The date time provided not follow the RFC 3339 format,", "please check the RFC 3339 rules.")) - # formatting the closed date time according to the RFC interval_dt <- as.POSIXct(split_datetime, tz = "UTC", tryFormats = c("%Y-%m-%dT%H:%M:%SZ", "%Y-%m-%d")) - # Check the interval, if the interval is wrong an error is returned if (interval_dt[1] > interval_dt[2]) { .error(paste("The closed date time provided is not in correct", "interval, the first date time shold be less than", "second.")) } - return(datetime) } - - # Check if date time is a fixed interval else { + # Check if date time is a fixed interval if (!all(.check_rfc_3339(split_datetime)) || length(split_datetime) != 1) .error(paste("The date time provided not follow the RFC 3339 format,", "please check the RFC 3339 rules.")) - return(datetime) } } } - -iso_3339_date_fullyear <- "[0-9]{4}" -iso_3339_date_month <- "(1[0-2]|0[1-9])" -iso_3339_date_mday <- "(3[01]|[12][0-9]|0[1-9])" -iso_3339_time_hour <- "(2[0-3]|[01][0-9])" -iso_3339_time_minute <- "([0-5][0-9])" -iso_3339_time_second <- "(60|[0-5][0-9])" -iso_3339_time_secfrac <- "(\\.[0-9]+)?" -iso_3339_time_numoffset <- paste0( - "[+-]", - paste( - iso_3339_time_hour, - iso_3339_time_minute, - sep = ":" - ) -) -iso_3339_time_offset <- paste0( - "(Z|", iso_3339_time_numoffset, ")" -) -iso_3339_partial_time <- paste0( - paste( - iso_3339_time_hour, - iso_3339_time_minute, - iso_3339_time_second, - sep = ":" - ), - iso_3339_time_secfrac -) -iso_3339_full_date <- paste( - iso_3339_date_fullyear, - iso_3339_date_month, - iso_3339_date_mday, - sep = "-" -) -iso_3339_full_time <- paste0( - iso_3339_partial_time, - iso_3339_time_offset -) -iso_3339_date_time <- paste0( - iso_3339_full_date, - "T", - iso_3339_full_time -) -grep_iso_3339_date <- function(x) { - grepl(paste0("^", iso_3339_full_date, "$"), x) -} -grep_iso_3339_date_time <- function(x) { - grepl(paste0("^", iso_3339_date_time, "$"), x) -} diff --git a/R/preview-utils.R b/R/preview-utils.R index 61efe433..eac51640 100644 --- a/R/preview-utils.R +++ b/R/preview-utils.R @@ -50,7 +50,7 @@ preview_read_file <- function(url) { make_get_request( url = url, httr::write_disk(path = temp_file, overwrite = TRUE), - error_msg = "Error in downloading" + error_msg = "Error while downloading" ) preview_switch( url, diff --git a/R/print.R b/R/print.R index cac9fd0e..75113fca 100644 --- a/R/print.R +++ b/R/print.R @@ -3,20 +3,20 @@ #' @description The print function covers all objects in the rstac package: #' #' \itemize{ -#' \item [stac()]: returns a `STACCatalog` document from +#' \item [stac()]: returns a `doc_catalog` document from #' `/stac` (v0.8.0) or `/` (v0.9.0 or v1.0.0) endpoint. -#' \item [stac_search()]: returns a `STACItemCollection` +#' \item [stac_search()]: returns a `doc_items` #' document from `/stac/search` (v0.8.0) or `/search` #' (v0.9.0 or v1.0.0) endpoint containing all Items that match #' the provided search predicates. #' \item [collections()]: implements the `/collections` and #' \code{/collections/\{collectionId\}} endpoints. The former returns -#' a `STACCollectionList` document that lists all collections published -#' by the server, and the later returns a single `STACCollection` +#' a `doc_collections` document that lists all collections published +#' by the server, and the later returns a single `doc_collection` #' document that describes a unique collection. -#' \item [items()]: retrieves a `STACItemCollection` document +#' \item [items()]: retrieves a `doc_items` document #' from \code{/collections/\{collectionId\}/items} endpoint and a -#' `STACItem` document from +#' `doc_item` document from #' \code{/collections/\{collectionId\}/items/\{itemId\}} endpoints. #' } #' @@ -27,19 +27,19 @@ #' Call `print()` function to print the rstac's objects. #' You can determine how many items will be printed using `n` parameter. #' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. +#' @param x either a `rstac_query` object expressing a STAC query +#' criteria or any `rstac_doc`. #' #' @param n number of entries to print. Each object has its own rule of -#' truncation: the `STACCollection` objects will print +#' truncation: the `doc_collection` objects will print #' 10 links by default. If the object has less than 20 collections, all -#' collections will be shown. In `STACItemCollection`, 10 features +#' collections will be shown. In `doc_items`, 10 features #' will be printed by default. To show all entries, use `n = Inf`. #' #' @param ... other parameters passed in the functions. #' #' @param tail A `logical` value indicating if last features in -#' STACItemCollection object must be show. +#' doc_items object must be show. #' #' @seealso #' [stac()] [stac_search()] [collections()] @@ -47,7 +47,7 @@ #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_item_collection <- #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", @@ -57,7 +57,7 @@ #' #' print(stac_item_collection, n = 10) #' -#' # STACCollectionList object +#' # doc_collections object #' stac_collection <- #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' collections() %>% @@ -65,19 +65,19 @@ #' #' print(stac_collection, n = 5) #' -#' # RSTACQuery object +#' # rstac_query object #' obj_rstac <- stac("https://brazildatacube.dpi.inpe.br/stac/") #' #' print(obj_rstac) #' } NULL -# ---- RSTACQuery ---- +# ---- rstac_query ---- #' @rdname print #' @export -print.RSTACQuery <- function(x, ...) { - cat(crayon::bold("###RSTACQuery"), fill = TRUE) +print.rstac_query <- function(x, ...) { + cat(crayon::bold("###rstac_query"), fill = TRUE) cat("-", crayon::bold("url:"), x$base_url, fill = TRUE) cat("-", crayon::bold("params:"), fill = TRUE) for (n in names(x$params)) { @@ -89,12 +89,12 @@ print.RSTACQuery <- function(x, ...) { invisible(x) } -# ---- STACCatalog ---- +# ---- doc_catalog ---- #' @rdname print #' @export -print.STACCatalog <- function(x, ...) { - cat(crayon::bold("###STACCatalog"), fill = TRUE) +print.doc_catalog <- function(x, ...) { + cat(crayon::bold("###Catalog"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) if (!is.null(x$description) && x$description != "") cat("-", crayon::bold("description:"), x$description, fill = TRUE) @@ -104,12 +104,12 @@ print.STACCatalog <- function(x, ...) { invisible(x) } -# ---- STACCollectionList ---- +# ---- doc_collections ---- #' @rdname print #' @export -print.STACCollectionList <- function(x, n = 10, ...) { - cat(crayon::bold("###STACCollectionList"), fill = TRUE) +print.doc_collections <- function(x, n = 10, ...) { + cat(crayon::bold("###Collections"), fill = TRUE) cat("-", crayon::bold("collections"), sprintf("(%s item(s)):", length(x$collections)), fill = TRUE) @@ -128,12 +128,12 @@ print.STACCollectionList <- function(x, n = 10, ...) { invisible(x) } -# ---- STACCollection ---- +# ---- doc_collection ---- #' @rdname print #' @export -print.STACCollection <- function(x, ...) { - cat(crayon::bold("###STACCollection"), fill = TRUE) +print.doc_collection <- function(x, ...) { + cat(crayon::bold("###Collection"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) if (!is.null(x$title) && x$title != "") cat("-", crayon::bold("title:"), x$title, fill = TRUE) @@ -144,28 +144,24 @@ print.STACCollection <- function(x, ...) { invisible(x) } -# ---- STACItemCollection ---- +# ---- doc_items ---- #' @rdname print #' @export -print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { - cat(crayon::bold("###STACItemCollection"), fill = TRUE) +print.doc_items <- function(x, n = 10, ..., tail = FALSE) { + cat(crayon::bold("###Items"), fill = TRUE) matched <- suppressWarnings(items_matched(x)) - if (!is.null(matched)) + if (!is.null(matched)) { cat("-", crayon::bold("matched feature(s):"), matched, fill = TRUE) - - if (!is.null(matched)) cat("-", crayon::bold("features"), sprintf("(%s item(s) / %s not fetched):", length(x$features), matched - length(x$features)), fill = TRUE) - else + } else cat("-", crayon::bold("features"), sprintf("(%s item(s)):", length(x$features)), fill = TRUE) - if (missing(n) && length(x$features) < 2 * n) n <- length(x$features) n <- min(n, length(x$features)) - seq_it <- seq_len(n) if (tail) seq_it <- seq.int(to = length(x$features), length.out = n) @@ -177,7 +173,6 @@ print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { if (n != length(x$features)) cat(sprintf(" - ... with %s more feature(s).", length(x$features) - n), fill = TRUE) - cat("-", crayon::bold("assets:"), paste0(items_assets(x), collapse = ", "), fill = TRUE) @@ -186,12 +181,12 @@ print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { invisible(x) } -# ---- STACItem ---- +# ---- doc_item ---- #' @rdname print #' @export -print.STACItem <- function(x, ...) { - cat(crayon::bold("###STACItem"), fill = TRUE) +print.doc_item <- function(x, ...) { + cat(crayon::bold("###Item"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) cat("-", crayon::bold("collection:"), x$collection, fill = TRUE) cat("-", crayon::bold("bbox:"), format_bbox(x$bbox), fill = TRUE) @@ -204,48 +199,97 @@ print.STACItem <- function(x, ...) { invisible(x) } -# ---- Queryables ---- +# ---- doc_queryables ---- #' @rdname print #' @export -print.Queryables <- function(x, n = 10, ...) { +print.doc_queryables <- function(x, n = 10, ...) { cat(crayon::bold("###Queryables"), fill = TRUE) - if (missing(n) && length(x$properties) < 2 * n) { n <- length(x$properties) } n <- min(n, length(x$properties)) + cat("-", crayon::bold("properties"), + sprintf("(%s entries(s)):", length(x$properties)), fill = TRUE) if (n > 0) { seq_it <- seq_len(n) - cat("-", crayon::bold("properties"), fill = TRUE) for (i in seq_it) { e <- names(x$properties[i]) cat(paste0(" - ", e), fill = TRUE) } + if (n != length(x$properties)) + cat(sprintf(" - ... with %s more entry(ies).", + length(x$properties) - n), fill = TRUE) } - cat("-", crayon::bold("field(s):"), - paste0(names(x), collapse = ", "), fill = TRUE) + cat("-", crayon::bold("field(s):"), paste0(names(x), collapse = ", "), + fill = TRUE) invisible(x) } -# ---- Conformance ---- +# ---- doc_conformance ---- #' @rdname print #' @export -print.Conformance <- function(x, n = 5, ...) { +print.doc_conformance <- function(x, n = 10, ...) { cat(crayon::bold("###Conformance"), fill = TRUE) - if (missing(n) && length(x$conformsTo) < 2 * n) { n <- length(x$conformsTo) } n <- min(n, length(x$conformsTo)) + cat("-", crayon::bold("conformances"), + sprintf("(%s entries(s)):", length(x$conformsTo)), fill = TRUE) if (n > 0) { seq_it <- seq_len(n) - cat("-", crayon::bold("conformsTo: "), fill = TRUE) for (i in seq_it) { e <- x$conformsTo[[i]] cat(paste0(" - ", e), fill = TRUE) } + if (n != length(x$conformsTo)) + cat(sprintf(" - ... with %s more entry(ies).", + length(x$conformsTo) - n), fill = TRUE) + } + invisible(x) +} + +# ---- Links ---- + +#' @rdname print +#' @export +print.doc_link <- function(x, ...) { + cat(crayon::bold("###Link"), fill = TRUE) + if ("title" %in% names(x)) + cat("-", crayon::bold(x$title), fill = TRUE) + cat("-", crayon::bold("href:"), x$href, fill = TRUE) + cat("-", crayon::bold("rel:"), x$rel, fill = TRUE) + cat("-", crayon::bold("field(s):"), + paste0(names(x), collapse = ", "), fill = TRUE) + invisible(x) +} + +#' @rdname print +#' @export +print.doc_links <- function(x, n = 10, ...) { + cat(crayon::bold("###Links"), fill = TRUE) + if (missing(n) && length(x) < 2 * n) + n <- length(x) + n <- min(n, length(x)) + cat("-", crayon::bold("links"), + sprintf("(%s entries(s)):", length(x)), fill = TRUE) + if (n > 0) { + seq_it <- seq_len(n) + seq_format <- format(seq_it, width = min(3, floor(log10(n)) + 1)) + for (i in seq_it) { + if ("title" %in% names(x[[i]])) { + cat(seq_format[[i]], crayon::bold(x[[i]]$title), + paste0("(", x[[i]]$href, ")"), fill = TRUE) + } else if ("rel" %in% names(x[[i]])) { + cat(seq_format[[i]], crayon::bold(paste0("[", x[[i]]$rel, "]")), + paste0("(", x[[i]]$href, ")"), fill = TRUE) + } else + cat(seq_format[[i]], paste0("(", x[[i]]$href, ")"), fill = TRUE) + } + if (n != length(x)) + cat(sprintf(" ... with %s more link(s).", length(x) - n), fill = TRUE) } invisible(x) } diff --git a/R/query-funs.R b/R/query-funs.R index f8ad356e..6a299039 100644 --- a/R/query-funs.R +++ b/R/query-funs.R @@ -1,8 +1,8 @@ #' @title Query development functions #' #' @describeIn extensions -#' The `RSTACQuery()` function is a constructor of `RSTACQuery` -#' objects. Every extension must implement a subclass of `RSTACQuery` to +#' The `rstac_query()` function is a constructor of `rstac_query` +#' objects. Every extension must implement a subclass of `rstac_query` to #' represent its queries. This is done by informing to the `subclass` #' parameter the extension's subclass name. #' @@ -32,9 +32,9 @@ #' object to be created. #' #' @return -#' The `RSTACQuery()` function returns a `STACQuery` object with +#' The `rstac_query()` function returns a `STACQuery` object with #' subclass defined by `subclass` parameter. -RSTACQuery <- function(version = NULL, base_url, params = list(), subclass) { +rstac_query <- function(version = NULL, base_url, params = list(), subclass) { structure( list(version = version, base_url = base_url, @@ -42,43 +42,32 @@ RSTACQuery <- function(version = NULL, base_url, params = list(), subclass) { params = params, verb = "GET", encode = NULL), - class = c(subclass, "RSTACQuery")) + class = c(subclass, "rstac_query")) } #' @export -stac_version.RSTACQuery <- function(x, ...) { - +stac_version.rstac_query <- function(x, ...) { if (!is.null(x$version)) return(x$version) - version <- NULL # check in '/' endpoint res <- make_get_request( - url = make_url(x$base_url, endpoint = "/"), ... + url = resolve_url(x$base_url, "./"), + ... ) if (!is.null(res)) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - version <- content[["stac_version"]] + content <- content_response_json(res) + version <- content$stac_version } - - # if no version was found, try '/stac' endpoint + # if no version was found, try './stac' endpoint if (is.null(version)) { res <- make_get_request( - url = make_url(x$base_url, endpoint = "/stac"), ..., error_msg = NULL + url = resolve_url(x$base_url, "./stac"), + ... ) if (!is.null(res)) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - version <- content[["stac_version"]] + content <- content_response_json(res) + version <- content$stac_version } } if (is.null(version)) @@ -86,38 +75,14 @@ stac_version.RSTACQuery <- function(x, ...) { "Could not determine STAC version in URL '%s'.", "Please, use 'force_version' parameter in stac() function" ), x$base_url) - - return(version) -} - -#' @export -subclass.RSTACQuery <- function(x) { - - setdiff(class(x), "RSTACQuery") -} - -#' @export -check_subclass.RSTACQuery <- function(x, subclasses) { - - if (!any(subclasses %in% subclass(x))) - .error("Expecting %s query.", - paste0("`", subclasses, "`", collapse = " or ")) -} - -#' @export -endpoint.RSTACQuery <- function(q) { - - .error("No endpoint was defined for the extension `%s`.", subclass(q)) + version } #' @export -before_request.RSTACQuery <- function(q) { - - check_query_verb(q, "") +subclass.rstac_query <- function(x) { + setdiff(class(x), "rstac_query") } -#' @export -after_response.RSTACQuery <- function(q, res) { - - check_query_verb(q, "") +query_class <- function(q) { + class(q)[[1]] } diff --git a/R/queryables-query.R b/R/queryables-query.R index aa80a415..c970c108 100644 --- a/R/queryables-query.R +++ b/R/queryables-query.R @@ -6,12 +6,12 @@ #' This endpoint can be accessed from the catalog (`/queryables`) #' or from a collection (`/collections/{collection_id}/queryables`). #' -#' @param q a `RSTACQuery` object expressing a STAC query criteria. +#' @param q a `rstac_query` object expressing a STAC query criteria. #' #' @seealso [ext_filter()], [conformance()], [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `queryables` for `/queryables` +#' A `rstac_query` object with the subclass `queryables` for `/queryables` #' endpoint. #' #' @examples @@ -29,41 +29,26 @@ #' #' @export queryables <- function(q) { - # check q parameter - check_subclass(q, c("collection_id", "stac")) - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = q$params, - subclass = unique(c("queryables", subclass(q)))) -} - -#' @export -endpoint.queryables <- function(q) { - if ("collection_id" %in% subclass(q)) { - col_id <- q$params[["collection_id"]] - return(paste("/collections", col_id, "queryables", sep = "/")) - } - return("/queryables") + check_query(q, c("collection_id", "stac")) + rstac_query( + version = q$version, + base_url = q$base_url, + params = q$params, + subclass = "queryables" + ) } #' @export before_request.queryables <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - # don't send 'collection_id' in url's query string or content body - if ("collection_id" %in% subclass(q)) { - q <- omit_query_params(q, names = "collection_id") - } - return(q) + if ("collection_id" %in% names(q$params)) + return(set_query_endpoint(q, endpoint = "./collections/%s/queryables", + params = "collection_id")) + set_query_endpoint(q, endpoint = "./queryables") } #' @export after_response.queryables <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "Queryables") + content <- content_response_json(res) + doc_queryables(content) } diff --git a/R/request.R b/R/request.R index 41eb2d0c..cbc762c7 100644 --- a/R/request.R +++ b/R/request.R @@ -8,7 +8,7 @@ #' The `post_request` is function that makes HTTP POST #' requests to STAC web services, retrieves, and parse the data. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param encode a `character` informing the request body @@ -26,8 +26,8 @@ #' [items()] #' #' @return -#' Either a `STACCatalog`, `STACCollection`, -#' `STACCollectionList`, `STACItemCollection` or `STACItem` +#' Either a `doc_catalog`, `doc_collection`, +#' `doc_collections`, `doc_items` or `doc_item` #' object depending on the subclass and search fields parameters of `q` #' argument. #' @@ -42,118 +42,39 @@ #' } #' @export get_request <- function(q, ...) { - - # check the object class - .check_obj(q, "RSTACQuery") - - # stamp verb + check_query(q) q$verb <- "GET" q$encode <- NULL - - # check version q$version <- stac_version(q, ...) - - # set endpoint - q$endpoint <- endpoint(q) - - # process STAC object q <- before_request(q) - - # process omitted params - q <- .do_omit_query_params(q) - res <- make_get_request( - url = make_url(q$base_url, endpoint = q$endpoint), - query = .querystrings_encode(q$params), ... + url = resolve_url(q$base_url, q$endpoint), + query = query_encode(q$params), + ..., + error_msg = "Error while requesting" ) - - # restore omitted params - q <- .undo_omit_query_params(q) - - # process content according to status-code and content-type - content <- after_response(q, res = res) - - return(content) + # process content and return + after_response(q, res = res) } #' @rdname request #' @export post_request <- function(q, ..., encode = c("json", "multipart", "form")) { - - # check the object class - .check_obj(q, "RSTACQuery") - + check_query(q) # check request settings - httr_encode <- c("json", "multipart", "form") encode <- encode[[1]] - if (!encode %in% httr_encode) - .error("Invalid body `encode` '%s'. Allowed `encode` are %s.", - encode, paste0("'", httr_encode, "'", collapse = ", ")) - - # stamp verb + check_body_encode(encode) q$verb <- "POST" q$encode <- encode - - # detect version q$version <- stac_version(q, ...) - - # set endpoint - q$endpoint <- endpoint(q) - - # process STAC object q <- before_request(q) - - # process omitted params - q <- .do_omit_query_params(q) - - tryCatch({ - res <- httr::POST(url = make_url(q$base_url, endpoint = q$endpoint), ..., - body = q$params, encode = q$encode) - }, - error = function(e) { - .error("Request error. %s", e$message) - }) - - # restore omitted params - q <- .undo_omit_query_params(q) - - # process content according to status-code and content-type - content <- after_response(q, res = res) - - return(content) -} - -#' @describeIn extensions -#' The `.do_omit_query_params()` Function to make the omission of the -#' parameters that were omitted in function `omit_query_params()`. -#' -#' @param q a `RSTACQuery` object. -#' -#' @noRd -.do_omit_query_params <- function(q) { - - if (is.character(q$omitted)) { - - to_omit <- names(q$param) %in% q$omitted - if (length(to_omit) > 0) { - q$omitted <- q$params[to_omit] - q$params[to_omit] <- NULL - } - } - q -} - -#' @describeIn extensions -#' The `.undo_omit_query_params()` function to undo the omission of -#' parameters that were omitted in function `omit_query_params()`. -#' -#' @param q a `RSTACQuery` object. -#' -#' @noRd -.undo_omit_query_params <- function(q) { - - if (is.list(q$omitted)) - q$params <- utils::modifyList(q$params, q$omitted) - q$omitted <- NULL - q + res <- make_post_request( + url = resolve_url(q$base_url, q$endpoint), + body = q$params, + encode = q$encode, + ..., + error_msg = "Error while requesting" + ) + # process content and return + after_response(q, res = res) } diff --git a/R/rstac-funs.R b/R/rstac-funs.R new file mode 100644 index 00000000..5f6c738a --- /dev/null +++ b/R/rstac-funs.R @@ -0,0 +1,15 @@ +# doc_items <- function(items) { +# if (!"features" %in% names(items)) { +# stac_version <- "1.0.0" +# if (length(items) > 0 && "stac_version" %in% names(items[[1]])) { +# stac_version <- items[[1]]$stac_version +# } +# items <- list( +# type = "FeatureCollection", +# stac_version = stac_version, +# features = items +# ) +# } +# items$features <- lapply(items$features, doc_item) +# structure(items, class = c("doc_items", "rstac_doc", "list")) +# } diff --git a/R/rstac.R b/R/rstac.R index c085417b..01a407b0 100644 --- a/R/rstac.R +++ b/R/rstac.R @@ -44,9 +44,9 @@ #' } #' #' @section Data types: -#' The package implements the following S3 classes: `STACItemCollection`, -#' `STACItem`, `STACCatalog`, `STACCollectionList` and -#' `STACCollection`. These classes are regular lists representing the +#' The package implements the following S3 classes: `doc_items`, +#' `doc_item`, `doc_catalog`, `doc_collections` and +#' `doc_collection`. These classes are regular lists representing the #' corresponding JSON STAC objects. #' #' @name rstac diff --git a/R/stac_search.R b/R/search-query.R similarity index 75% rename from R/stac_search.R rename to R/search-query.R index df1aa317..1be4d79b 100644 --- a/R/stac_search.R +++ b/R/search-query.R @@ -9,10 +9,10 @@ #' It prepares query parameters used in the search API request, a #' `stac` object with all filter parameters to be provided to #' `get_request` or `post_request` functions. The GeoJSON content -#' returned by these requests is a `STACItemCollection` object, a regular R +#' returned by these requests is a `doc_items` object, a regular R #' `list` representing a STAC Item Collection document. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param collections a `character` vector of collection IDs to include in @@ -68,7 +68,7 @@ #' [get_request()], [post_request()] #' #' @return -#' A `RSTACQuery` object with the subclass `search` containing all +#' A `rstac_query` object with the subclass `search` containing all #' search field parameters to be provided to STAC API web service. #' #' @examples @@ -94,31 +94,21 @@ stac_search <- function(q, datetime = NULL, intersects = NULL, limit = NULL) { - - # check q parameter - check_subclass(q, c("stac", "search")) - + check_query(q, c("stac", "search")) params <- list() - if (!is.null(collections)) - params[["collections"]] <- .parse_collections(collections) - + params$collections <- .parse_collections(collections) if (!is.null(ids)) - params[["ids"]] <- .parse_ids(ids) - + params$ids <- .parse_ids(ids) if (!is.null(datetime)) - params[["datetime"]] <- .parse_datetime(datetime) - + params$datetime <- .parse_datetime(datetime) if (!is.null(bbox)) - params[["bbox"]] <- .parse_bbox(bbox) - + params$bbox <- .parse_bbox(bbox) if (!is.null(intersects)) - params[["intersects"]] <- .parse_intersects(intersects) - + params$intersects <- .parse_intersects(intersects) if (!is.null(limit)) - params[["limit"]] <- .parse_limit(limit) - - RSTACQuery( + params$limit <- .parse_limit(limit) + rstac_query( version = q$version, base_url = q$base_url, params = utils::modifyList(q$params, params), @@ -128,46 +118,30 @@ stac_search <- function(q, #' @export parse_params.search <- function(q, params) { - - if (!is.null(params[["collections"]])) - params[["collections"]] <- .parse_collections(params[["collections"]]) - - if (!is.null(params[["ids"]])) - params[["ids"]] <- .parse_ids(params[["ids"]]) - - if (!is.null(params[["datetime"]])) - params[["datetime"]] <- .parse_datetime(params[["datetime"]]) - - if (!is.null(params[["bbox"]])) - params[["bbox"]] <- .parse_bbox(params[["bbox"]]) - - if (!is.null(params[["intersects"]])) - params[["intersects"]] <- .parse_intersects(params[["intersects"]]) - - if (!is.null(params[["limit"]])) - params[["limit"]] <- .parse_limit(params[["limit"]]) - + if (!is.null(params$collections)) + params$collections <- .parse_collections(params$collections) + if (!is.null(params$ids)) + params$ids <- .parse_ids(params$ids) + if (!is.null(params$datetime)) + params$datetime <- .parse_datetime(params$datetime) + if (!is.null(params$bbox)) + params$bbox <- .parse_bbox(params$bbox) + if (!is.null(params$intersects)) + params$intersects <- .parse_intersects(params$intersects) + if (!is.null(params$limit)) + params$limit <- .parse_limit(params$limit) params } -#' @export -endpoint.search <- function(q) { - - if (q$version < "0.9.0") - return("/stac/search") - return("/search") -} - #' @export before_request.search <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - if (!is.null(q$params[["intersects"]]) && q$verb == "GET") + if (!is.null(q$params$intersects) && q$verb == "GET") .error(paste0("Search param `intersects` is not supported by HTTP GET", - "method. Try use `post_request` method instead.")) - - return(q) + "method. Try use `post_request()` method instead.")) + if (!is.null(q$version) && q$version < "0.9.0") + return(set_query_endpoint(q, endpoint = "./stac/search")) + set_query_endpoint(q, endpoint = "./search") } #' @export diff --git a/R/signatures.R b/R/signatures.R index 4228de61..cd9a5fe9 100644 --- a/R/signatures.R +++ b/R/signatures.R @@ -16,7 +16,7 @@ ms_token <- new_env() #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", #' datetime = "2019-06-01/2019-08-01") %>% @@ -36,8 +36,9 @@ sign_bdc <- function(access_token = NULL, ...) { # append the same token for an asset parse <- function(obj_req) { - token_str <- paste0("?access_token=", obj_req[["token"]]) - obj_req[["token_value"]] <- httr::parse_url(token_str)[["query"]] + token_str <- paste0("?access_token=", obj_req$token) + parsed_url <- httr::parse_url(token_str) + obj_req$token_value <- parsed_url$query obj_req } @@ -53,7 +54,7 @@ sign_bdc <- function(access_token = NULL, ...) { token[["default"]] <<- list("token" = Sys.getenv("BDC_ACCESS_KEY")) } - token[["default"]] <<- parse(token[["default"]]) + token[["default"]] <<- parse(token$default) } exists_token <- function(item) { @@ -61,7 +62,7 @@ sign_bdc <- function(access_token = NULL, ...) { } get_token_value <- function(item) { - token[["default"]][["token_value"]] + token$default$token_value } # in the current implementation bdc tokens do not expire @@ -75,12 +76,12 @@ sign_bdc <- function(access_token = NULL, ...) { sign_asset <- function(asset, token) { - asset_url <- httr::parse_url(asset[["href"]]) + asset_url <- httr::parse_url(asset$href) # if the href is already sign it will not be modified asset_url$query <- modify_list(asset_url$query, token) - asset[["href"]] <- httr::build_url(asset_url) + asset$href <- httr::build_url(asset_url) asset } @@ -89,8 +90,7 @@ sign_bdc <- function(access_token = NULL, ...) { if (!exists_token(item) || is_token_expired(item)) new_token(item) - item$assets <- lapply(item$assets, sign_asset, - get_token_value(item)) + item$assets <- lapply(item$assets, sign_asset, get_token_value(item)) return(item) } @@ -119,7 +119,7 @@ sign_bdc <- function(access_token = NULL, ...) { #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") %>% #' stac_search(collections = "sentinel-2-l2a", #' bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% @@ -149,11 +149,11 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { ms_token_endpoint <- "https://planetarycomputer.microsoft.com/api/sas/v1/token" get_ms_info <- function(asset) { - parsed_url <- httr::parse_url(asset[["href"]]) + parsed_url <- httr::parse_url(asset$href) host_spplited <- strsplit( - x = parsed_url[["hostname"]], split = ".", fixed = TRUE + x = parsed_url$hostname, split = ".", fixed = TRUE ) - path_spplited <- strsplit(parsed_url[["path"]], split = "/", fixed = TRUE) + path_spplited <- strsplit(parsed_url$path, split = "/", fixed = TRUE) list( acc = host_spplited[[1]][[1]], @@ -162,17 +162,17 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { } get_ms_acc <- function(ms_info) { - ms_info[["acc"]] + ms_info$acc } get_ms_cnt <- function(ms_info) { - ms_info[["cnt"]] + ms_info$cnt } is_public_asset <- function(parsed_url) { ms_blob_name <- ".blob.core.windows.net" ms_public_assets <- "ai4edatasetspublicassets.blob.core.windows.net" - host <- parsed_url[["hostname"]] + host <- parsed_url$hostname !endsWith(host, ms_blob_name) || host == ms_public_assets } @@ -188,8 +188,9 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { res[["msft:expiry"]], "%Y-%m-%dT%H:%M:%SZ" )) - token_str <- paste0("?", res[["token"]]) - res[["token_value"]] <- httr::parse_url(token_str)[["query"]] + token_str <- paste0("?", res$token) + parsed_url <- httr::parse_url(token_str) + res$token_value <- parsed_url$query res } @@ -214,29 +215,26 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { if (exists_token(acc, cnt) && !is_token_expired(acc, cnt)) return(NULL) res <- make_get_request( url = paste(ms_token_endpoint, acc, cnt, sep = "/"), - httr::add_headers(.headers = headers), ... - ) - res_content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") + httr::add_headers(.headers = headers), + ..., + error_msg = "Error while requesting" ) + content <- content_response_json(res) if (!acc %in% names(ms_token)) { assign(acc, value = list(), envir = ms_token) } - ms_token[[acc]][[cnt]] <- parse_token(res_content) + ms_token[[acc]][[cnt]] <- parse_token(content) } get_token <- function(acc, cnt) { new_token(acc, cnt) # get token value from global variable - ms_token[[acc]][[cnt]][["token_value"]] + ms_token[[acc]][[cnt]]$token_value } sign_asset <- function(asset) { # public assets do not require a signature - parsed_url <- httr::parse_url(asset[["href"]]) + parsed_url <- httr::parse_url(asset$href) if (is_public_asset(parsed_url)) { return(asset) } @@ -246,9 +244,9 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { # get an existing token or generate a new one token_value <- get_token(account, container) # if the href is already sign it will not be modified - parsed_url$query <- modify_list(parsed_url[["query"]], token_value) + parsed_url$query <- modify_list(parsed_url$query, token_value) - asset[["href"]] <- httr::build_url(parsed_url) + asset$href <- httr::build_url(parsed_url) asset } diff --git a/R/stac-funs.R b/R/stac-funs.R new file mode 100644 index 00000000..38b18578 --- /dev/null +++ b/R/stac-funs.R @@ -0,0 +1,46 @@ +#' @title Utility functions +#' +#' @description +#' These function retrieves information about either `rstac` queries +#' (`rstac_query` objects) or `rstac` documents +#' (`rstac_doc` objects). +#' +#' @param x either a `rstac_query` object expressing a STAC query +#' criteria or any `rstac_doc`. +#' +#' @param ... config parameters to be passed to [GET][httr::GET] +#' method, such as [add_headers][httr::add_headers] or [set_cookies][httr::set_cookies]. +#' +#' @return +#' The `stac_version()` function returns a `character` STAC API +#' version. +#' +#' @export +stac_version <- function(x, ...) { + UseMethod("stac_version", x) +} + +stac_subclass <- function(obj) { + if (!is.list(obj) || is.null(names(obj))) + .error("Invalid STAC document.") + if ("type" %in% names(obj)) { + if (obj$type == "Feature") + return("doc_item") + if (obj$type == "FeatureCollection") + return("doc_items") + if (obj$type == "Collection") + return("doc_collection") + .error("Invalid STAC document. Key value 'type': '", obj$type, + "' is not a supported STAC document.") + } else { + if ("conformsTo" %in% names(obj)) + return("doc_conformance") + if ("collections" %in% names(obj)) + return("doc_collections") + if ("id" %in% names(obj) && "links" %in% names(obj)) + return("doc_collection") + if ("links" %in% names(obj)) + return("doc_catalog") + .error("Invalid STAC document.") + } +} diff --git a/R/stac-query.R b/R/stac-query.R index f3c4216e..9c21ca71 100644 --- a/R/stac-query.R +++ b/R/stac-query.R @@ -20,7 +20,7 @@ #' [post_request()] #' #' @return -#' A `RSTACQuery` object with the subclass `stac` containing all +#' A `rstac_query` object with the subclass `stac` containing all #' request parameters to be provided to API service. #' #' @examples @@ -32,42 +32,32 @@ #' @rdname stac #' @export stac <- function(base_url, force_version = NULL) { - # check url parameter - .check_obj(base_url, "character") - + check_character(base_url, "STAC URL must be a character value.") # check version force_version <- force_version[[1]] if (!is.null(force_version) && force_version < "0.8.0") .warning("STAC API version '%s' is not supported by `rstac` package.", force_version) - # create a new STAC - RSTACQuery(version = force_version, - base_url = base_url, - params = list(), - subclass = "stac") -} - -#' @export -endpoint.stac <- function(q) { - if (q$version < "0.9.0") - return("/stac") - return("/") + base_url <- url_normalize(base_url) + rstac_query( + version = force_version, + base_url = base_url, + params = list(), + subclass = "stac" + ) } #' @export before_request.stac <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - return(q) + if (!is.null(q$version) && q$version < "0.9.0") + return(set_query_endpoint(q, endpoint = "./stac")) + set_query_endpoint(q, endpoint = "./") } #' @export after_response.stac <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "STACCatalog") + content <- content_response_json(res) + doc_catalog(content) } diff --git a/R/stac_version.R b/R/stac_version.R deleted file mode 100644 index d43d44cb..00000000 --- a/R/stac_version.R +++ /dev/null @@ -1,22 +0,0 @@ -#' @title Utility functions -#' -#' @description -#' These function retrieves information about either `rstac` queries -#' (`RSTACQuery` objects) or `rstac` documents -#' (`RSTACDocument` objects). -#' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. -#' -#' @param ... config parameters to be passed to [GET][httr::GET] -#' method, such as [add_headers][httr::add_headers] or [set_cookies][httr::set_cookies]. -#' -#' @return -#' The `stac_version()` function returns a `character` STAC API -#' version. -#' -#' @export -stac_version <- function(x, ...) { - - UseMethod("stac_version", x) -} diff --git a/R/url-utils.R b/R/url-utils.R index 3f63dffe..c960022f 100644 --- a/R/url-utils.R +++ b/R/url-utils.R @@ -1,18 +1,73 @@ -make_url <- function(url, endpoint = "", params = list()) { - # remove trailing '/' char - if (substring(url, nchar(url)) == "/") - url <- substring(url, 1, nchar(url) - 1) - endpoint <- paste0(endpoint, collapse = "/") +remove_dot_segments <- function(path) { + while (grepl("[^/]+/\\.\\./?", path)) { + path <- gsub("[^/]+/\\.\\./?", "", path) + } + path <- gsub("(\\./)+", "", path) + gsub("/\\.$", "/", path) +} + +remove_last_segment <- function(path) { + gsub("/[^/]*$", "", path) +} + +resolve_url <- function(url, new_url) { + parsed_url <- httr::parse_url(url) + if (is.null(new_url) || new_url == "") { + return(httr::build_url(parsed_url)) + } + parsed_new <- httr::parse_url(new_url) + if (!is.null(parsed_new$scheme)) { + return(new_url) + } else { + if (!is.null(parsed_new$hostname)) { + parsed_url$hostname <- parsed_new$hostname + parsed_url$path <- parsed_new$path + parsed_url$query <- parsed_new$query + parsed_url$params <- parsed_new$params + parsed_url$fragment <- parsed_new$fragment + } else if (parsed_new$path != "") { + if (startsWith(parsed_new$path, "/")) + path <- parsed_new$path + else { + path <- remove_last_segment(parsed_url$path) + path <- paste(path, parsed_new$path, sep = "/") + } + parsed_url$path <- remove_dot_segments(path) + parsed_url$query <- parsed_new$query + parsed_url$params <- parsed_new$params + parsed_url$fragment <- parsed_new$fragment + } else if (!is.null(parsed_new$query)) { + parsed_url$query <- parsed_new$query + } else if (!is.null(parsed_new$params)) { + parsed_url$params <- parsed_new$params + path <- remove_last_segment(parsed_url$path) + path <- paste(path, parsed_new$path, sep = "/") + parsed_url$path <- remove_dot_segments(path) + parsed_url$query <- parsed_new$query + } else if (!is.null(parsed_new$fragment)) { + parsed_url$fragment <- parsed_new$fragment + } + } + httr::build_url(parsed_url) +} - res <- paste0(url, endpoint) +is_url_file <- function(url) { + parsed_url <- httr::parse_url(url) + grepl("/[^/]+\\.[^/]+$", parsed_url$path) +} - return(res) +url_normalize <- function(url) { + if (!is_url_file(url)) + url <- paste0(gsub("/$", "", url), "/") + url } -make_get_request <- function(url, ..., error_msg = "Error while requesting") { +make_get_request <- function(url, ..., headers = NULL, error_msg = NULL) { + if (!is.null(headers)) + headers <- httr::add_headers(headers) tryCatch({ - httr::GET(url, ...) + httr::GET(url, headers, ...) }, error = function(e) { if (!is.null(error_msg)) @@ -20,33 +75,26 @@ make_get_request <- function(url, ..., error_msg = "Error while requesting") { }) } -.querystrings_encode <- function(params) { - return(lapply(params, paste0, collapse = ",")) -} - -.querystring_decode <- function(querystring) { - # first decode and remove all coded spaces - querystring <- URLdecode(querystring) - querystring_spplited <- strsplit(querystring, split = "&")[[1]] - # remove empty spaces - querystring_spplited <- querystring_spplited[nzchar(querystring_spplited)] - values <- lapply(querystring_spplited, - function(x) regmatches(x, regexpr("=", x), invert = TRUE)[[1]]) - params <- lapply(values, `[[`, 2) - names(params) <- map_chr(values, `[[`, 1) - return(params) +make_post_request <- function(url, ..., body, + encode = c("json", "multipart", "form"), + headers = NULL, + error_msg = NULL) { + # check request settings + encode <- encode[[1]] + check_body_encode(encode) + if (!is.null(headers)) + headers <- httr::add_headers(headers) + tryCatch({ + httr::POST(url, body = body, encode = encode, headers, ...) + }, + error = function(e) { + if (!is.null(error_msg)) + .error(paste(error_msg, "'%s'. \n%s"), url, e$message) + }) } -.validate_query <- function(params) { - - if (!is.null(params$query) && is.character(params$query)) { - params$query <- jsonlite::fromJSON(params$query, simplifyVector = FALSE) - - if (is.list(params$query)) - params$query <- list(params$query) - } - - return(params) +query_encode <- function(params) { + return(lapply(params, paste0, collapse = ",")) } gdalvsi_schema <- function(url) { @@ -84,29 +132,6 @@ format_bbox <- function(bbox) { sprintf("%.5f", bbox), collapse = ", ")) } -asset_download <- function(asset, - output_dir, - overwrite, ..., - download_fn = NULL) { - if (!is.null(download_fn)) - return(download_fn(asset)) - - # create a full path name - path <- url_get_path(asset$href) - out_file <- path_normalize(output_dir, path) - dir_create(out_file) - - make_get_request( - url = asset$href, - httr::write_disk(path = out_file, overwrite = overwrite), - ..., - error_msg = "Error in downloading" - ) - asset$href <- path - - asset -} - path_normalize <- function(...) { path <- file.path(...) path <- gsub("\\\\", "/", path) @@ -116,7 +141,8 @@ path_normalize <- function(...) { } url_get_path <- function(url) { - return(httr::parse_url(url)[["path"]]) + parsed_url <- httr::parse_url(url) + return(parsed_url$path) } dir_create <- function(path) { @@ -133,3 +159,10 @@ dir_create <- function(path) { path_get_dir <- function(path) { return(gsub("^\\.", "", dirname(path))) } + +check_body_encode <- function(encode) { + valid_encodes <- c("json", "multipart", "form") + if (!encode %in% valid_encodes) + .error("Invalid body `encode` '%s'. Allowed `encode` are %s.", + encode, paste0("'", valid_encodes, "'", collapse = ", ")) +} diff --git a/man/RSTACDocument.Rd b/man/RSTACDocument.Rd deleted file mode 100644 index 011c9cdb..00000000 --- a/man/RSTACDocument.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/document-funs.R -\name{RSTACDocument} -\alias{RSTACDocument} -\title{Document development functions} -\usage{ -RSTACDocument(content, q = NULL, subclass = NULL) -} -\arguments{ -\item{content}{a \code{list} data structure representing the JSON file -received in HTTP response (see \code{\link[=content_response]{content_response()}} function)} - -\item{q}{a \code{RSTACQuery} object expressing the STAC query used -to retrieve the document.} - -\item{subclass}{a \code{character} corresponding to the subclass of the -document to be created.} -} -\value{ -The \code{RSTACDocument()} function returns a \code{RSTACDocument} object -with subclass defined by \code{subclass} parameter. -} -\description{ -Document development functions -} -\keyword{internal} diff --git a/man/assets_filter.Rd b/man/assets_filter.Rd deleted file mode 100644 index bb994875..00000000 --- a/man/assets_filter.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprec-funs.R -\name{assets_filter} -\alias{assets_filter} -\alias{assets_filter.STACItemCollection} -\alias{assets_filter.STACItem} -\title{Assets filter (Deprecated)} -\usage{ -assets_filter(items, ..., filter_fn = NULL) - -\method{assets_filter}{STACItemCollection}(items, ..., filter_fn = NULL) - -\method{assets_filter}{STACItem}(items, ..., filter_fn = NULL) -} -\arguments{ -\item{items}{a \code{STACItemCollection} object representing -the result of \verb{/stac/search}, \code{/collections/{collectionId}/items}.} - -\item{...}{additional arguments. See details.} - -\item{filter_fn}{a \code{function} that will be used to filter the -attributes listed in the properties.} -} -\value{ -a \code{list} with the attributes of date, bands and paths. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} diff --git a/man/assets_functions.Rd b/man/assets_functions.Rd index 8ff13209..027e8137 100644 --- a/man/assets_functions.Rd +++ b/man/assets_functions.Rd @@ -3,24 +3,24 @@ \name{assets_functions} \alias{assets_functions} \alias{assets_download} -\alias{assets_download.STACItem} -\alias{assets_download.STACItemCollection} +\alias{assets_download.doc_item} +\alias{assets_download.doc_items} \alias{assets_download.default} \alias{assets_url} -\alias{assets_url.STACItem} -\alias{assets_url.STACItemCollection} +\alias{assets_url.doc_item} +\alias{assets_url.doc_items} \alias{assets_url.default} \alias{assets_select} -\alias{assets_select.STACItem} -\alias{assets_select.STACItemCollection} +\alias{assets_select.doc_item} +\alias{assets_select.doc_items} \alias{assets_select.default} \alias{assets_rename} -\alias{assets_rename.STACItem} -\alias{assets_rename.STACItemCollection} +\alias{assets_rename.doc_item} +\alias{assets_rename.doc_items} \alias{assets_rename.default} \alias{has_assets} -\alias{has_assets.STACItem} -\alias{has_assets.STACItemCollection} +\alias{has_assets.doc_item} +\alias{has_assets.doc_items} \alias{has_assets.default} \alias{asset_key} \alias{asset_eo_bands} @@ -37,7 +37,7 @@ assets_download( fn = deprecated() ) -\method{assets_download}{STACItem}( +\method{assets_download}{doc_item}( items, asset_names = NULL, output_dir = getwd(), @@ -48,7 +48,7 @@ assets_download( fn = deprecated() ) -\method{assets_download}{STACItemCollection}( +\method{assets_download}{doc_items}( items, asset_names = NULL, output_dir = getwd(), @@ -74,33 +74,33 @@ assets_download( assets_url(items, asset_names = NULL, append_gdalvsi = FALSE) -\method{assets_url}{STACItem}(items, asset_names = NULL, append_gdalvsi = FALSE) +\method{assets_url}{doc_item}(items, asset_names = NULL, append_gdalvsi = FALSE) -\method{assets_url}{STACItemCollection}(items, asset_names = NULL, append_gdalvsi = FALSE) +\method{assets_url}{doc_items}(items, asset_names = NULL, append_gdalvsi = FALSE) \method{assets_url}{default}(items, asset_names = NULL, append_gdalvsi = FALSE) assets_select(items, ..., asset_names = NULL, select_fn = NULL) -\method{assets_select}{STACItem}(items, ..., asset_names = NULL, select_fn = NULL) +\method{assets_select}{doc_item}(items, ..., asset_names = NULL, select_fn = NULL) -\method{assets_select}{STACItemCollection}(items, ..., asset_names = NULL, select_fn = NULL) +\method{assets_select}{doc_items}(items, ..., asset_names = NULL, select_fn = NULL) \method{assets_select}{default}(items, ..., asset_names = NULL, select_fn = NULL) assets_rename(items, mapper = NULL, ...) -\method{assets_rename}{STACItem}(items, mapper = NULL, ...) +\method{assets_rename}{doc_item}(items, mapper = NULL, ...) -\method{assets_rename}{STACItemCollection}(items, mapper = NULL, ...) +\method{assets_rename}{doc_items}(items, mapper = NULL, ...) \method{assets_rename}{default}(items, mapper = NULL, ...) has_assets(items) -\method{has_assets}{STACItem}(items) +\method{has_assets}{doc_item}(items) -\method{has_assets}{STACItemCollection}(items) +\method{has_assets}{doc_items}(items) \method{has_assets}{default}(items) @@ -111,7 +111,7 @@ asset_eo_bands(field) asset_raster_bands(field) } \arguments{ -\item{items}{a \code{STACItem} or \code{STACItemCollection} object +\item{items}{a \code{doc_item} or \code{doc_items} object representing the result of \verb{/stac/search}, \code{/collections/{collectionId}/items} or \code{/collections/{collectionId}/items/{itemId}} endpoints.} @@ -135,7 +135,7 @@ hrefs for each asset, as well as the way download is done.} use \code{download_fn} parameter instead.} \item{create_json}{a \code{logical} indicating if a JSON file with item -metadata (\code{STACItem} or \code{STACItemCollection}) must be created in the +metadata (\code{doc_item} or \code{doc_items}) must be created in the output directory.} \item{items_max}{a \code{numeric} corresponding to how many items will be @@ -149,14 +149,14 @@ included in the URL of each asset. The following schemes are supported: HTTP/HTTPS files, S3 (AWS S3) and GS (Google Cloud Storage).} \item{select_fn}{a \code{function} to select assets an item -(\code{STACItem} or \code{STACItemCollection}). This function receives as parameter +(\code{doc_item} or \code{doc_items}). This function receives as parameter the asset element and, optionally, the asset name. Asset elements contain metadata describing spatial-temporal objects. Users can provide a function to select assets based on this metadata by returning a logical value where \code{TRUE} selects the asset, and \code{FALSE} discards it.} \item{mapper}{either a named \code{list} or a \code{function} to rename assets -of an item (\code{STACItem} or \code{STACItemCollection}). In the case of a named +of an item (\code{doc_item} or \code{doc_items}). In the case of a named list, use \verb{ = } to rename the assets. The function can be used to rename the assets by returning a \code{character} string using the metadata contained in the asset object.} @@ -167,22 +167,22 @@ return.} \value{ \itemize{ \item \code{assets_download()}: returns the same input object item -(\code{STACItem} or \code{STACItemCollection}) where \code{href} properties point to +(\code{doc_item} or \code{doc_items}) where \code{href} properties point to the download assets. \item \code{assets_url()}: returns a character vector with all assets \code{href} -of an item (\code{STACItem} or \code{STACItemCollection}). +of an item (\code{doc_item} or \code{doc_items}). \item \code{assets_select()}: returns the same input object item -(\code{STACItem} or \code{STACItemCollection}) with the selected assets. +(\code{doc_item} or \code{doc_items}) with the selected assets. \item \code{assets_rename()}: returns the same input object item -(\code{STACItemCollection} or \code{STACItem}) with the assets renamed. +(\code{doc_items} or \code{doc_item}) with the assets renamed. } } \description{ -These functions provide support to work with \code{STACItemCollection} and -\code{STACItem} item objects. +These functions provide support to work with \code{doc_items} and +\code{doc_item} item objects. \itemize{ \item \code{assets_download()}: Downloads the assets provided by the STAC API. diff --git a/man/collections.Rd b/man/collections.Rd index 22161912..f5a452ed 100644 --- a/man/collections.Rd +++ b/man/collections.Rd @@ -7,13 +7,13 @@ collections(q, collection_id = NULL) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{collection_id}{a \code{character} collection id to be retrieved.} } \value{ -A \code{RSTACQuery} object with the subclass \code{collections} for +A \code{rstac_query} object with the subclass \code{collections} for \verb{/collections/} endpoint, or a \code{collection_id} subclass for \code{/collections/{collection_id}} endpoint, containing all search field parameters to be provided to STAC API web service. diff --git a/man/conformance.Rd b/man/conformance.Rd index cac3d56e..8afce489 100644 --- a/man/conformance.Rd +++ b/man/conformance.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/conformance-query.R \name{conformance} \alias{conformance} -\title{Conformance endpoint} +\title{doc_conformance endpoint} \usage{ conformance(q) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query criteria.} +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} } \value{ -A \code{RSTACQuery} object with the subclass \code{conformance} for \verb{/conformance} +A \code{rstac_query} object with the subclass \code{conformance} for \verb{/conformance} endpoint. } \description{ diff --git a/man/doc_query.Rd b/man/doc_query.Rd deleted file mode 100644 index 693da8ae..00000000 --- a/man/doc_query.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/document-funs.R -\name{doc_query} -\alias{doc_query} -\title{Document utils functions} -\usage{ -doc_query(d) -} -\arguments{ -\item{d}{an \code{RSTACDocument} object} -} -\value{ -a \code{RSTACQuery} object with the predecessor subclass with the -fields used in the request. -} -\description{ -Document utils functions -} -\keyword{internal} diff --git a/man/ext_filter.Rd b/man/ext_filter.Rd index 65a6a1c0..8f0fa024 100644 --- a/man/ext_filter.Rd +++ b/man/ext_filter.Rd @@ -13,7 +13,7 @@ cql2_json(expr) cql2_text(expr) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{expr}{a valid R expression to be translated to CQL2 (see details).} @@ -28,7 +28,7 @@ system used by geometry objects. If \code{NULL} (default), STAC services assume \code{"WGS 84"}.} } \value{ -A \code{RSTACQuery} object with the subclass \code{ext_filter} containing +A \code{rstac_query} object with the subclass \code{ext_filter} containing all request parameters to be passed to \code{get_request()} or \code{post_request()} function. } @@ -236,6 +236,5 @@ cql2_json(collection == "landsat-c2-l2" && } \seealso{ \code{\link[=ext_query]{ext_query()}}, \code{\link[=stac_search]{stac_search()}}, \code{\link[=post_request]{post_request()}}, -\code{\link[=endpoint]{endpoint()}}, \code{\link[=before_request]{before_request()}}, -\code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} +\code{\link[=before_request]{before_request()}}, \code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} } diff --git a/man/ext_query.Rd b/man/ext_query.Rd index c232af2e..0a375542 100644 --- a/man/ext_query.Rd +++ b/man/ext_query.Rd @@ -7,13 +7,13 @@ ext_query(q, ...) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{...}{entries with format \verb{ }.} } \value{ -A \code{RSTACQuery} object with the subclass \code{ext_query} containing +A \code{rstac_query} object with the subclass \code{ext_query} containing all request parameters to be passed to \code{post_request()} function. } \description{ @@ -50,7 +50,6 @@ search operator. Besides this function, the following S3 generic methods were implemented to get things done for this extension: \itemize{ -\item The \code{endpoint()} for subclass \code{ext_query} \item The \code{before_request()} for subclass \code{ext_query} \item The \code{after_response()} for subclass \code{ext_query} } @@ -68,6 +67,5 @@ extensions. } \seealso{ \code{\link[=ext_filter]{ext_filter()}}, \code{\link[=stac_search]{stac_search()}}, \code{\link[=post_request]{post_request()}}, -\code{\link[=endpoint]{endpoint()}}, \code{\link[=before_request]{before_request()}}, -\code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} +\code{\link[=before_request]{before_request()}}, \code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} } diff --git a/man/extensions.Rd b/man/extensions.Rd index d3368a56..314c6d7b 100644 --- a/man/extensions.Rd +++ b/man/extensions.Rd @@ -2,20 +2,17 @@ % Please edit documentation in R/extensions.R, R/query-funs.R \name{extensions} \alias{extensions} -\alias{endpoint} \alias{before_request} \alias{after_response} \alias{parse_params} \alias{content_response} \alias{check_query_verb} -\alias{check_subclass} +\alias{check_query} \alias{subclass} -\alias{omit_query_params} -\alias{RSTACQuery} +\alias{set_query_endpoint} +\alias{rstac_query} \title{Extension development functions} \usage{ -endpoint(q) - before_request(q) after_response(q, res) @@ -26,16 +23,16 @@ content_response(res, status_codes, content_types, key_message) check_query_verb(q, verbs, msg = NULL) -check_subclass(x, subclasses) +check_query(x, classes = NULL) subclass(x) -omit_query_params(q, names) +set_query_endpoint(q, endpoint, params = NULL) -RSTACQuery(version = NULL, base_url, params = list(), subclass) +rstac_query(version = NULL, base_url, params = list(), subclass) } \arguments{ -\item{q}{a \code{RSTACQuery} object.} +\item{q}{a \code{rstac_query} object.} \item{res}{a \code{httr} \code{response} object.} @@ -55,12 +52,13 @@ requested API message.} \item{msg}{a \code{character} with a personalized error message} -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{a \code{rstac_query} object expressing a STAC query +criteria.} -\item{subclasses}{a \code{character} vector with all allowed S3 subclasses} +\item{classes}{a \code{character} vector with all allowed S3 sub-classes} -\item{names}{a \code{character} vector with the names do omit.} +\item{endpoint}{a \code{character} vector with the format string with the +endpoint url.} \item{version}{a \code{character} with the STAC version.} @@ -71,24 +69,23 @@ STAC web service.} object to be created.} } \value{ -A \code{character} endpoint value for \code{endpoint()} function. -A \code{RSTACQuery} object for \code{before_request()} and +A \code{rstac_query} object for \code{before_request()} and \code{after_response()} functions. The \code{content_response()} function returns a \code{list} data structure representing the JSON file received in HTTP response -The \code{RSTACQuery()} function returns a \code{STACQuery} object with +The \code{rstac_query()} function returns a \code{STACQuery} object with subclass defined by \code{subclass} parameter. } \description{ Currently, there are five STAC documents defined in STAC spec: \itemize{ -\item \code{STACCatalog} -\item \code{STACCollection} -\item \code{STACCollectionList} -\item \code{STACItem} -\item \code{STACItemCollection} +\item \code{doc_catalog} +\item \code{doc_collection} +\item \code{doc_collections} +\item \code{doc_item} +\item \code{doc_items} } Each document class is associated with STAC API endpoints. @@ -125,22 +122,18 @@ These functions are intended for those who want to implement new STAC API extensions. An extension must define a subclass name and implement all the following S3 generic methods for that subclass: \itemize{ -\item \code{endpoint()}: returns the endpoint value of the extension. -Endpoints that vary between STAC API versions can be properly returned by -checking the \code{version} field of \code{RSTACQuery} object. \item \code{before_request()}: allows handling query parameters before -submit them to the HTTP server; +submit them to the HTTP server, usually sets up the query endpoint; \item \code{after_request()}: allows to check and parse document received by the HTTP server; } -These methods will work 'behind the scenes' when a \code{RSTACQuery} object +These methods will work 'behind the scenes' when a \code{rstac_query} object representing a user query are passed to a request function (e.g. \code{get_request()} or \code{post_request()}). The calling order is: \enumerate{ \item begin of \code{get_request()} or \code{post_request()} \item if STAC API version is not defined, try detect it -\item call \code{endpoint()} \item call \code{before_request()} \item send HTTP request \item receive HTTP response @@ -149,13 +142,13 @@ representing a user query are passed to a request function } Besides that, the extension must expose a function to receive user -parameters and return a \code{RSTACQuery} object with a subclass +parameters and return a \code{rstac_query} object with a subclass associated with the above S3 methods. This function must accept as its -first parameter a \code{RSTACQuery} object representing the actual query. +first parameter a \code{rstac_query} object representing the actual query. To keep the command flow consistency, the function needs to check the subclass of the input query. After that, it must set new or changes the input query parameters according to the user input and, finally, -return the new query as a \code{RSTACQuery} object. +return the new query as a \code{rstac_query} object. You can see examples on how to implement an STAC API extension by looking at \code{stac.R}, \code{collections.R}, \code{items.R}, \code{stac_search.R}, @@ -175,20 +168,20 @@ It returns the parsed content response. verbs are allowed. It is useful for establishing which verbs will be supported by an extension. -\item \code{check_subclass()}: The \code{check_subclass()} function specifies which type of query -objects (\code{RSTACQuery}) or document objects (\code{RSTACDocument}) -are expected in the function extension. +\item \code{check_query()}: The \code{check_query()} function specifies which type of query +object (\code{rstac_query}) is expected in the function extension. \item \code{subclass()}: The \code{subclass()} function returns a \code{character} representing the -subclass name of either \code{RSTACQuery} or \code{RSTACDocument} S3 classes. +subclass name of \code{rstac_query} objects. -\item \code{omit_query_params()}: The \code{omit_query_params()} function was created to omit the paths that -are defined as query parameters to simplify the creation of a query. -Therefore, use this method only in endpoints that specify a parameter in -their paths. +\item \code{set_query_endpoint()}: The \code{set_query_endpoint()} function defines the endpoint of a query. +If \code{params} parameter is passed, each value must be an entry of params +field of the given query. The corresponding param value will be used as +value replacement of \verb{\%s} occurrences in the \code{endpoint} string. After +the replacement, all params in this list will be removed. -\item \code{RSTACQuery()}: The \code{RSTACQuery()} function is a constructor of \code{RSTACQuery} -objects. Every extension must implement a subclass of \code{RSTACQuery} to +\item \code{rstac_query()}: The \code{rstac_query()} function is a constructor of \code{rstac_query} +objects. Every extension must implement a subclass of \code{rstac_query} to represent its queries. This is done by informing to the \code{subclass} parameter the extension's subclass name. diff --git a/man/items.Rd b/man/items.Rd index c327efef..8daa5f30 100644 --- a/man/items.Rd +++ b/man/items.Rd @@ -7,7 +7,7 @@ items(q, feature_id = NULL, datetime = NULL, bbox = NULL, limit = NULL) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{feature_id}{a \code{character} with item id to be fetched. @@ -53,7 +53,7 @@ in cases where the box spans the antimeridian, the first value to return. If not informed, it defaults to the service implementation.} } \value{ -A \code{RSTACQuery} object with the subclass \code{items} for +A \code{rstac_query} object with the subclass \code{items} for \code{/collections/{collection_id}/items} endpoint, or a \code{item_id} subclass for \code{/collections/{collection_id}/items/{feature_id}} endpoint, diff --git a/man/items_functions.Rd b/man/items_functions.Rd index 91b10d72..754cbb1f 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -1,150 +1,140 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprec-funs.R, R/items-funs.R -\name{items_group} -\alias{items_group} +% Please edit documentation in R/items-funs.R +\name{items_functions} \alias{items_functions} \alias{items_length} -\alias{items_length.STACItem} -\alias{items_length.STACItemCollection} +\alias{items_length.doc_item} +\alias{items_length.doc_items} \alias{items_length.default} \alias{items_matched} -\alias{items_matched.STACItem} -\alias{items_matched.STACItemCollection} +\alias{items_matched.doc_item} +\alias{items_matched.doc_items} \alias{items_matched.default} \alias{items_fetch} -\alias{items_fetch.STACItemCollection} +\alias{items_fetch.doc_items} \alias{items_next} -\alias{items_next.STACItemCollection} +\alias{items_next.doc_items} \alias{items_datetime} -\alias{items_datetime.STACItem} -\alias{items_datetime.STACItemCollection} +\alias{items_datetime.doc_item} +\alias{items_datetime.doc_items} \alias{items_datetime.default} \alias{items_bbox} -\alias{items_bbox.STACItem} -\alias{items_bbox.STACItemCollection} +\alias{items_bbox.doc_item} +\alias{items_bbox.doc_items} \alias{items_bbox.default} \alias{items_assets} -\alias{items_assets.STACItem} -\alias{items_assets.STACItemCollection} +\alias{items_assets.doc_item} +\alias{items_assets.doc_items} \alias{items_assets.default} \alias{items_filter} -\alias{items_filter.STACItemCollection} +\alias{items_filter.doc_items} \alias{items_compact} -\alias{items_compact.STACItemCollection} +\alias{items_compact.doc_items} \alias{items_reap} -\alias{items_reap.STACItem} -\alias{items_reap.STACItemCollection} +\alias{items_reap.doc_item} +\alias{items_reap.doc_items} \alias{items_reap.default} \alias{items_fields} -\alias{items_fields.STACItem} -\alias{items_fields.STACItemCollection} +\alias{items_fields.doc_item} +\alias{items_fields.doc_items} \alias{items_fields.default} \alias{items_sign} -\alias{items_sign.STACItem} -\alias{items_sign.STACItemCollection} +\alias{items_sign.doc_item} +\alias{items_sign.doc_items} \alias{items_sign.default} \alias{items_as_sf} -\alias{items_as_sf.STACItem} -\alias{items_as_sf.STACItemCollection} +\alias{items_as_sf.doc_item} +\alias{items_as_sf.doc_items} \title{Items functions} \usage{ -items_group(items, ..., field = NULL, index = NULL) - items_length(items) -\method{items_length}{STACItem}(items) +\method{items_length}{doc_item}(items) -\method{items_length}{STACItemCollection}(items) +\method{items_length}{doc_items}(items) \method{items_length}{default}(items) items_matched(items, matched_field = NULL) -\method{items_matched}{STACItem}(items, matched_field = NULL) +\method{items_matched}{doc_item}(items, matched_field = NULL) -\method{items_matched}{STACItemCollection}(items, matched_field = NULL) +\method{items_matched}{doc_items}(items, matched_field = NULL) \method{items_matched}{default}(items, matched_field = NULL) items_fetch(items, ...) -\method{items_fetch}{STACItemCollection}(items, ..., progress = TRUE, matched_field = NULL) +\method{items_fetch}{doc_items}(items, ..., progress = TRUE, matched_field = NULL) items_next(items, ...) -\method{items_next}{STACItemCollection}(items, ...) +\method{items_next}{doc_items}(items, ...) items_datetime(items) -\method{items_datetime}{STACItem}(items) +\method{items_datetime}{doc_item}(items) -\method{items_datetime}{STACItemCollection}(items) +\method{items_datetime}{doc_items}(items) \method{items_datetime}{default}(items) items_bbox(items) -\method{items_bbox}{STACItem}(items) +\method{items_bbox}{doc_item}(items) -\method{items_bbox}{STACItemCollection}(items) +\method{items_bbox}{doc_items}(items) \method{items_bbox}{default}(items) -items_assets(items, simplify = deprecated()) +items_assets(items) -\method{items_assets}{STACItem}(items, simplify = deprecated()) +\method{items_assets}{doc_item}(items) -\method{items_assets}{STACItemCollection}(items, simplify = deprecated()) +\method{items_assets}{doc_items}(items) -\method{items_assets}{default}(items, simplify = deprecated()) +\method{items_assets}{default}(items) items_filter(items, ..., filter_fn = NULL) -\method{items_filter}{STACItemCollection}(items, ..., filter_fn = NULL) +\method{items_filter}{doc_items}(items, ..., filter_fn = NULL) items_compact(items) -\method{items_compact}{STACItemCollection}(items) +\method{items_compact}{doc_items}(items) -items_reap(items, field, ..., pick_fn = identity) +items_reap(items, field, pick_fn = identity) -\method{items_reap}{STACItem}(items, field, ..., pick_fn = identity) +\method{items_reap}{doc_item}(items, field, pick_fn = identity) -\method{items_reap}{STACItemCollection}(items, field, ..., pick_fn = identity) +\method{items_reap}{doc_items}(items, field, pick_fn = identity) -\method{items_reap}{default}(items, field, ..., pick_fn = identity) +\method{items_reap}{default}(items, field, pick_fn = identity) items_fields(items, field = NULL, ...) -\method{items_fields}{STACItem}(items, field = NULL, ...) +\method{items_fields}{doc_item}(items, field = NULL) -\method{items_fields}{STACItemCollection}(items, field = NULL, ...) +\method{items_fields}{doc_items}(items, field = NULL) -\method{items_fields}{default}(items, field = NULL, ...) +\method{items_fields}{default}(items, field = NULL) items_sign(items, sign_fn) -\method{items_sign}{STACItem}(items, sign_fn) +\method{items_sign}{doc_item}(items, sign_fn) -\method{items_sign}{STACItemCollection}(items, sign_fn) +\method{items_sign}{doc_items}(items, sign_fn) \method{items_sign}{default}(items, sign_fn) items_as_sf(items) -\method{items_as_sf}{STACItem}(items) +\method{items_as_sf}{doc_item}(items) -\method{items_as_sf}{STACItemCollection}(items) +\method{items_as_sf}{doc_items}(items) } \arguments{ -\item{items}{a \code{STACItemCollection} object.} - -\item{...}{additional arguments. See details.} - -\item{field}{a \code{character} with the names of the field to -get the subfields values.} - -\item{index}{an \code{atomic} vector with values as the group index.} +\item{items}{a \code{doc_items} object.} \item{matched_field}{a \code{character} vector with the path where the number of items returned in the named list is located starting @@ -152,19 +142,24 @@ from the initial node of the list. For example, if the information is in a position \code{items$meta$found} of the object, it must be passed as the following parameter \code{c("meta", "found")}.} +\item{...}{additional arguments. See details.} + \item{progress}{a \code{logical} indicating if a progress bar must be shown or not. Defaults to \code{TRUE}.} -\item{simplify}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} no side-effect} - \item{filter_fn}{a \code{function} that receives an item that should evaluate a \code{logical} value.} +\item{field}{a \code{character} with the names of the field to +get the subfields values.} + \item{pick_fn}{a \code{function} used to pick elements from items addressed by \code{field} parameter.} \item{sign_fn}{a \code{function} that receives an item as a parameter and returns an item signed.} + +\item{index}{an \code{atomic} vector with values as the group index.} } \value{ \itemize{ @@ -173,7 +168,7 @@ and returns an item signed.} \item \code{items_matched()}: returns an \code{integer} value if the STAC web server does support this extension. Otherwise returns \code{NULL}. -\item \code{items_fetch()}: a \code{STACItemCollection} with all matched items. +\item \code{items_fetch()}: a \code{doc_items} with all matched items. \item \code{items_next()}: fetches a new page from STAC service. @@ -184,16 +179,16 @@ does support this extension. Otherwise returns \code{NULL}. \item \code{item_assets()}: Returns a \code{character} value with all assets names of the all items. -\item \code{items_filter()}: a \code{STACItemCollection} object. +\item \code{items_filter()}: a \code{doc_items} object. \item \code{items_reap()}: a \code{vector} if the supplied field is atomic, otherwise or a \code{list}. \item \code{items_fields()}: a \code{character} vector. -\item \code{items_group()}: a \code{list} of \code{STACItemCollection} objects. +\item \code{items_group()}: a \code{list} of \code{doc_items} objects. -\item \code{items_sign()}: a \code{STACItemCollection} object with signed assets url. +\item \code{items_sign()}: a \code{doc_items} object with signed assets url. \item \code{items_as_sf()}: a \code{sf} object. @@ -201,11 +196,11 @@ otherwise or a \code{list}. } \description{ These functions provide support to work with -\code{STACItemCollection} and \code{STACItem} objects. +\code{doc_items} and \code{doc_item} objects. \itemize{ \item \code{items_length()}: shows how many items there are in -the \code{STACItemCollection} object. +the \code{doc_items} object. \item \code{items_matched()}: shows how many items matched the search criteria. It supports \code{search:metadata} (v0.8.0), @@ -217,29 +212,27 @@ pagination. \item \code{items_next()}: fetches a new page from STAC service. \item \code{items_datetime()}: retrieves the \code{datetime} -field in \code{properties} from \code{STACItemCollection} and -\code{STACItem} objects. +field in \code{properties} from \code{doc_items} and +\code{doc_item} objects. \item \code{items_bbox()}: retrieves the \code{bbox} -field of a \code{STACItemCollection} or a \code{STACItem} object. +field of a \code{doc_items} or a \code{doc_item} object. \item \code{item_assets()}: returns the assets name from -\code{STACItemCollection} and \code{STACItem} objects. +\code{doc_items} and \code{doc_item} objects. \item \code{items_filter()}: selects only items that match some criteria (see details section). \item \code{items_reap()}: extract key values by traversing all items -in a \code{STACItemCollection} object. +in a \code{doc_items} object. \item \code{items_fields()}: lists field names inside an item. -\item \code{items_group()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} organizes -items as elements of a list using some criteria. - \item \code{items_sign()}: allow access assets by preparing its url. -\item \code{items_as_sf()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items to \code{sf} object. +\item \code{items_as_sf()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items +to \code{sf} object. } } \details{ @@ -253,11 +246,8 @@ additional \code{httr} options to \link[httr:GET]{GET} or \link[httr:POST]{POST} methods, such as \link[httr:add_headers]{add_headers} or \link[httr:set_cookies]{set_cookies}. -\item \code{items_fields()}: ellipsis parameter is deprecated in version -0.9.2 of rstac. Please, use \code{field} parameter instead. - \item \code{items_filter()}: ellipsis is used to pass logical -expressions to be evaluated against a \code{STACItem} field as filter criteria. +expressions to be evaluated against a \code{doc_item} field as filter criteria. \strong{WARNING:} the evaluation of filter expressions changed in \code{rstac} 0.9.2. Older versions of \code{rstac} used \code{properties} field to evaluate filter @@ -284,7 +274,7 @@ Data Cube products and Microsoft Planetary Computer catalogs, respectively. \dontrun{ x <- stac("https://brazildatacube.dpi.inpe.br/stac") \%>\% stac_search(collections = "CB4-16D-2") \%>\% - stac_search(limit = 500) \%>\% + stac_search(datetime = "2020-01-01/2021-01-01", limit = 500) \%>\% get_request() x \%>\% items_length() @@ -298,7 +288,7 @@ Data Cube products and Microsoft Planetary Computer catalogs, respectively. # Defining BDC token Sys.setenv("BDC_ACCESS_KEY" = "token-123") -# STACItem object +# doc_item object stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", @@ -308,7 +298,7 @@ stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% } \dontrun{ -# STACItemCollection object +# doc_items object stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", @@ -327,7 +317,7 @@ stac("https://earth-search.aws.element84.com/v0") \%>\% } \dontrun{ -# STACItemCollection object +# doc_items object stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", diff --git a/man/print.Rd b/man/print.Rd index 00d74e46..1059e6ef 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -2,65 +2,71 @@ % Please edit documentation in R/print.R \name{print} \alias{print} -\alias{print.RSTACQuery} -\alias{print.STACCatalog} -\alias{print.STACCollectionList} -\alias{print.STACCollection} -\alias{print.STACItemCollection} -\alias{print.STACItem} -\alias{print.Queryables} -\alias{print.Conformance} +\alias{print.rstac_query} +\alias{print.doc_catalog} +\alias{print.doc_collections} +\alias{print.doc_collection} +\alias{print.doc_items} +\alias{print.doc_item} +\alias{print.doc_queryables} +\alias{print.doc_conformance} +\alias{print.doc_link} +\alias{print.doc_links} \title{Printing functions} \usage{ -\method{print}{RSTACQuery}(x, ...) +\method{print}{rstac_query}(x, ...) -\method{print}{STACCatalog}(x, ...) +\method{print}{doc_catalog}(x, ...) -\method{print}{STACCollectionList}(x, n = 10, ...) +\method{print}{doc_collections}(x, n = 10, ...) -\method{print}{STACCollection}(x, ...) +\method{print}{doc_collection}(x, ...) -\method{print}{STACItemCollection}(x, n = 10, ..., tail = FALSE) +\method{print}{doc_items}(x, n = 10, ..., tail = FALSE) -\method{print}{STACItem}(x, ...) +\method{print}{doc_item}(x, ...) -\method{print}{Queryables}(x, n = 10, ...) +\method{print}{doc_queryables}(x, n = 10, ...) -\method{print}{Conformance}(x, n = 5, ...) +\method{print}{doc_conformance}(x, n = 10, ...) + +\method{print}{doc_link}(x, ...) + +\method{print}{doc_links}(x, n = 10, ...) } \arguments{ -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{either a \code{rstac_query} object expressing a STAC query +criteria or any \code{rstac_doc}.} \item{...}{other parameters passed in the functions.} \item{n}{number of entries to print. Each object has its own rule of -truncation: the \code{STACCollection} objects will print +truncation: the \code{doc_collection} objects will print 10 links by default. If the object has less than 20 collections, all -collections will be shown. In \code{STACItemCollection}, 10 features +collections will be shown. In \code{doc_items}, 10 features will be printed by default. To show all entries, use \code{n = Inf}.} \item{tail}{A \code{logical} value indicating if last features in -STACItemCollection object must be show.} +doc_items object must be show.} } \description{ The print function covers all objects in the rstac package: \itemize{ -\item \code{\link[=stac]{stac()}}: returns a \code{STACCatalog} document from +\item \code{\link[=stac]{stac()}}: returns a \code{doc_catalog} document from \verb{/stac} (v0.8.0) or \code{/} (v0.9.0 or v1.0.0) endpoint. -\item \code{\link[=stac_search]{stac_search()}}: returns a \code{STACItemCollection} +\item \code{\link[=stac_search]{stac_search()}}: returns a \code{doc_items} document from \verb{/stac/search} (v0.8.0) or \verb{/search} (v0.9.0 or v1.0.0) endpoint containing all Items that match the provided search predicates. \item \code{\link[=collections]{collections()}}: implements the \verb{/collections} and \code{/collections/\{collectionId\}} endpoints. The former returns -a \code{STACCollectionList} document that lists all collections published -by the server, and the later returns a single \code{STACCollection} +a \code{doc_collections} document that lists all collections published +by the server, and the later returns a single \code{doc_collection} document that describes a unique collection. -\item \code{\link[=items]{items()}}: retrieves a \code{STACItemCollection} document +\item \code{\link[=items]{items()}}: retrieves a \code{doc_items} document from \code{/collections/\{collectionId\}/items} endpoint and a -\code{STACItem} document from +\code{doc_item} document from \code{/collections/\{collectionId\}/items/\{itemId\}} endpoints. } @@ -73,7 +79,7 @@ You can determine how many items will be printed using \code{n} parameter. } \examples{ \dontrun{ - # STACItemCollection object + # doc_items object stac_item_collection <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", @@ -83,7 +89,7 @@ You can determine how many items will be printed using \code{n} parameter. print(stac_item_collection, n = 10) - # STACCollectionList object + # doc_collections object stac_collection <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% collections() \%>\% @@ -91,7 +97,7 @@ You can determine how many items will be printed using \code{n} parameter. print(stac_collection, n = 5) - # RSTACQuery object + # rstac_query object obj_rstac <- stac("https://brazildatacube.dpi.inpe.br/stac/") print(obj_rstac) diff --git a/man/queryables.Rd b/man/queryables.Rd index 931ef1ea..82ebe633 100644 --- a/man/queryables.Rd +++ b/man/queryables.Rd @@ -7,10 +7,10 @@ queryables(q) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query criteria.} +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} } \value{ -A \code{RSTACQuery} object with the subclass \code{queryables} for \verb{/queryables} +A \code{rstac_query} object with the subclass \code{queryables} for \verb{/queryables} endpoint. } \description{ diff --git a/man/request.Rd b/man/request.Rd index 64e2ae9f..0048ef80 100644 --- a/man/request.Rd +++ b/man/request.Rd @@ -1,16 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/request.R +% Please edit documentation in R/request.R, R/static-funs.R \name{get_request} \alias{get_request} \alias{post_request} +\alias{stac_read} \title{STAC API request functions} \usage{ get_request(q, ...) post_request(q, ..., encode = c("json", "multipart", "form")) + +stac_read(url, ...) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{...}{config parameters to be passed to \link[httr:GET]{GET} or @@ -24,8 +27,8 @@ and \code{'multipart'} (\code{'multipart/form-data'}). Defaults to \code{'json'}.} } \value{ -Either a \code{STACCatalog}, \code{STACCollection}, -\code{STACCollectionList}, \code{STACItemCollection} or \code{STACItem} +Either a \code{doc_catalog}, \code{doc_collection}, +\code{doc_collections}, \code{doc_items} or \code{doc_item} object depending on the subclass and search fields parameters of \code{q} argument. } diff --git a/man/rstac.Rd b/man/rstac.Rd index b80b6d29..a9a7f84c 100644 --- a/man/rstac.Rd +++ b/man/rstac.Rd @@ -61,9 +61,9 @@ them accessible. \section{Data types}{ -The package implements the following S3 classes: \code{STACItemCollection}, -\code{STACItem}, \code{STACCatalog}, \code{STACCollectionList} and -\code{STACCollection}. These classes are regular lists representing the +The package implements the following S3 classes: \code{doc_items}, +\code{doc_item}, \code{doc_catalog}, \code{doc_collections} and +\code{doc_collection}. These classes are regular lists representing the corresponding JSON STAC objects. } diff --git a/man/sign_bdc.Rd b/man/sign_bdc.Rd index ab775f75..5ec133a3 100644 --- a/man/sign_bdc.Rd +++ b/man/sign_bdc.Rd @@ -23,7 +23,7 @@ environment variable in \code{BDC_ACCESS_KEY}or use \code{acess_token} parameter } \examples{ \dontrun{ - # STACItemCollection object + # doc_items object stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", datetime = "2019-06-01/2019-08-01") \%>\% diff --git a/man/sign_planetary_computer.Rd b/man/sign_planetary_computer.Rd index d72638be..700a9d34 100644 --- a/man/sign_planetary_computer.Rd +++ b/man/sign_planetary_computer.Rd @@ -28,7 +28,7 @@ token that will be used in the href. } \examples{ \dontrun{ - # STACItemCollection object + # doc_items object stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") \%>\% stac_search(collections = "sentinel-2-l2a", bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) \%>\% diff --git a/man/stac.Rd b/man/stac.Rd index e30fa413..5c75a736 100644 --- a/man/stac.Rd +++ b/man/stac.Rd @@ -16,7 +16,7 @@ the version of STAC used. It is highly recommended that you inform the STAC version you are using.} } \value{ -A \code{RSTACQuery} object with the subclass \code{stac} containing all +A \code{rstac_query} object with the subclass \code{stac} containing all request parameters to be provided to API service. } \description{ diff --git a/man/stac_search.Rd b/man/stac_search.Rd index 54bf3381..639c5601 100644 --- a/man/stac_search.Rd +++ b/man/stac_search.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stac_search.R +% Please edit documentation in R/search-query.R \name{stac_search} \alias{stac_search} \title{Endpoint functions} @@ -15,7 +15,7 @@ stac_search( ) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{collections}{a \code{character} vector of collection IDs to include in @@ -68,7 +68,7 @@ the provided geometry. To turn a GeoJSON into a list the packages to return. If not informed, it defaults to the service implementation.} } \value{ -A \code{RSTACQuery} object with the subclass \code{search} containing all +A \code{rstac_query} object with the subclass \code{search} containing all search field parameters to be provided to STAC API web service. } \description{ @@ -81,7 +81,7 @@ The \code{stac_search} function implements \verb{/stac/search} API endpoint It prepares query parameters used in the search API request, a \code{stac} object with all filter parameters to be provided to \code{get_request} or \code{post_request} functions. The GeoJSON content -returned by these requests is a \code{STACItemCollection} object, a regular R +returned by these requests is a \code{doc_items} object, a regular R \code{list} representing a STAC Item Collection document. } \examples{ diff --git a/man/stac_version.Rd b/man/stac_version.Rd index e1950722..113d226b 100644 --- a/man/stac_version.Rd +++ b/man/stac_version.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stac_version.R +% Please edit documentation in R/stac-funs.R \name{stac_version} \alias{stac_version} \title{Utility functions} @@ -7,8 +7,8 @@ stac_version(x, ...) } \arguments{ -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{either a \code{rstac_query} object expressing a STAC query +criteria or any \code{rstac_doc}.} \item{...}{config parameters to be passed to \link[httr:GET]{GET} method, such as \link[httr:add_headers]{add_headers} or \link[httr:set_cookies]{set_cookies}.} @@ -19,6 +19,6 @@ version. } \description{ These function retrieves information about either \code{rstac} queries -(\code{RSTACQuery} objects) or \code{rstac} documents -(\code{RSTACDocument} objects). +(\code{rstac_query} objects) or \code{rstac} documents +(\code{rstac_doc} objects). } diff --git a/tests/testthat/test-assets_functions.R b/tests/testthat/test-assets_functions.R index 15792064..248dda64 100644 --- a/tests/testthat/test-assets_functions.R +++ b/tests/testthat/test-assets_functions.R @@ -19,8 +19,8 @@ testthat::test_that("assets functions", { testthat::expect_error( stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - get_request(.) %>% - assets_download(., asset_names = c("blue", "evi")) + get_request() %>% + assets_download(asset_names = c("blue", "evi")) ) # error - wrong path @@ -49,7 +49,7 @@ testthat::test_that("assets functions", { create_json = FALSE) subclass(x) }, - expected = "STACItemCollection" + expected = "doc_items" ) # deprec param @@ -86,7 +86,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItemCollection" + expected = "doc_items" ) testthat::expect_equal( @@ -101,7 +101,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItem" + expected = "doc_item" ) # deprec fn param @@ -134,7 +134,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItem" + expected = "doc_item" ) stac_items <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% @@ -151,13 +151,13 @@ testthat::test_that("assets functions", { # return the same object after select? testthat::expect_s3_class( object = assets_select(stac_items, asset_names = "BAND13"), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # return the same object after select? testthat::expect_s3_class( object = assets_select(stac_item, asset_names = "BAND13"), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) # were the asset selected? @@ -170,7 +170,7 @@ testthat::test_that("assets functions", { testthat::expect_equal( object = items_assets(assets_select(stac_items, asset_names = c("BAND14", "EVI"), - `eo:bands` == 5)), + `eo:bands` == 8)), expected = "EVI" ) @@ -193,14 +193,14 @@ testthat::test_that("assets functions", { expect_length( object = items_assets( - assets_select(stac_item, 10 %in% asset_get("eo:band")) + suppressWarnings(assets_select(stac_item, 10 %in% asset_get("eo:band"))) ), n = 0 ) expect_length( object = items_assets( - assets_select(stac_item, "B1" %in% asset_get("eo:band")) + suppressWarnings(assets_select(stac_item, "B1" %in% asset_get("eo:band"))) ), n = 0 ) @@ -221,36 +221,36 @@ testthat::test_that("assets functions", { testthat::expect_s3_class( object = assets_rename(selected_items, c("BAND13" = "B13")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, c("BAND13" = "B13")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_items, list("BAND13" = "B13")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, list("BAND13" = "B13")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_items, list(BAND13 = "B13"), BAND14 = "B14"), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, list(BAND13 = "B13"), BAND14 = "B14"), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_equal( @@ -332,7 +332,7 @@ testthat::test_that("assets functions", { return(x$`eo:bands` < 6) return(FALSE) }), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) # return the same object after filter? @@ -344,56 +344,58 @@ testthat::test_that("assets functions", { }) ) - # assets_filter----------------------------------------------------------- - # deprec function assets_filter + # assets_select----------------------------------------------------------- + # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_items, `eo:bands` < 6)))}, - expected = c("STACItemCollection", "RSTACDocument", "list") + object = {suppressWarnings(class(assets_select(stac_items, `eo:bands` < 6)))}, + expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_filter + # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_items, filter_fn = function(x) { + object = {suppressWarnings(class(assets_select(stac_items, select_fn = function(x) { if ("eo:bands" %in% names(x)) return(x$`eo:bands` < 6) return(FALSE) })))}, - expected = c("STACItemCollection", "RSTACDocument", "list") + expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_filter + # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_item, `eo:bands` < 6)))}, - expected = c("STACItem", "RSTACDocument", "list") + object = class(assets_select(stac_item, `eo:bands` < 6)), + expected = c("doc_item", "rstac_doc", "list") ) - # deprec function assets_filter + # deprec function assets_select testthat::expect_error( - object = suppressWarnings(assets_filter(stac_item, a = `eo:bands` < 6)), + object = assets_select(stac_item, a = `eo:bands` < 6), ) - # deprec function assets_filter - testthat::expect_error( - object = suppressWarnings(assets_filter(stac_item, `eo:dbandsd` < 6)), + # deprec function assets_select + testthat::expect_warning( + object = assets_select(stac_item, `eo:dbandsd` < 6), ) - # deprec function assets_filter + # deprec function assets_select testthat::expect_error( - object = suppressWarnings(assets_filter(stac_items, a = `eo:bands` < 6)), + object = assets_select(stac_items, a = `eo:bands` < 6), ) - # deprec function assets_filter - testthat::expect_error( - object = suppressWarnings(assets_filter(stac_items, `eo:dbandsd` < 6)), + # deprec function assets_select + testthat::expect_warning( + object = assets_select(stac_items, `eo:dbandsd` < 6), ) - # deprec function assets_filter + # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_item, filter_fn = function(x) { - if ("eo:bands" %in% names(x)) - return(x$`eo:bands` < 6) - return(FALSE) - })))}, - expected = c("STACItem", "RSTACDocument", "list") + object = { + class(assets_select(stac_item, select_fn = function(x) { + if ("eo:bands" %in% names(x)) + return(x$`eo:bands` < 6) + return(FALSE) + })) + }, + expected = c("doc_item", "rstac_doc", "list") ) }) diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index 6f3f1de9..1157f3f3 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -9,14 +9,14 @@ testthat::test_that("examples rstac", { object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::collections() %>% rstac::get_request(), - class = c("STACCollectionList", "RSTACDocument")) + class = c("doc_collections", "rstac_doc")) # test collections items - /collections/{collection_id} testthat::expect_s3_class( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request(), - class = c("STACCollection", "STACCatalog", "RSTACDocument")) + class = c("doc_collection", "doc_catalog", "rstac_doc")) # test items collection - /collections/{collection_id}/items testthat::expect_s3_class( @@ -24,7 +24,7 @@ testthat::test_that("examples rstac", { collections("CB4-16D-2") %>% items(bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% get_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test items collection - /search/ testthat::expect_s3_class( @@ -32,7 +32,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% get_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test items collection - /search/ testthat::expect_s3_class( @@ -40,7 +40,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% post_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test stac item - /collections/{collection_id}/items/{feature_id} testthat::expect_s3_class( @@ -48,13 +48,13 @@ testthat::test_that("examples rstac", { collections("CB4-16D-2") %>% items("CB4-16D_V2_000002_20230509") %>% get_request(), - class = c("STACItem", "RSTACDocument")) + class = c("doc_item", "rstac_doc")) # test stac catalog - / testthat::expect_s3_class( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request(), - class = c("STACCatalog", "RSTACDocument")) + class = c("doc_catalog", "rstac_doc")) #### tests in extensions #### @@ -64,7 +64,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2") %>% ext_query("bdc:tile" == "021027") %>% post_request(), - class = c("STACItem", "RSTACDocument")) + class = c("doc_item", "rstac_doc")) #### tests in items #### @@ -75,7 +75,7 @@ testthat::test_that("examples rstac", { limit = 500) %>% get_request() %>% items_fetch(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test item_length testthat::expect_equal( diff --git a/tests/testthat/test-ext_filter.R b/tests/testthat/test-ext_filter.R index ad8f6d55..f35d96b8 100644 --- a/tests/testthat/test-ext_filter.R +++ b/tests/testthat/test-ext_filter.R @@ -5,7 +5,7 @@ conformance_test <- function(q, expected_number) { ) } -test_that("Conformance Test 7", { +test_that("doc_conformance Test 7", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -38,10 +38,10 @@ test_that("Conformance Test 7", { datetime < "2019-02-02") res <- post_request(res) - expect_s3_class(res, "STACItemCollection") + expect_s3_class(res, "doc_items") res2 <- items_next(res) - expect_s3_class(res2, "STACItemCollection") - expect_gt(object = items_length(res2), expected = items_length(res)) + expect_s3_class(res2, "doc_items") + expect_equal(object = items_length(res2), expected = items_length(res)) conformance_test( q = ext_filter( @@ -252,7 +252,7 @@ test_that("Conformance Test 7", { ) }) -test_that("Conformance Test 12", { +test_that("doc_conformance Test 12", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -370,7 +370,7 @@ test_that("Conformance Test 12", { ) }) -test_that("Conformance Test 16", { +test_that("doc_conformance Test 16", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -457,7 +457,7 @@ test_that("Conformance Test 16", { ) }) -test_that("Conformance Test 25", { +test_that("doc_conformance Test 25", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -532,7 +532,7 @@ test_that("Conformance Test 25", { ) }) -test_that("Conformance Test 34", { +test_that("doc_conformance Test 34", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( @@ -685,7 +685,7 @@ test_that("Conformance Test 34", { ) }) -test_that("Conformance Test 38", { +test_that("doc_conformance Test 38", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -874,7 +874,7 @@ test_that("Conformance Test 38", { ) }) -test_that("Conformance Test 45", { +test_that("doc_conformance Test 45", { q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R index 70da6dc8..87da4bea 100644 --- a/tests/testthat/test-internals.R +++ b/tests/testthat/test-internals.R @@ -4,13 +4,9 @@ testthat::test_that("internals functions", { stac_obj <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") - # check_subclass object + # check_query object testthat::expect_null( - object = check_subclass(stac_obj, subclasses = c("stac")) - ) - - testthat::expect_error( - object = .check_obj(stac_obj, "numeric") + object = check_query(stac_obj, classes = c("stac")) ) # check for query for wrong verb @@ -26,7 +22,7 @@ testthat::test_that("internals functions", { testthat::expect_error( object = { mock_obj <- stac_obj - class(mock_obj) <- "RSTACQuery" + class(mock_obj) <- "rstac_query" after_response(mock_obj, res = NULL) } ) @@ -34,7 +30,7 @@ testthat::test_that("internals functions", { testthat::expect_error( object = { mock_obj <- stac_obj - class(mock_obj) <- "RSTACQuery" + class(mock_obj) <- "rstac_query" endpoint(mock_obj) } ) @@ -54,10 +50,6 @@ testthat::test_that("internals functions", { testthat::expect_warning( .warning("warning function") ) - - testthat::expect_error( - .make_url("aaa", params = list(1)) - ) }) testthat::test_that("internals response", { diff --git a/tests/testthat/test-items_functions.R b/tests/testthat/test-items_functions.R index 37f97e39..9fa70fb9 100644 --- a/tests/testthat/test-items_functions.R +++ b/tests/testthat/test-items_functions.R @@ -76,7 +76,7 @@ testthat::test_that("items functions", { limit = 500) %>% get_request(.) %>% items_fetch()), - expected = "STACItemCollection" + expected = "doc_items" ) testthat::expect_error( @@ -95,7 +95,7 @@ testthat::test_that("items functions", { ext_query("io:tile_id" %in% "60W") %>% post_request() %>% items_fetch())), - expected = "STACItemCollection" + expected = "doc_items" ) # items_length-------------------------------------------------------------- @@ -103,10 +103,10 @@ testthat::test_that("items functions", { testthat::expect_true(is.numeric(items_length(res))) # items_datetime------------------------------------------------------------ - # STACItemCollection + # doc_items testthat::expect_length(items_datetime(res), n = 10) - # STACItem + # doc_item testthat::expect_vector(items_datetime(item_stac), ptype = character()) # provide wrong object @@ -119,10 +119,10 @@ testthat::test_that("items functions", { ) # items_bbox---------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_length(items_bbox(res), n = 10) - # STACItem + # doc_item testthat::expect_vector(items_bbox(item_stac), ptype = double()) testthat::expect_error( @@ -134,10 +134,10 @@ testthat::test_that("items functions", { ) # items_assets--------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_length(items_assets(res), n = 11) - # STACItem + # doc_item testthat::expect_vector(items_assets(item_stac), ptype = character()) # provide wrong object @@ -163,36 +163,36 @@ testthat::test_that("items functions", { object = items_filter( res, filter_fn = function(x) {x[["eo:cloud_cover"]] < 10} ), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_filter( res, filter_fn = function(x) {x$properties$`eo:cloud_cover` < 10} ), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_warning( - object = items_filter(res, `eo:cloud_cover` < 10), - class = "STACItemCollection" + object = items_filter(res, properies$`eo:cloud_cover` < 10), + class = "doc_items" ) testthat::expect_s3_class( object = items_filter(res, properties$`eo:cloud_cover` < 10), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_filter(res), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_error( object = items_filter(item_stac, `eo:cloud_cover` < 10) ) - testthat::expect_error( + testthat::expect_warning( object = items_filter(res, list(`eo:cloud_cover` < 10)) ) @@ -202,11 +202,6 @@ testthat::test_that("items functions", { expected = "character" ) - testthat::expect_message( - items_assets(res, simplify = FALSE), - regexp = "deprecated" - ) - testthat::expect_equal( object = class(items_assets(item_stac)), expected = "character" @@ -215,40 +210,39 @@ testthat::test_that("items functions", { # items_next---------------------------------------------------------------- testthat::expect_s3_class( object = items_next(res_geo), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res_bbox), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res_ext), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_equal( object = items_length(items_next(res)), - expected = 20 + expected = 10 ) testthat::expect_error( object = { mock_obj <- res_geo attributes(mock_obj)$query <- list(NULL) - items_next(mock_obj) } ) # items_reap---------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_equal( object = class(items_reap(item_stac, field = c("properties", "datetime"))), expected = "character" @@ -260,14 +254,12 @@ testthat::test_that("items functions", { ) testthat::expect_null(items_reap(item_stac, FALSE)) - testthat::expect_message(items_reap(item_stac, FALSE, field = FALSE), - regexp = "^The parameter \\.\\.\\.") testthat::expect_error( object = subclass(items_reap(item_stac)) ) - # STACItemCollection + # doc_items testthat::expect_equal( object = class(items_reap(res, field = c("properties", "datetime"))), expected = "character" @@ -280,14 +272,14 @@ testthat::test_that("items functions", { # items_reap with pick_fn testthat::expect_equal( - object = class(items_reap(item_stac, field = c("properties"), - pick_fn = function(x) x[["datetime"]])), + object = class(items_reap(item_stac, field = "properties", + pick_fn = function(x) x$datetime)), expected = "character" ) testthat::expect_length( - object = items_reap(item_stac, field = c("properties"), - pick_fn = function(x) x[["datetime"]]), + object = items_reap(item_stac, field = "properties", + pick_fn = function(x) x$datetime), n = 1 ) diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index cc091370..fbb60c2e 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -5,35 +5,6 @@ testthat::test_that("stac search object", { stac("https://landsatlook.usgs.gov/sat-api/stac", force_version = "0.7.0") ) - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "0.7.0") - ) - ), - expected = "/stac" - ) - - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "0.8.1") %>% - stac_search() - - ) - ), - expected = "/stac/search" - ) - - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "1.0.0") - ) - ), - expected = "/" - ) - # no stac version detected testthat::expect_error( stac("https://landsatlook.usgs.gov/sat-api/stac") %>% @@ -55,7 +26,7 @@ testthat::test_that("stac search object", { object = class( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(bbox = "-48.19039,-16.00871,-41.6341,-11.91345")), - expected = c("search", "RSTACQuery") + expected = c("search", "rstac_query") ) # check object class of stac_search @@ -64,7 +35,7 @@ testthat::test_that("stac search object", { rstac::stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12)), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search @@ -74,16 +45,7 @@ testthat::test_that("stac search object", { rstac::stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12))), - class = c("search", "RSTACQuery") - ) - - # check object class of stac_search - testthat::expect_error( - object = endpoint( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, - -41.6341, -11.91345, - -18.00871, -42.12))) + class = c("search", "rstac_query") ) # check object class of stac_search @@ -100,14 +62,14 @@ testthat::test_that("stac search object", { object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(limit = 10), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) testthat::expect_error( @@ -134,7 +96,7 @@ testthat::test_that("stac search object", { testthat::expect_s3_class( object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(ids = c(1, 2)), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search @@ -144,14 +106,14 @@ testthat::test_that("stac search object", { "{\"type\":\"Polygon\",\"coordinates\":[[[-48.19039,-16.00871],", "[-41.6341,-16.00871],[-41.6341,-11.91345],[-48.19039,-11.91345],", "[-48.19039,-16.00871]]]}")), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(collections = "ssss", ids = "aaa,bbb,ccc"), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check GET request from stac_search object @@ -161,7 +123,7 @@ testthat::test_that("stac search object", { rstac::stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) %>% get_request()), - expected = "STACItemCollection" + expected = "doc_items" ) # check for invalid stac endpoint @@ -291,7 +253,7 @@ testthat::test_that("stac search object", { testthat::expect_s3_class( object = ext_query(s_search, "bdc:tile" %in% "007004") %>% post_request(), - class = "STACItemCollection" + class = "doc_items" ) # Check print function------------------------------------------------------ @@ -302,7 +264,7 @@ testthat::test_that("stac search object", { rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), - regexp = "###STACItemCollection" + regexp = "###Items" ) testthat::expect_output( @@ -310,7 +272,7 @@ testthat::test_that("stac search object", { rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), - regexp = "###STACItemCollection" + regexp = "###Items" ) # Check errors in fixed date time------------------------------------------- @@ -405,8 +367,8 @@ testthat::test_that("stac collection object", { get_request() testthat::expect_equal( - object = subclass(s_col), - expected = "STACCollectionList" + object = stac_subclass(s_col), + expected = "doc_collections" ) testthat::expect_equal( @@ -426,7 +388,7 @@ testthat::test_that("stac collection object", { testthat::expect_output( object = print(rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% rstac::collections()), - regexp = "###RSTACQuery" + regexp = "###rstac_query" ) testthat::expect_output( @@ -434,11 +396,6 @@ testthat::test_that("stac collection object", { regexp = "collections" ) - testthat::expect_equal( - object = attributes(s_col)$query$endpoint, - expected = "/collections" - ) - # check object class of stac collections s_colid <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% @@ -457,13 +414,13 @@ testthat::test_that("stac collection object", { # check request from stac collections object testthat::expect_equal( object = subclass(s_colid %>% get_request()), - expected = "STACCollection" + expected = "doc_collection" ) # check print stac_collection object testthat::expect_output( object = print((s_colid %>% get_request())), - regexp = "###STACCollection" + regexp = "###Collection" ) }) @@ -491,7 +448,7 @@ testthat::test_that("stac object", { object = subclass( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request()), - expected = "STACCatalog" + expected = "doc_catalog" ) # check print stac_collection object @@ -499,7 +456,7 @@ testthat::test_that("stac object", { object = print( rstac::stac("https://brazildatacube.dpi.inpe.br/stac") %>% get_request()), - regexp = "###STACCatalog" + regexp = "###Catalog" ) }) @@ -582,7 +539,7 @@ testthat::test_that("stac item object", { # output test testthat::expect_output( object = print(stac_item), - regexp = "###STACItem" + regexp = "###Item" ) # output test @@ -615,13 +572,13 @@ testthat::test_that("queryables object", { object = subclass( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), - expected = c("queryables", "stac") + expected = c("queryables") ) testthat::expect_equal( object = subclass( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), - expected = c("queryables", "stac") + expected = c("queryables") ) testthat::expect_equal( @@ -629,7 +586,7 @@ testthat::test_that("queryables object", { rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("sentinel") %>% queryables()), - expected = c("queryables", "collection_id") + expected = c("queryables") ) testthat::expect_equal( @@ -637,7 +594,7 @@ testthat::test_that("queryables object", { stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% queryables() %>% get_request()), - expected = c("Queryables", "RSTACDocument", "list") + expected = c("doc_queryables", "rstac_doc", "list") ) testthat::expect_equal( @@ -646,7 +603,7 @@ testthat::test_that("queryables object", { collections(collection_id = "sentinel-2-l2a") %>% queryables() %>% get_request()), - expected = c("Queryables", "RSTACDocument", "list") + expected = c("doc_queryables", "rstac_doc", "list") ) testthat::expect_output( @@ -670,14 +627,14 @@ testthat::test_that("conformance object", { object = subclass( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), - expected = c("conformance", "stac") + expected = c("conformance") ) testthat::expect_equal( object = subclass( rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), - expected = c("conformance", "stac") + expected = c("conformance") ) testthat::expect_equal( @@ -685,7 +642,7 @@ testthat::test_that("conformance object", { stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% conformance() %>% get_request()), - expected = c("Conformance", "RSTACDocument", "list") + expected = c("doc_conformance", "rstac_doc", "list") ) testthat::expect_output( diff --git a/tests/testthat/test-signatures.R b/tests/testthat/test-signatures.R index d11c2fd1..9ae2df89 100644 --- a/tests/testthat/test-signatures.R +++ b/tests/testthat/test-signatures.R @@ -16,13 +16,13 @@ testthat::test_that("signature functions", { # return the same object after signature? testthat::expect_s3_class( object = stac_items %>% items_sign(sign_fn = sign_bdc("AAAA-BBB")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # return the same object after signature? testthat::expect_s3_class( object = stac_item %>% items_sign(sign_fn = sign_bdc("AAAA-BBB")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) items_signed <- items_sign(stac_items, sign_fn = sign_bdc("AAAA-BBB")) @@ -91,7 +91,7 @@ testthat::test_that("signature functions", { object = suppressWarnings( items_sign(stac_items, sign_planetary_computer) ), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # provided wrong url @@ -107,7 +107,7 @@ testthat::test_that("signature functions", { object = suppressWarnings( items_sign(stac_item, sign_fn = sign_planetary_computer()) ), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) items_signed <- suppressWarnings( From d1445eda1047e11684d075f1af3b7dc19db2bcf9 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Fri, 1 Dec 2023 17:58:20 +0100 Subject: [PATCH 02/35] Add support to static catalogs (closes #21) --- R/static-funs.R | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 R/static-funs.R diff --git a/R/static-funs.R b/R/static-funs.R new file mode 100644 index 00000000..2500c78d --- /dev/null +++ b/R/static-funs.R @@ -0,0 +1,45 @@ +#' @rdname request +#' @export +stac_read <- function(url, ...) { + check_character(url, "STAC URL must be a character value.") + content <- jsonlite::read_json(url) + # create an rstac doc from content and return + as_rstac_doc(content, base_url = url) +} + +read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { + check_collection(collection) + rel <- NULL + link_items <- links(collection, rel == "item") + if (is.null(limit) || limit < 1) + limit <- length(link_items) + limit <- max(1, as.integer(limit)) + page <- max(1, as.integer(page)) + pages <- ceiling(length(link_items) / limit) + if (page > pages) + return(NULL) + if (length(link_items) > limit) { + previous_len <- (page - 1) * limit + len <- min(limit, length(link_items) - previous_len) + link_items <- link_items[previous_len + seq_len(len)] + } + + # verify if progress bar can be shown + progress <- progress && length(link_items) > 1 + if (progress) { + pb <- utils::txtProgressBar(max = length(link_items), style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) + } + features <- list() + for (i in seq_along(link_items)) { + if (progress) + utils::setTxtProgressBar(pb, i) + features <- c(features, list(link_open(link_items[[i]]))) + } + # Convert to doc_items object and return + doc_items( + x = list(type = "FeatureCollection", features = features), + base_url = url + ) +} From 9726e94001832b3d5e19ae4ccc7e0ac6d25a2fff Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Fri, 1 Dec 2023 19:20:20 +0100 Subject: [PATCH 03/35] Document static functions --- DESCRIPTION | 3 +- NAMESPACE | 3 + NEWS.md | 4 ++ R/items-funs.R | 12 ++-- R/links-funs.R | 21 ------- R/static-funs.R | 119 ++++++++++++++++++++++++++++++++++- README.md | 28 ++++----- man/request.Rd | 5 +- man/static_functions.Rd | 95 ++++++++++++++++++++++++++++ vignettes/rstac-01-intro.Rmd | 2 +- 10 files changed, 243 insertions(+), 49 deletions(-) delete mode 100644 R/links-funs.R create mode 100644 man/static_functions.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 42e21e84..21668f73 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rstac Title: Client Library for SpatioTemporal Asset Catalog -Version: 0.9.2-5 +Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", @@ -72,7 +72,6 @@ Collate: 'items-funs.R' 'items-utils.R' 'items-query.R' - 'links-funs.R' 'message-utils.R' 'preview-utils.R' 'print.R' diff --git a/NAMESPACE b/NAMESPACE index 1f3fb9fb..63733ce5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -191,9 +191,12 @@ export(items_matched) export(items_next) export(items_reap) export(items_sign) +export(link_open) +export(links) export(post_request) export(preview_plot) export(queryables) +export(read_items) export(sign_bdc) export(sign_planetary_computer) export(stac) diff --git a/NEWS.md b/NEWS.md index a0e25cc3..609a3cc6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # rstac (development version) +# rstac 1.0.0-beta (Pre-Release) + +* Add support to static catalogs + # rstac 0.9.2-4 (Released 2023-06-15) * Fix vignette BDC errors diff --git a/R/items-funs.R b/R/items-funs.R index df0b844b..11e09ff4 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -296,6 +296,8 @@ items_fetch.doc_items <- function(items, ..., } }) } + # Initialize the items + next_items <- items while (TRUE) { # check if features is complete if (!is.null(matched) && (items_length(items) == matched)) @@ -304,15 +306,15 @@ items_fetch.doc_items <- function(items, ..., if (!is.null(matched) && (items_length(items) > matched)) .error(paste("Length of returned items (%s) is different", "from matched items (%s)."), items_length(items), matched) - new_items <- tryCatch({ - items_next(items, ...) + next_items <- tryCatch({ + items_next(next_items, ...) }, next_error = function(e) NULL) - if (is.null(new_items)) + if (is.null(next_items)) break - items$features <- c(items$features, new_items$features) + items$features <- c(items$features, next_items$features) # update progress bar if (progress) - utils::setTxtProgressBar(pb, length(new_items)) + utils::setTxtProgressBar(pb, length(next_items)) } items } diff --git a/R/links-funs.R b/R/links-funs.R deleted file mode 100644 index c48cd4e6..00000000 --- a/R/links-funs.R +++ /dev/null @@ -1,21 +0,0 @@ -links <- function(x, ...) { - exprs <- as.list(substitute(list(...)))[-1] - sel <- !logical(length(x$links)) - for (expr in exprs) { - sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) - } - structure(x$links[sel], class = c("doc_links", "list")) -} - -link_open <- function(link) { - if (is.list(link)) { - check_link(link) - url <- link$href - if ("rstac:base_url" %in% names(link)) - url <- resolve_url(link[["rstac:base_url"]], url) - } else if (is.character(link)) - url <- link - content <- jsonlite::read_json(url) - # create an rstac doc from content and return - as_rstac_doc(content) -} diff --git a/R/static-funs.R b/R/static-funs.R index 2500c78d..d75badec 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -1,12 +1,97 @@ -#' @rdname request +#' @title Static functions +#' +#' @description +#' These functions provide support to work with static catalogs. +#' +#' \itemize{ +#' \item `stac_read()`: open a STAC document from an URL. +#' +#' \item `read_items()`: opens (statically) all items referred in `links` +#' key entry of a given collection document (`doc_collection`). +#' +#' \item `links()`: extracts and filters the links of any STAC document. +#' +#' \item `link_open()`: opens (statically) the document referenced by +#' the link. This function can resolve any relative URL. +#' } +#' +#' @param url a `character` value with the URL to a valid STAC document. +#' +#' @param collection a `doc_collection` object to fetch all item links. +#' +#' @param limit an `integer` with defining the page size of items to fetch. +#' +#' @param page an `integer` with the page number to fetch the items. +#' +#' @param progress a `logical` indicating if a progress bar must be +#' shown or not. Defaults to `TRUE`. +#' +#' @param x any `rstac` document with `'links'` key entry. +#' +#' @param link a `doc_link` object, usually an element of `links` key entry. +#' +#' @param base_url a `character` with the base URL to resolve relative links. +#' If `NULL` (default) `rstac` will try resolve relative links using +#' internal metadata. +#' +#' @param ... additional arguments. See details. +#' +#' @details +#' Ellipsis argument (`...`) may appears in different items functions and +#' has distinct purposes: +#' \itemize{ +#' +#' \item `stac_read()`: ellipsis is used to pass any additional parameters +#' to [read_json][jsonlite::read_json] function. +#' +#' \item `links()`: ellipsis is used to pass logical expressions to be +#' evaluated against a `doc_link` item as a filter criteria. See examples. +#' +#' } +#' +#' @return +#' +#' \itemize{ +#' \item `links()`: a `doc_links` object containing a list of `link` entries. +#' +#' \item `link_open()`: a recognizable `rstac` document. +#' } +#' +#' @examples +#' \dontrun{ +#' x <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% +#' collections("CB4-16D-2") %>% +#' get_request() +#' +#' link <- links(x, rel == "items") +#' link_open(link[[1]]) +#' } +#' +#' \dontrun{ +#' x <- stac_read( +#' "https://s3.eu-central-1.wasabisys.com/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" +#' ) +#' +#' read_items(x, limit = 10, page = 2) # reads the second page of 10 links +#' +#' } +#' +#' @name static_functions +NULL + +#' @rdname static_functions +#' #' @export stac_read <- function(url, ...) { check_character(url, "STAC URL must be a character value.") - content <- jsonlite::read_json(url) + content <- jsonlite::read_json(url, ...) # create an rstac doc from content and return as_rstac_doc(content, base_url = url) } +#' @rdname static_functions +#' +#' @export read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { check_collection(collection) rel <- NULL @@ -43,3 +128,33 @@ read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { base_url = url ) } + +#' @rdname static_functions +#' +#' @export +links <- function(x, ...) { + exprs <- as.list(substitute(list(...)))[-1] + sel <- !logical(length(x$links)) + for (expr in exprs) { + sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) + } + structure(x$links[sel], class = c("doc_links", "list")) +} + +#' @rdname static_functions +#' +#' @export +link_open <- function(link, base_url = NULL) { + if (is.list(link)) { + check_link(link) + url <- link$href + if (!is.null(base_url)) + url <- resolve_url(base_url, url) + else if ("rstac:base_url" %in% names(link)) + url <- resolve_url(link[["rstac:base_url"]], url) + } else if (is.character(link)) + url <- link + content <- jsonlite::read_json(url) + # create an rstac doc from content and return + as_rstac_doc(content) +} diff --git a/README.md b/README.md index cafa1793..28282549 100644 --- a/README.md +++ b/README.md @@ -110,18 +110,18 @@ it_obj <- s_obj |> it_obj #> ###STACItemCollection -#> - matched feature(s): 1003 -#> - features (100 item(s) / 903 not fetched): -#> - CB4-16D_V2_007004_20230509 -#> - CB4-16D_V2_007005_20230509 -#> - CB4-16D_V2_007006_20230509 -#> - CB4-16D_V2_008004_20230509 -#> - CB4-16D_V2_008006_20230509 -#> - CB4-16D_V2_008005_20230509 -#> - CB4-16D_V2_007004_20230423 -#> - CB4-16D_V2_007005_20230423 -#> - CB4-16D_V2_007006_20230423 -#> - CB4-16D_V2_008004_20230423 +#> - matched feature(s): 1072 +#> - features (100 item(s) / 972 not fetched): +#> - CB4-16D_V2_007004_20231101 +#> - CB4-16D_V2_007006_20231101 +#> - CB4-16D_V2_007005_20231101 +#> - CB4-16D_V2_008004_20231101 +#> - CB4-16D_V2_008006_20231101 +#> - CB4-16D_V2_008005_20231101 +#> - CB4-16D_V2_007004_20231016 +#> - CB4-16D_V2_007005_20231016 +#> - CB4-16D_V2_007006_20231016 +#> - CB4-16D_V2_008004_20231016 #> - ... with 90 more feature(s). #> - assets: #> BAND13, BAND14, BAND15, BAND16, CLEAROB, CMASK, EVI, NDVI, PROVENANCE, thumbnail, TOTALOB @@ -156,7 +156,7 @@ search criteria: # it_obj variable from the last code example it_obj |> items_matched() -#> [1] 1003 +#> [1] 1072 ``` However, if we count how many items there are in `it_obj` variable, we @@ -177,7 +177,7 @@ it_obj <- it_obj |> it_obj |> items_length() -#> [1] 1003 +#> [1] 1072 ``` ### Download assets diff --git a/man/request.Rd b/man/request.Rd index 0048ef80..490e462a 100644 --- a/man/request.Rd +++ b/man/request.Rd @@ -1,16 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/request.R, R/static-funs.R +% Please edit documentation in R/request.R \name{get_request} \alias{get_request} \alias{post_request} -\alias{stac_read} \title{STAC API request functions} \usage{ get_request(q, ...) post_request(q, ..., encode = c("json", "multipart", "form")) - -stac_read(url, ...) } \arguments{ \item{q}{a \code{rstac_query} object expressing a STAC query diff --git a/man/static_functions.Rd b/man/static_functions.Rd new file mode 100644 index 00000000..ce42b2d6 --- /dev/null +++ b/man/static_functions.Rd @@ -0,0 +1,95 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/static-funs.R +\name{static_functions} +\alias{static_functions} +\alias{stac_read} +\alias{read_items} +\alias{links} +\alias{link_open} +\title{Static functions} +\usage{ +stac_read(url, ...) + +read_items(collection, limit = 100, page = 1, progress = TRUE) + +links(x, ...) + +link_open(link, base_url = NULL) +} +\arguments{ +\item{url}{a \code{character} value with the URL to a valid STAC document.} + +\item{...}{additional arguments. See details.} + +\item{collection}{a \code{doc_collection} object to fetch all item links.} + +\item{limit}{an \code{integer} with defining the page size of items to fetch.} + +\item{page}{an \code{integer} with the page number to fetch the items.} + +\item{progress}{a \code{logical} indicating if a progress bar must be +shown or not. Defaults to \code{TRUE}.} + +\item{x}{any \code{rstac} document with \code{'links'} key entry.} + +\item{link}{a \code{doc_link} object, usually an element of \code{links} key entry.} + +\item{base_url}{a \code{character} with the base URL to resolve relative links. +If \code{NULL} (default) \code{rstac} will try resolve relative links using +internal metadata.} +} +\value{ +\itemize{ +\item \code{links()}: a \code{doc_links} object containing a list of \code{link} entries. + +\item \code{link_open()}: a recognizable \code{rstac} document. +} +} +\description{ +These functions provide support to work with static catalogs. + +\itemize{ +\item \code{stac_read()}: open a STAC document from an URL. + +\item \code{read_items()}: opens (statically) all items referred in \code{links} +key entry of a given collection document (\code{doc_collection}). + +\item \code{links()}: extracts and filters the links of any STAC document. + +\item \code{link_open()}: opens (statically) the document referenced by +the link. This function can resolve any relative URL. +} +} +\details{ +Ellipsis argument (\code{...}) may appears in different items functions and +has distinct purposes: +\itemize{ + +\item \code{stac_read()}: ellipsis is used to pass any additional parameters +to \link[jsonlite:read_json]{read_json} function. + +\item \code{links()}: ellipsis is used to pass logical expressions to be +evaluated against a \code{doc_link} item as a filter criteria. See examples. + +} +} +\examples{ +\dontrun{ + x <- stac("https://brazildatacube.dpi.inpe.br/stac") \%>\% + collections("CB4-16D-2") \%>\% + get_request() + + link <- links(x, rel == "items") + link_open(link[[1]]) +} + +\dontrun{ + x <- stac_read( + "https://s3.eu-central-1.wasabisys.com/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" + ) + + read_items(x, limit = 10, page = 2) # reads the second page of 10 links + +} + +} diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd index 6b458bc3..d1561ec0 100644 --- a/vignettes/rstac-01-intro.Rmd +++ b/vignettes/rstac-01-intro.Rmd @@ -264,7 +264,7 @@ items_fetched <- s_obj |> items_fetched ``` -Note that the 1127 has been recovered: +Note that all items was fetched: ```{r length-2} items_length(items_fetched) From 21676d2f9e9f4cc99cc1c499f3b6f0a447433c71 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Sat, 2 Dec 2023 13:51:03 +0100 Subject: [PATCH 04/35] Fix bug on refactored code --- NAMESPACE | 7 --- R/assets-funs.R | 61 ++++++---------------- R/items-funs.R | 71 +++++++------------------- R/static-funs.R | 5 +- man/assets_functions.Rd | 15 ++---- man/items_functions.Rd | 25 +-------- tests/testthat/test-assets_functions.R | 48 ++--------------- tests/testthat/test-rstac_objs.R | 17 ------ 8 files changed, 47 insertions(+), 202 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 63733ce5..24e58895 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,23 +47,16 @@ S3method(items_as_sf,doc_items) S3method(items_assets,default) S3method(items_assets,doc_item) S3method(items_assets,doc_items) -S3method(items_bbox,default) S3method(items_bbox,doc_item) S3method(items_bbox,doc_items) S3method(items_compact,doc_items) -S3method(items_datetime,default) S3method(items_datetime,doc_item) S3method(items_datetime,doc_items) S3method(items_fetch,doc_items) -S3method(items_fields,default) S3method(items_fields,doc_item) S3method(items_fields,doc_items) S3method(items_filter,doc_items) -S3method(items_length,default) -S3method(items_length,doc_item) S3method(items_length,doc_items) -S3method(items_matched,default) -S3method(items_matched,doc_item) S3method(items_matched,doc_items) S3method(items_next,doc_items) S3method(items_reap,default) diff --git a/R/assets-funs.R b/R/assets-funs.R index c85fd038..47df0203 100644 --- a/R/assets-funs.R +++ b/R/assets-funs.R @@ -47,9 +47,6 @@ #' each item to be downloaded. Using this function, you can change the #' hrefs for each asset, as well as the way download is done. #' -#' @param fn `r lifecycle::badge('deprecated')` -#' use `download_fn` parameter instead. -#' #' @param append_gdalvsi a `logical` value. If true, gdal drivers are #' included in the URL of each asset. The following schemes are supported: #' HTTP/HTTPS files, S3 (AWS S3) and GS (Google Cloud Storage). @@ -185,14 +182,11 @@ assets_download <- function(items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., - download_fn = NULL, - fn = deprecated()) { - + download_fn = NULL) { # check output dir if (!dir.exists(output_dir)) .error(paste("The directory provided does not exist.", - "Please specify a valid directory.")) - + "Please, provide an existing directory.")) UseMethod("assets_download", items) } @@ -204,17 +198,7 @@ assets_download.doc_item <- function(items, output_dir = getwd(), overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated()) { - if (!missing(fn)) { - deprec_parameter( - deprec_var = "fn", - deprec_version = "0.9.2", - msg = "Please, use `download_fn` parameter instead." - ) - download_fn <- fn - } - + download_fn = NULL) { if (!is.null(asset_names)) { in_assets <- asset_names %in% items_assets(items) if (!all(asset_names %in% items_assets(items))) { @@ -223,12 +207,10 @@ assets_download.doc_item <- function(items, } items <- assets_select(items = items, asset_names = asset_names) } - items$assets <- lapply( items$assets, asset_download, output_dir = output_dir, overwrite = overwrite, ..., download_fn = download_fn ) - if (create_json) { file <- "item.json" if ("id" %in% names(items)) { @@ -236,29 +218,20 @@ assets_download.doc_item <- function(items, } cat(to_json(items), file = file.path(output_dir, file)) } - return(items) + items } #' @rdname assets_functions #' #' @export assets_download.doc_items <- function(items, - asset_names = NULL, - output_dir = getwd(), - overwrite = FALSE, ..., - download_fn = NULL, - create_json = TRUE, - items_max = Inf, - progress = TRUE, - fn = deprecated()) { - if (!missing(fn)) { - deprec_parameter( - deprec_var = "fn", - deprec_version = "0.9.2", - msg = "Please, use `download_fn` parameter instead." - ) - download_fn <- fn - } + asset_names = NULL, + output_dir = getwd(), + overwrite = FALSE, ..., + download_fn = NULL, + create_json = TRUE, + items_max = Inf, + progress = TRUE) { # remove empty items items <- items_compact(items) items_max <- max(0, min(items_length(items), items_max)) @@ -324,8 +297,8 @@ assets_url.doc_item <- function(items, #' #' @export assets_url.doc_items <- function(items, - asset_names = NULL, - append_gdalvsi = FALSE) { + asset_names = NULL, + append_gdalvsi = FALSE) { if (is.null(asset_names)) { asset_names <- items_assets(items) } @@ -401,8 +374,8 @@ assets_select.doc_item <- function(items, ..., #' #' @export assets_select.doc_items <- function(items, ..., - asset_names = NULL, - select_fn = NULL) { + asset_names = NULL, + select_fn = NULL) { items <- foreach_item( items, assets_select, asset_names = asset_names, ..., select_fn = select_fn @@ -475,9 +448,7 @@ has_assets <- function(items) { #' #' @export has_assets.doc_item <- function(items) { - if (!"assets" %in% names(items)) - .error("Parameter `items` is not a valid.") - return(length(items$assets) > 0) + length(items$assets) > 0 } #' @rdname assets_functions diff --git a/R/items-funs.R b/R/items-funs.R index 11e09ff4..7c076721 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -58,8 +58,6 @@ #' @param pick_fn a `function` used to pick elements from items #' addressed by `field` parameter. #' -#' @param index an `atomic` vector with values as the group index. -#' #' @param sign_fn a `function` that receives an item as a parameter #' and returns an item signed. #' @@ -204,14 +202,6 @@ items_length <- function(items) { UseMethod("items_length", items) } -#' @rdname items_functions -#' -#' @export -items_length.doc_item <- function(items) { - check_item(items) - return(1) -} - #' @rdname items_functions #' #' @export @@ -220,11 +210,6 @@ items_length.doc_items <- function(items) { return(length(items$features)) } -#' @rdname items_functions -#' -#' @export -items_length.default <- items_length.doc_item - #' @rdname items_functions #' #' @export @@ -232,14 +217,6 @@ items_matched <- function(items, matched_field = NULL) { UseMethod("items_matched", items) } -#' @rdname items_functions -#' -#' @export -items_matched.doc_item <- function(items, matched_field = NULL) { - check_item(items) - return(1) -} - #' @rdname items_functions #' #' @export @@ -260,11 +237,6 @@ items_matched.doc_items <- function(items, matched_field = NULL) { matched } -#' @rdname items_functions -#' -#' @export -items_matched.default <- items_matched.doc_item - #' @rdname items_functions #' #' @export @@ -385,7 +357,7 @@ items_datetime <- function(items) { items_datetime.doc_item <- function(items) { check_item(items) if (!"datetime" %in% names(items$properties)) { - .error("Parameter `items` is invalid.") + .error("Item has no datetime field.") } items$properties$datetime } @@ -398,11 +370,6 @@ items_datetime.doc_items <- function(items) { map_chr(items$features, items_datetime) } -#' @rdname items_functions -#' -#' @export -items_datetime.default <- items_datetime.doc_item - #' @rdname items_functions #' #' @export @@ -426,11 +393,6 @@ items_bbox.doc_items <- function(items) { return(items_reap(items, field = "bbox")) } -#' @rdname items_functions -#' -#' @export -items_bbox.default <- items_bbox.doc_item - #' @rdname items_functions #' #' @export @@ -443,7 +405,9 @@ items_assets <- function(items) { #' @export items_assets.doc_item <- function(items) { check_item(items) - items_fields(items, field = "assets") + if (!"assets" %in% names(items)) + .error("Item has no assets.") + names(items$assets) } #' @rdname items_functions @@ -457,7 +421,11 @@ items_assets.doc_items <- function(items) { #' @rdname items_functions #' #' @export -items_assets.default <- items_assets.doc_item +items_assets.default <- function(items) { + if (!"assets" %in% names(items)) + .error("Item has no assets.") + names(items$assets) +} #' @rdname items_functions #' @@ -470,7 +438,6 @@ items_filter <- function(items, ..., filter_fn = NULL) { #' #' @export items_filter.doc_items <- function(items, ..., filter_fn = NULL) { - check_items(items) init_length <- items_length(items) exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), @@ -544,12 +511,14 @@ items_reap.doc_items <- function(items, field, pick_fn = identity) { #' @rdname items_functions #' #' @export -items_reap.default <- items_reap.doc_item +items_reap.default <- function(items, field, pick_fn = identity) { + apply_deeply(items, i = field, fn = pick_fn) +} #' @rdname items_functions #' #' @export -items_fields <- function(items, field = NULL, ...) { +items_fields <- function(items, field = NULL) { UseMethod("items_fields", items) } @@ -575,15 +544,10 @@ items_fields.doc_items <- function(items, field = NULL) { check_items(items) if (items_length(items) == 0) return(NULL) - fields <- lapply(items$features, items_fields.doc_item, field = field) + fields <- apply_deeply(items, i = c("features", "*", field), fn = names) sort(unique(unlist(unname(fields)))) } -#' @rdname items_functions -#' -#' @export -items_fields.default <- items_fields.doc_item - #' @rdname items_functions #' #' @export @@ -610,7 +574,9 @@ items_sign.doc_items <- function(items, sign_fn) { #' @rdname items_functions #' #' @export -items_sign.default <- items_sign.doc_item +items_sign.default <- function(items, sign_fn) { + sign_fn(items) +} #' @rdname items_functions #' @@ -631,5 +597,6 @@ items_as_sf.doc_item <- function(items) { #' #' @export items_as_sf.doc_items <- function(items) { - items_as_sf.doc_item(items) + check_items(items) + geojsonsf::geojson_sf(to_json(items)) } diff --git a/R/static-funs.R b/R/static-funs.R index d75badec..49a6a4b7 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -133,7 +133,10 @@ read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { #' #' @export links <- function(x, ...) { - exprs <- as.list(substitute(list(...)))[-1] + exprs <- unquote( + expr = as.list(substitute(list(...), env = environment())[-1]), + env = parent.frame() + ) sel <- !logical(length(x$links)) for (expr in exprs) { sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) diff --git a/man/assets_functions.Rd b/man/assets_functions.Rd index 027e8137..7f37e02a 100644 --- a/man/assets_functions.Rd +++ b/man/assets_functions.Rd @@ -33,8 +33,7 @@ assets_download( output_dir = getwd(), overwrite = FALSE, ..., - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) \method{assets_download}{doc_item}( @@ -44,8 +43,7 @@ assets_download( overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) \method{assets_download}{doc_items}( @@ -57,8 +55,7 @@ assets_download( download_fn = NULL, create_json = TRUE, items_max = Inf, - progress = TRUE, - fn = deprecated() + progress = TRUE ) \method{assets_download}{default}( @@ -68,8 +65,7 @@ assets_download( overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) assets_url(items, asset_names = NULL, append_gdalvsi = FALSE) @@ -131,9 +127,6 @@ if FALSE, a warning message is shown.} each item to be downloaded. Using this function, you can change the hrefs for each asset, as well as the way download is done.} -\item{fn}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -use \code{download_fn} parameter instead.} - \item{create_json}{a \code{logical} indicating if a JSON file with item metadata (\code{doc_item} or \code{doc_items}) must be created in the output directory.} diff --git a/man/items_functions.Rd b/man/items_functions.Rd index 754cbb1f..8c538bf0 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -3,13 +3,9 @@ \name{items_functions} \alias{items_functions} \alias{items_length} -\alias{items_length.doc_item} \alias{items_length.doc_items} -\alias{items_length.default} \alias{items_matched} -\alias{items_matched.doc_item} \alias{items_matched.doc_items} -\alias{items_matched.default} \alias{items_fetch} \alias{items_fetch.doc_items} \alias{items_next} @@ -17,11 +13,9 @@ \alias{items_datetime} \alias{items_datetime.doc_item} \alias{items_datetime.doc_items} -\alias{items_datetime.default} \alias{items_bbox} \alias{items_bbox.doc_item} \alias{items_bbox.doc_items} -\alias{items_bbox.default} \alias{items_assets} \alias{items_assets.doc_item} \alias{items_assets.doc_items} @@ -37,7 +31,6 @@ \alias{items_fields} \alias{items_fields.doc_item} \alias{items_fields.doc_items} -\alias{items_fields.default} \alias{items_sign} \alias{items_sign.doc_item} \alias{items_sign.doc_items} @@ -49,20 +42,12 @@ \usage{ items_length(items) -\method{items_length}{doc_item}(items) - \method{items_length}{doc_items}(items) -\method{items_length}{default}(items) - items_matched(items, matched_field = NULL) -\method{items_matched}{doc_item}(items, matched_field = NULL) - \method{items_matched}{doc_items}(items, matched_field = NULL) -\method{items_matched}{default}(items, matched_field = NULL) - items_fetch(items, ...) \method{items_fetch}{doc_items}(items, ..., progress = TRUE, matched_field = NULL) @@ -77,16 +62,12 @@ items_datetime(items) \method{items_datetime}{doc_items}(items) -\method{items_datetime}{default}(items) - items_bbox(items) \method{items_bbox}{doc_item}(items) \method{items_bbox}{doc_items}(items) -\method{items_bbox}{default}(items) - items_assets(items) \method{items_assets}{doc_item}(items) @@ -111,14 +92,12 @@ items_reap(items, field, pick_fn = identity) \method{items_reap}{default}(items, field, pick_fn = identity) -items_fields(items, field = NULL, ...) +items_fields(items, field = NULL) \method{items_fields}{doc_item}(items, field = NULL) \method{items_fields}{doc_items}(items, field = NULL) -\method{items_fields}{default}(items, field = NULL) - items_sign(items, sign_fn) \method{items_sign}{doc_item}(items, sign_fn) @@ -158,8 +137,6 @@ addressed by \code{field} parameter.} \item{sign_fn}{a \code{function} that receives an item as a parameter and returns an item signed.} - -\item{index}{an \code{atomic} vector with values as the group index.} } \value{ \itemize{ diff --git a/tests/testthat/test-assets_functions.R b/tests/testthat/test-assets_functions.R index 248dda64..2735bc55 100644 --- a/tests/testthat/test-assets_functions.R +++ b/tests/testthat/test-assets_functions.R @@ -52,24 +52,6 @@ testthat::test_that("assets functions", { expected = "doc_items" ) - # deprec param - testthat::expect_message( - object = { - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-09-01/2019-11-01", - limit = 1) %>% - get_request() %>% - assets_download(asset_names = c("thumbnail"), - fn = function(x) { x }, - output_dir = tempdir(), - create_json = FALSE, - overwrite = TRUE) - }, - regexp = "deprecated" - ) - testthat::expect_equal( object = { x <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% @@ -104,22 +86,6 @@ testthat::test_that("assets functions", { expected = "doc_item" ) - # deprec fn param - testthat::expect_message( - object = { - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - collections("CB4-16D-2") %>% - items("CB4-16D_V2_000002_20230509") %>% - get_request() %>% - assets_download(asset_names = c("thumbnail"), - fn = function(x) {x}, - output_dir = tempdir(), - create_json = FALSE, - overwrite = TRUE) - }, - regexp = "deprecated" - ) - testthat::expect_equal( object = { x <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% @@ -345,49 +311,41 @@ testthat::test_that("assets functions", { ) # assets_select----------------------------------------------------------- - # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_select(stac_items, `eo:bands` < 6)))}, + object = {class(assets_select(stac_items, `eo:bands` < 6))}, expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_select testthat::expect_equal( - object = {suppressWarnings(class(assets_select(stac_items, select_fn = function(x) { + object = {class(assets_select(stac_items, select_fn = function(x) { if ("eo:bands" %in% names(x)) return(x$`eo:bands` < 6) return(FALSE) - })))}, + }))}, expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_select testthat::expect_equal( object = class(assets_select(stac_item, `eo:bands` < 6)), expected = c("doc_item", "rstac_doc", "list") ) - # deprec function assets_select testthat::expect_error( object = assets_select(stac_item, a = `eo:bands` < 6), ) - # deprec function assets_select testthat::expect_warning( object = assets_select(stac_item, `eo:dbandsd` < 6), ) - # deprec function assets_select testthat::expect_error( object = assets_select(stac_items, a = `eo:bands` < 6), ) - # deprec function assets_select testthat::expect_warning( object = assets_select(stac_items, `eo:dbandsd` < 6), ) - # deprec function assets_select testthat::expect_equal( object = { class(assets_select(stac_item, select_fn = function(x) { diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index fbb60c2e..5e0a27f3 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -542,23 +542,6 @@ testthat::test_that("stac item object", { regexp = "###Item" ) - # output test - testthat::expect_equal( - object = items_length(stac_item), - expected = 1 - ) - - # output test - testthat::expect_equal( - object = items_matched(stac_item), - expected = 1 - ) - - # output test - testthat::expect_equal( - object = items_length(stac_item), - expected = 1 - ) }) testthat::test_that("queryables object", { From 3ce63a5380af434da028ededc20af6ff75903233 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Sat, 2 Dec 2023 14:19:49 +0100 Subject: [PATCH 05/35] Add acknowleadgment of OpenGeoHub --- README.Rmd | 2 ++ README.md | 9 +++++++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index a6ae0b5d..a002bd77 100644 --- a/README.Rmd +++ b/README.Rmd @@ -217,6 +217,8 @@ We acknowledge and thank the project funders that provided financial and materia - Radiant Earth Foundation and STAC Project Steering Committee for the advance of STAC ecosystem programme. +- OpenGeoHub Foundation and the European Commission (EC) through the project Open-Earth-Monitor Cyberinfrastructure: Environmental information to support EU’s Green Deal (1 Jun. 2022 – 31 May 2026 - 101059548) + ## How to contribute? The `rstac` package was implemented based on an extensible architecture, so diff --git a/README.md b/README.md index 28282549..e00e8a95 100644 --- a/README.md +++ b/README.md @@ -82,7 +82,7 @@ Brazilian National Space Research Institute (INPE). s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") get_request(s_obj) -#> ###STACCatalog +#> ###Catalog #> - id: bdc #> - description: Brazil Data Cube Catalog #> - field(s): description, id, stac_version, links @@ -109,7 +109,7 @@ it_obj <- s_obj |> get_request() it_obj -#> ###STACItemCollection +#> ###Items #> - matched feature(s): 1072 #> - features (100 item(s) / 972 not fetched): #> - CB4-16D_V2_007004_20231101 @@ -245,6 +245,11 @@ material support: - Radiant Earth Foundation and STAC Project Steering Committee for the advance of STAC ecosystem programme. +- OpenGeoHub Foundation and the European Commission (EC) through the + project Open-Earth-Monitor Cyberinfrastructure: Environmental + information to support EU’s Green Deal (1 Jun. 2022 – 31 May 2026 - + 101059548) + ## How to contribute? The `rstac` package was implemented based on an extensible architecture, From cb28ddb06d0f43b84c5dbb43dd14c86037bc5f23 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Thu, 7 Dec 2023 11:30:34 +0100 Subject: [PATCH 06/35] Add static functions --- R/stac-funs.R | 2 ++ R/static-funs.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/R/stac-funs.R b/R/stac-funs.R index 38b18578..7c5d90e0 100644 --- a/R/stac-funs.R +++ b/R/stac-funs.R @@ -30,6 +30,8 @@ stac_subclass <- function(obj) { return("doc_items") if (obj$type == "Collection") return("doc_collection") + if (obj$type == "Catalog") + return("doc_catalog") .error("Invalid STAC document. Key value 'type': '", obj$type, "' is not a supported STAC document.") } else { diff --git a/R/static-funs.R b/R/static-funs.R index 49a6a4b7..811c55b7 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -159,5 +159,5 @@ link_open <- function(link, base_url = NULL) { url <- link content <- jsonlite::read_json(url) # create an rstac doc from content and return - as_rstac_doc(content) + as_rstac_doc(content, base_url = url) } From 1d444d0a6dae0abcfe59642c5ad6a3cfdf981c12 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Fri, 19 Jan 2024 18:09:34 +0100 Subject: [PATCH 07/35] Add new function items_geometry() --- R/geom-funs.R | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ R/items-funs.R | 23 ++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100644 R/geom-funs.R diff --git a/R/geom-funs.R b/R/geom-funs.R new file mode 100644 index 00000000..e4d273f8 --- /dev/null +++ b/R/geom-funs.R @@ -0,0 +1,53 @@ +geom_type <- function(x) { + if (!"type" %in% names(x) || !"coordinates" %in% names(x)) + .error("Invalid geometry object") + x$type +} + +geom_switch <- function(x, ...) { + switch(geom_type(x), ..., + .error("Geometry of type '%s' is not supported", geom_type(x))) +} + +get_geom <- function(x) { + geom_switch( + x, + Point = point(x), + MultiPoint = multi_point(x), + LineString = linestring(x), + MultiLineString = multi_linestring(x), + Polygon = polygon(x), + MultiPolygon = multi_polygon(x), + GeometryCollection = geom_collection(x) + ) +} + +point <- function(x) { + data <- unlist(x$coordinates)[c(1, 2)] + structure(data, class = c("XY", "POINT", "sfg")) +} + +multi_point <- function(x) { + data <- matrix(unlist(x$coordinates), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data), class = c("XY", "MULTIPOINT", "sfg")) +} + +linestring <- function(x) { + +} + +multi_linestring <- function(x) { + +} + +polygon <- function(x) { + +} + +multi_polygon <- function(x) { + +} + +geom_collection <- function(x) { + +} diff --git a/R/items-funs.R b/R/items-funs.R index 7c076721..c16d4c9e 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -600,3 +600,26 @@ items_as_sf.doc_items <- function(items) { check_items(items) geojsonsf::geojson_sf(to_json(items)) } + +#' @rdname items_functions +#' +#' @export +items_geometry <- function(items) { + UseMethod("items_geometry", items) +} + +#' @rdname items_functions +#' +#' @export +items_geometry.doc_item <- function(items) { + check_item(items) + geojsonsf::geojson_sf(to_json(items)) +} + +#' @rdname items_functions +#' +#' @export +items_geometry.doc_items <- function(items) { + check_items(items) + geojsonsf::geojson_sf(to_json(items)) +} From 946c140b7be289e4a3be9aad87d049ff70ae78b8 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Mon, 22 Jan 2024 09:08:02 +0100 Subject: [PATCH 08/35] Implement geojson->sf converter --- R/geom-funs.R | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/R/geom-funs.R b/R/geom-funs.R index e4d273f8..9751d69a 100644 --- a/R/geom-funs.R +++ b/R/geom-funs.R @@ -17,8 +17,7 @@ get_geom <- function(x) { LineString = linestring(x), MultiLineString = multi_linestring(x), Polygon = polygon(x), - MultiPolygon = multi_polygon(x), - GeometryCollection = geom_collection(x) + MultiPolygon = multi_polygon(x) ) } @@ -33,21 +32,33 @@ multi_point <- function(x) { } linestring <- function(x) { - + data <- matrix(unlist(x$coordinates), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data), class = c("XY", "LINESTRING", "sfg")) } multi_linestring <- function(x) { - + data <- lapply(x$coordinates, \(ls) { + data <- matrix(unlist(ls), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + structure(data, class = c("XY", "MULTILINESTRING", "sfg")) } polygon <- function(x) { - + data <- lapply(x$coordinates, \(lr) { + data <- matrix(unlist(lr), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + structure(data, class = c("XY", "POLYGON", "sfg")) } multi_polygon <- function(x) { - + data <- lapply(x$coordinates, \(pl) { + lapply(pl, \(lr) { + data <- matrix(unlist(lr), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + }) + structure(data, class = c("XY", "MULTIPOLYGON", "sfg")) } -geom_collection <- function(x) { - -} From b5073f03e33aa12019281aa249a1bb0ea72a755a Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Mon, 22 Jan 2024 19:01:32 +0100 Subject: [PATCH 09/35] Add native conversion from geojson to sf --- DESCRIPTION | 3 +- NAMESPACE | 6 ++++ R/geom-funs.R | 11 ++++-- R/items-funs.R | 63 +++++++++++++++++++++++++++------- man/items_functions.Rd | 26 +++++++++++--- man/rstac.Rd | 2 +- tests/testthat/test-examples.R | 56 ------------------------------ 7 files changed, 89 insertions(+), 78 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 21668f73..11e2de5f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ License: MIT + file LICENSE URL: https://brazil-data-cube.github.io/rstac/ BugReports: https://github.com/brazil-data-cube/rstac/issues Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.0 Depends: R (>= 3.5) Imports: @@ -69,6 +69,7 @@ Collate: 'ext_filter.R' 'ext_query.R' 'extensions.R' + 'geom-funs.R' 'items-funs.R' 'items-utils.R' 'items-query.R' diff --git a/NAMESPACE b/NAMESPACE index 24e58895..72d266d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,8 @@ S3method(has_assets,doc_item) S3method(has_assets,doc_items) S3method(items_as_sf,doc_item) S3method(items_as_sf,doc_items) +S3method(items_as_sfc,doc_item) +S3method(items_as_sfc,doc_items) S3method(items_assets,default) S3method(items_assets,doc_item) S3method(items_assets,doc_items) @@ -56,6 +58,8 @@ S3method(items_fetch,doc_items) S3method(items_fields,doc_item) S3method(items_fields,doc_items) S3method(items_filter,doc_items) +S3method(items_intersects,doc_item) +S3method(items_intersects,doc_items) S3method(items_length,doc_items) S3method(items_matched,doc_items) S3method(items_next,doc_items) @@ -172,6 +176,7 @@ export(get_request) export(has_assets) export(items) export(items_as_sf) +export(items_as_sfc) export(items_assets) export(items_bbox) export(items_compact) @@ -179,6 +184,7 @@ export(items_datetime) export(items_fetch) export(items_fields) export(items_filter) +export(items_intersects) export(items_length) export(items_matched) export(items_next) diff --git a/R/geom-funs.R b/R/geom-funs.R index 9751d69a..84d2aba5 100644 --- a/R/geom-funs.R +++ b/R/geom-funs.R @@ -1,5 +1,5 @@ geom_type <- function(x) { - if (!"type" %in% names(x) || !"coordinates" %in% names(x)) + if (!"type" %in% names(x)) .error("Invalid geometry object") x$type } @@ -10,6 +10,8 @@ geom_switch <- function(x, ...) { } get_geom <- function(x) { + if ("geometry" %in% names(x)) + x <- x$geometry geom_switch( x, Point = point(x), @@ -17,7 +19,8 @@ get_geom <- function(x) { LineString = linestring(x), MultiLineString = multi_linestring(x), Polygon = polygon(x), - MultiPolygon = multi_polygon(x) + MultiPolygon = multi_polygon(x), + GeometryCollection = geom_collection(x) ) } @@ -62,3 +65,7 @@ multi_polygon <- function(x) { structure(data, class = c("XY", "MULTIPOLYGON", "sfg")) } +geom_collection <- function(x) { + data <- lapply(x$geometries, get_geom) + structure(data, class = c("XY", "GEOMETRYCOLLECTION", "sfg")) +} diff --git a/R/items-funs.R b/R/items-funs.R index c16d4c9e..81b9e9f6 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -127,8 +127,6 @@ #' #' \item `items_fields()`: a `character` vector. #' -#' \item `items_group()`: a `list` of `doc_items` objects. -#' #' \item `items_sign()`: a `doc_items` object with signed assets url. #' #' \item `items_as_sf()`: a `sf` object. @@ -581,45 +579,84 @@ items_sign.default <- function(items, sign_fn) { #' @rdname items_functions #' #' @export -items_as_sf <- function(items) { +items_as_sf <- function(items, ..., crs = 4326) { UseMethod("items_as_sf", items) } #' @rdname items_functions #' #' @export -items_as_sf.doc_item <- function(items) { +items_as_sf.doc_item <- function(items, ..., crs = 4326) { + check_item(items) + data <- sf::st_sf( + datetime = items_datetime(items), + ..., + geometry = items_as_sfc(items, crs = crs) + ) + data +} + +#' @rdname items_functions +#' +#' @export +items_as_sf.doc_items <- function(items, ..., crs = 4326) { + check_items(items) + data <- sf::st_sf( + datetime = items_datetime(items), + ..., + geometry = items_as_sfc(items, crs = crs) + ) + data +} + +#' @rdname items_functions +#' +#' @export +items_as_sfc <- function(items, crs = 4326) { + UseMethod("items_as_sfc", items) +} + +#' @rdname items_functions +#' +#' @export +items_as_sfc.doc_item <- function(items, crs = 4326) { check_item(items) - geojsonsf::geojson_sf(to_json(items)) + sf::st_sfc(get_geom(items$geometry), crs = crs) } #' @rdname items_functions #' #' @export -items_as_sf.doc_items <- function(items) { +items_as_sfc.doc_items <- function(items, crs = 4326) { check_items(items) - geojsonsf::geojson_sf(to_json(items)) + sf::st_sfc(lapply(items$features, get_geom), crs = crs) } + #' @rdname items_functions #' #' @export -items_geometry <- function(items) { - UseMethod("items_geometry", items) +items_intersects <- function(items, geom, ..., crs = 4326) { + UseMethod("items_intersects", items) } #' @rdname items_functions #' #' @export -items_geometry.doc_item <- function(items) { +items_intersects.doc_item <- function(items, geom, ..., crs = 4326) { check_item(items) - geojsonsf::geojson_sf(to_json(items)) + items_geom <- items_as_sfc(items, crs = crs) + geom <- sf::st_transform(geom, crs = crs) + apply(sf::st_intersects(items_geom, geom), 1, any) > 0 } #' @rdname items_functions #' #' @export -items_geometry.doc_items <- function(items) { +items_intersects.doc_items <- function(items, geom, ..., crs = 4326) { check_items(items) - geojsonsf::geojson_sf(to_json(items)) + items_geom <- items_as_sfc(items, crs = crs) + geom <- sf::st_transform(geom, crs = crs) + apply(sf::st_intersects(items_geom, geom), 1, any) > 0 } + diff --git a/man/items_functions.Rd b/man/items_functions.Rd index 8c538bf0..e43a9b77 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -38,6 +38,12 @@ \alias{items_as_sf} \alias{items_as_sf.doc_item} \alias{items_as_sf.doc_items} +\alias{items_as_sfc} +\alias{items_as_sfc.doc_item} +\alias{items_as_sfc.doc_items} +\alias{items_intersects} +\alias{items_intersects.doc_item} +\alias{items_intersects.doc_items} \title{Items functions} \usage{ items_length(items) @@ -106,11 +112,23 @@ items_sign(items, sign_fn) \method{items_sign}{default}(items, sign_fn) -items_as_sf(items) +items_as_sf(items, ..., crs = 4326) -\method{items_as_sf}{doc_item}(items) +\method{items_as_sf}{doc_item}(items, ..., crs = 4326) -\method{items_as_sf}{doc_items}(items) +\method{items_as_sf}{doc_items}(items, ..., crs = 4326) + +items_as_sfc(items, crs = 4326) + +\method{items_as_sfc}{doc_item}(items, crs = 4326) + +\method{items_as_sfc}{doc_items}(items, crs = 4326) + +items_intersects(items, geom, ..., crs = 4326) + +\method{items_intersects}{doc_item}(items, geom, ..., crs = 4326) + +\method{items_intersects}{doc_items}(items, geom, ..., crs = 4326) } \arguments{ \item{items}{a \code{doc_items} object.} @@ -163,8 +181,6 @@ otherwise or a \code{list}. \item \code{items_fields()}: a \code{character} vector. -\item \code{items_group()}: a \code{list} of \code{doc_items} objects. - \item \code{items_sign()}: a \code{doc_items} object with signed assets url. \item \code{items_as_sf()}: a \code{sf} object. diff --git a/man/rstac.Rd b/man/rstac.Rd index a9a7f84c..71076468 100644 --- a/man/rstac.Rd +++ b/man/rstac.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/rstac.R \docType{package} \name{rstac} -\alias{rstac} \alias{rstac-package} +\alias{rstac} \title{R client library for STAC (rstac)} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index 1157f3f3..a9c0be55 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -86,62 +86,6 @@ testthat::test_that("examples rstac", { items_length(), expected = 10) - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group() - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group() - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group(field = "test", index = "test") - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group(index = list(1, 2, 3)) - ) - ) - # test items_reap testthat::expect_equal( object = typeof( From 7394badf7d7479642f40f7918aded6f888098256 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Sun, 28 Jan 2024 23:36:28 +0100 Subject: [PATCH 10/35] Fix collate --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 21668f73..518f4227 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -69,6 +69,7 @@ Collate: 'ext_filter.R' 'ext_query.R' 'extensions.R' + 'geom-funs.R' 'items-funs.R' 'items-utils.R' 'items-query.R' From 91f4d852a298b6cc18afe0ce6bd0b073f1189e03 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Mon, 29 Jan 2024 12:35:40 +0100 Subject: [PATCH 11/35] Fix vignettes --- vignettes/rstac-01-intro.Rmd | 2 ++ vignettes/rstac-03-cql2-mpc.Rmd | 13 ++++++------- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd index d1561ec0..8b24c04d 100644 --- a/vignettes/rstac-01-intro.Rmd +++ b/vignettes/rstac-01-intro.Rmd @@ -32,6 +32,8 @@ library(tibble) ``` ```{r setup, eval=TRUE, echo=FALSE} +if (!requireNamespace("png")) install.packages("png") +library(png) library(rstac) ``` diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd index 08984248..4ab76abc 100644 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ b/vignettes/rstac-03-cql2-mpc.Rmd @@ -31,6 +31,8 @@ knitr::opts_chunk$set( ```{r load-rstac, eval=TRUE} +if (!requireNamespace("tmap")) install.packages("tmap") +library(tmap) library(rstac) ``` @@ -246,18 +248,15 @@ library(slider) library(ggplot2) df <- items_as_sf(stac_items) |> + dplyr::mutate(cloud_cover = rstac::items_reap(stac_items, c("properties", "eo:cloud_cover"))) |> dplyr::mutate(datetime = as.Date(datetime)) |> dplyr::group_by(datetime) |> - dplyr::summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) |> - dplyr::mutate( - `eo:cloud_cover` = slider::slide_mean( - `eo:cloud_cover`, before = 3, after = 3 - ) - ) + dplyr::summarise(cloud_cover = mean(cloud_cover)) |> + dplyr::mutate(cloud_cover = slider::slide_mean(cloud_cover, before = 3, after = 3)) df |> ggplot2::ggplot() + - ggplot2::geom_line(ggplot2::aes(x = datetime, y = `eo:cloud_cover`)) + ggplot2::geom_line(ggplot2::aes(x = datetime, y = cloud_cover)) ``` `cql2_bbox_as_geojson()` is a `rstac` helper function and it must be evaluated before the request. This is why we embraced it with `{{`. We use `items_fetch()` to retrieve all paginated items matched in the search. From 60143daa8024a987456f248601b2c4c29ae102e1 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Sun, 4 Feb 2024 22:30:05 +0100 Subject: [PATCH 12/35] Fix checking errors --- DESCRIPTION | 6 ++-- NAMESPACE | 4 +++ R/items-funs.R | 56 +++++++++++++++++++++++++++++---- R/items-utils.R | 23 ++++++++++++++ R/rstac.R | 1 + man/items_functions.Rd | 33 +++++++++++++++++-- vignettes/rstac-03-cql2-mpc.Rmd | 7 ++--- 7 files changed, 115 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 11e2de5f..a3624061 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ License: MIT + file LICENSE URL: https://brazil-data-cube.github.io/rstac/ BugReports: https://github.com/brazil-data-cube/rstac/issues Encoding: UTF-8 -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 Depends: R (>= 3.5) Imports: @@ -31,7 +31,8 @@ Imports: utils, jsonlite, lifecycle, - magrittr + magrittr, + tibble Suggests: testthat, sf, @@ -39,7 +40,6 @@ Suggests: rmarkdown, png, jpeg, - tibble, dplyr, purrr, slider, diff --git a/NAMESPACE b/NAMESPACE index 72d266d1..19b348e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,6 +63,8 @@ S3method(items_intersects,doc_items) S3method(items_length,doc_items) S3method(items_matched,doc_items) S3method(items_next,doc_items) +S3method(items_properties,doc_item) +S3method(items_properties,doc_items) S3method(items_reap,default) S3method(items_reap,doc_item) S3method(items_reap,doc_items) @@ -188,6 +190,7 @@ export(items_intersects) export(items_length) export(items_matched) export(items_next) +export(items_properties) export(items_reap) export(items_sign) export(link_open) @@ -213,5 +216,6 @@ importFrom(httr,write_disk) importFrom(jsonlite,fromJSON) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") +importFrom(tibble,as_tibble) importFrom(utils,URLdecode) importFrom(utils,modifyList) diff --git a/R/items-funs.R b/R/items-funs.R index 81b9e9f6..8713e95f 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -39,6 +39,15 @@ #' #' \item `items_as_sf()`: `r lifecycle::badge('experimental')` convert items #' to `sf` object. +#' +#' \item `items_as_sfc()`: `r lifecycle::badge('experimental')` convert items +#' to `sfc` object. +#' +#' \item `items_intersects()`: `r lifecycle::badge('experimental')` indicates +#' which items intersects a given geometry. +#' +#' \item `items_properties()`: lists properties names inside an item. +#' #' } #' #' @param items a `doc_items` object. @@ -64,6 +73,10 @@ #' @param filter_fn a `function` that receives an item that should #' evaluate a `logical` value. #' +#' @param crs a `character` representing the geometry projection. +#' +#' @param geom a `sf` or `sfc` object. +#' #' @param ... additional arguments. See details. #' #' @details @@ -117,8 +130,8 @@ #' #' \item `items_bbox()`: returns a `list` with all items' bounding boxes. #' -#' \item `item_assets()`: Returns a `character` value with all assets names -#' of the all items. +#' \item `item_assets()`: returns a `character` value with all assets names +#' of all items. #' #' \item `items_filter()`: a `doc_items` object. #' @@ -131,6 +144,13 @@ #' #' \item `items_as_sf()`: a `sf` object. #' +#' \item `items_as_sfc()`: a `sfc` object. +#' +#' \item `items_intersects()`: a `logical` vector. +#' +#' \item `items_properties()`: returns a `character` value with all properties +#' of all items. +#' #' } #' #' @examples @@ -589,10 +609,10 @@ items_as_sf <- function(items, ..., crs = 4326) { items_as_sf.doc_item <- function(items, ..., crs = 4326) { check_item(items) data <- sf::st_sf( - datetime = items_datetime(items), - ..., + items_as_tibble(items), geometry = items_as_sfc(items, crs = crs) ) + class(data) <- c("sf", "tbl_df", "tbl", "data.frame") data } @@ -602,10 +622,10 @@ items_as_sf.doc_item <- function(items, ..., crs = 4326) { items_as_sf.doc_items <- function(items, ..., crs = 4326) { check_items(items) data <- sf::st_sf( - datetime = items_datetime(items), - ..., + items_as_tibble(items), geometry = items_as_sfc(items, crs = crs) ) + #class(data) <- c("sf", "tbl_df", "tbl", "data.frame") data } @@ -660,3 +680,27 @@ items_intersects.doc_items <- function(items, geom, ..., crs = 4326) { apply(sf::st_intersects(items_geom, geom), 1, any) > 0 } +#' @rdname items_functions +#' +#' @export +items_properties <- function(items) { + UseMethod("items_properties", items) +} + +#' @rdname items_functions +#' +#' @export +items_properties.doc_item <- function(items) { + check_item(items) + sort(names(items$properties)) +} + +#' @rdname items_functions +#' +#' @export +items_properties.doc_items <- function(items) { + check_items(items) + sort(unique(unlist(lapply(items$features, function(item) { + names(item$properties) + })))) +} diff --git a/R/items-utils.R b/R/items-utils.R index 9a839a89..eb7beaa1 100644 --- a/R/items-utils.R +++ b/R/items-utils.R @@ -19,3 +19,26 @@ eval_filter_fn <- function(f, filter_fn) { value <- FALSE value } + +items_as_tibble <- function(items) { + non_atomic_props <- function(items) { + unique(unlist(lapply(items$features, function(item) { + non_atomic <- vapply(item$properties, function(x) { + is.null(x) || !is.atomic(x) || length(x) > 1 + }, FUN.VALUE = logical(1), USE.NAMES = FALSE) + names(item$properties)[non_atomic] + }))) + } + atomic <- setdiff(items_properties(items), non_atomic_props(items)) + data <- lapply(items$features, function(item) { + values <- item$properties[atomic] + names(values) <- atomic + values + }) + data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) + structure( + data, + class = c("tbl_df", "tbl", "data.frame"), + row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) + ) +} diff --git a/R/rstac.R b/R/rstac.R index 01a407b0..4f8cfbd4 100644 --- a/R/rstac.R +++ b/R/rstac.R @@ -64,4 +64,5 @@ magrittr::`%>%` #' @importFrom utils modifyList URLdecode #' @importFrom jsonlite fromJSON #' @importFrom lifecycle deprecated +#' @importFrom tibble as_tibble NULL diff --git a/man/items_functions.Rd b/man/items_functions.Rd index e43a9b77..08ada638 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -44,6 +44,9 @@ \alias{items_intersects} \alias{items_intersects.doc_item} \alias{items_intersects.doc_items} +\alias{items_properties} +\alias{items_properties.doc_item} +\alias{items_properties.doc_items} \title{Items functions} \usage{ items_length(items) @@ -129,6 +132,12 @@ items_intersects(items, geom, ..., crs = 4326) \method{items_intersects}{doc_item}(items, geom, ..., crs = 4326) \method{items_intersects}{doc_items}(items, geom, ..., crs = 4326) + +items_properties(items) + +\method{items_properties}{doc_item}(items) + +\method{items_properties}{doc_items}(items) } \arguments{ \item{items}{a \code{doc_items} object.} @@ -155,6 +164,10 @@ addressed by \code{field} parameter.} \item{sign_fn}{a \code{function} that receives an item as a parameter and returns an item signed.} + +\item{crs}{a \code{character} representing the geometry projection.} + +\item{geom}{a \code{sf} or \code{sfc} object.} } \value{ \itemize{ @@ -171,8 +184,8 @@ does support this extension. Otherwise returns \code{NULL}. \item \code{items_bbox()}: returns a \code{list} with all items' bounding boxes. -\item \code{item_assets()}: Returns a \code{character} value with all assets names -of the all items. +\item \code{item_assets()}: returns a \code{character} value with all assets names +of all items. \item \code{items_filter()}: a \code{doc_items} object. @@ -185,6 +198,13 @@ otherwise or a \code{list}. \item \code{items_as_sf()}: a \code{sf} object. +\item \code{items_as_sfc()}: a \code{sfc} object. + +\item \code{items_intersects()}: a \code{logical} vector. + +\item \code{items_properties()}: returns a \code{character} value with all properties +of all items. + } } \description{ @@ -226,6 +246,15 @@ in a \code{doc_items} object. \item \code{items_as_sf()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items to \code{sf} object. + +\item \code{items_as_sfc()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items +to \code{sfc} object. + +\item \code{items_intersects()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} indicates +which items intersects a given geometry. + +\item \code{items_properties()}: lists properties names inside an item. + } } \details{ diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd index 4ab76abc..7398c7cd 100644 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ b/vignettes/rstac-03-cql2-mpc.Rmd @@ -248,15 +248,14 @@ library(slider) library(ggplot2) df <- items_as_sf(stac_items) |> - dplyr::mutate(cloud_cover = rstac::items_reap(stac_items, c("properties", "eo:cloud_cover"))) |> dplyr::mutate(datetime = as.Date(datetime)) |> dplyr::group_by(datetime) |> - dplyr::summarise(cloud_cover = mean(cloud_cover)) |> - dplyr::mutate(cloud_cover = slider::slide_mean(cloud_cover, before = 3, after = 3)) + dplyr::summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) |> + dplyr::mutate(`eo:cloud_cover` = slider::slide_mean(`eo:cloud_cover`, before = 3, after = 3)) df |> ggplot2::ggplot() + - ggplot2::geom_line(ggplot2::aes(x = datetime, y = cloud_cover)) + ggplot2::geom_line(ggplot2::aes(x = datetime, y = `eo:cloud_cover`)) ``` `cql2_bbox_as_geojson()` is a `rstac` helper function and it must be evaluated before the request. This is why we embraced it with `{{`. We use `items_fetch()` to retrieve all paginated items matched in the search. From 0041cf44ec24fe7581088b08530a0cbc64d0efa5 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Mon, 5 Feb 2024 17:43:08 +0100 Subject: [PATCH 13/35] Improving static STAC functions --- NAMESPACE | 5 +- R/doc-funs.R | 42 +++++++++++ R/stac-funs.R | 32 ++------ R/static-funs.R | 87 +++++++++++++++++++--- man/{stac_version.Rd => stac_functions.Rd} | 6 +- man/static_functions.Rd | 27 +++++-- tests/testthat/test-rstac_objs.R | 2 +- 7 files changed, 157 insertions(+), 44 deletions(-) rename man/{stac_version.Rd => stac_functions.Rd} (90%) diff --git a/NAMESPACE b/NAMESPACE index 19b348e1..c68d0a6f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,6 +86,7 @@ S3method(print,doc_link) S3method(print,doc_links) S3method(print,doc_queryables) S3method(print,rstac_query) +S3method(stac_type,rstac_doc) S3method(stac_version,doc_collections) S3method(stac_version,doc_items) S3method(stac_version,rstac_doc) @@ -198,12 +199,14 @@ export(links) export(post_request) export(preview_plot) export(queryables) +export(read_collections) export(read_items) +export(read_stac) export(sign_bdc) export(sign_planetary_computer) export(stac) -export(stac_read) export(stac_search) +export(stac_type) export(stac_version) importFrom(crayon,bold) importFrom(httr,GET) diff --git a/R/doc-funs.R b/R/doc-funs.R index 84790dd5..916e4b79 100644 --- a/R/doc-funs.R +++ b/R/doc-funs.R @@ -29,6 +29,47 @@ subclass.rstac_doc <- function(x) { class(x)[[1]] } +#' @export +stac_type.rstac_doc <- function(x) { + subclass <- subclass(x) + switch( + subclass, + doc_conformance = "Conformance", + doc_catalog = "Catalog", + doc_collection = "Collection", + doc_collections = "Collections", + doc_item = "Item", + doc_items = "Items" + ) +} + +stac_subclass <- function(obj) { + if (!is.list(obj) || is.null(names(obj))) + .error("Invalid STAC document.") + if ("type" %in% names(obj)) { + if (obj$type == "Feature") + return("doc_item") + if (obj$type == "FeatureCollection") + return("doc_items") + if (obj$type == "Collection") + return("doc_collection") + if (obj$type == "Catalog") + return("doc_catalog") + .error("Invalid STAC document. Key value 'type': '", obj$type, + "' is not a supported STAC document.") + } else { + if ("conformsTo" %in% names(obj)) + return("doc_conformance") + if ("collections" %in% names(obj)) + return("doc_collections") + if ("id" %in% names(obj) && "links" %in% names(obj)) + return("doc_collection") + if ("links" %in% names(obj)) + return("doc_catalog") + .error("Invalid STAC document.") + } +} + as_rstac_doc <- function(x, base_url = NULL) { subclass <- stac_subclass(x) switch( @@ -66,6 +107,7 @@ doc_links <- function(x, base_url = NULL) { if (!is.list(x)) .error("Invalid Links object.") x <- lapply(x, doc_link, base_url = base_url) + x <- c(list(list(rel = "self", href = base_url)), x) rstac_doc(x, subclass = c("doc_links")) } diff --git a/R/stac-funs.R b/R/stac-funs.R index 7c5d90e0..4d65d1ba 100644 --- a/R/stac-funs.R +++ b/R/stac-funs.R @@ -15,34 +15,16 @@ #' The `stac_version()` function returns a `character` STAC API #' version. #' +#' @name stac_functions +#' #' @export stac_version <- function(x, ...) { UseMethod("stac_version", x) } -stac_subclass <- function(obj) { - if (!is.list(obj) || is.null(names(obj))) - .error("Invalid STAC document.") - if ("type" %in% names(obj)) { - if (obj$type == "Feature") - return("doc_item") - if (obj$type == "FeatureCollection") - return("doc_items") - if (obj$type == "Collection") - return("doc_collection") - if (obj$type == "Catalog") - return("doc_catalog") - .error("Invalid STAC document. Key value 'type': '", obj$type, - "' is not a supported STAC document.") - } else { - if ("conformsTo" %in% names(obj)) - return("doc_conformance") - if ("collections" %in% names(obj)) - return("doc_collections") - if ("id" %in% names(obj) && "links" %in% names(obj)) - return("doc_collection") - if ("links" %in% names(obj)) - return("doc_catalog") - .error("Invalid STAC document.") - } +#' @rdname stac_functions +#' +#' @export +stac_type <- function(x) { + UseMethod("stac_type", x) } diff --git a/R/static-funs.R b/R/static-funs.R index 811c55b7..1f9d3dde 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -17,7 +17,10 @@ #' #' @param url a `character` value with the URL to a valid STAC document. #' -#' @param collection a `doc_collection` object to fetch all item links. +#' @param catalog a `doc_catalog` object to fetch all `rel=="child"` links. +#' +#' @param collection a `doc_collection` object to fetch all +#' `rel=="item"` links. #' #' @param limit an `integer` with defining the page size of items to fetch. #' @@ -68,12 +71,21 @@ #' } #' #' \dontrun{ -#' x <- stac_read( -#' "https://s3.eu-central-1.wasabisys.com/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" +#' wv_url <- paste0( +#' "https://s3.eu-central-1.wasabisys.com", +#' "/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" #' ) +#' wv <- read_stac(wv_url) +#' stac_type(wv) # Collection +#' +#' # reads the second page of 5 links +#' wv_items <- read_items(wv, limit = 5, page = 2) #' -#' read_items(x, limit = 10, page = 2) # reads the second page of 10 links +#' # lists all links of the collection document that are not items +#' links(wv, rel != "item") #' +#' # lists all links of the items document +#' links(wv_items) #' } #' #' @name static_functions @@ -82,7 +94,7 @@ NULL #' @rdname static_functions #' #' @export -stac_read <- function(url, ...) { +read_stac <- function(url, ...) { check_character(url, "STAC URL must be a character value.") content <- jsonlite::read_json(url, ...) # create an rstac doc from content and return @@ -120,13 +132,68 @@ read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { for (i in seq_along(link_items)) { if (progress) utils::setTxtProgressBar(pb, i) - features <- c(features, list(link_open(link_items[[i]]))) + item <- link_open(link_items[[i]]) + features <- c(features, list(item)) } # Convert to doc_items object and return - doc_items( - x = list(type = "FeatureCollection", features = features), - base_url = url - ) + parent <- links(collection, rel == "self") + if (length(parent) > 0) { + parent <- parent[[1]] + parent$rel <- "parent" + parent <- list(parent) + } + doc_items(list( + type = "FeatureCollection", + features = features, + links = parent + )) +} + +#' @rdname static_functions +#' +#' @export +read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { + check_catalog(catalog) + rel <- NULL + link_collections <- links(catalog, rel == "child") + if (is.null(limit) || limit < 1) + limit <- length(link_collections) + limit <- max(1, as.integer(limit)) + page <- max(1, as.integer(page)) + pages <- ceiling(length(link_collections) / limit) + if (page > pages) + return(NULL) + if (length(link_collections) > limit) { + previous_len <- (page - 1) * limit + len <- min(limit, length(link_collections) - previous_len) + link_collections <- link_collections[previous_len + seq_len(len)] + } + + # verify if progress bar can be shown + progress <- progress && length(link_collections) > 1 + if (progress) { + pb <- utils::txtProgressBar(max = length(link_collections), style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) + } + collections <- list() + for (i in seq_along(link_collections)) { + if (progress) + utils::setTxtProgressBar(pb, i) + collection <- link_open(link_collections[[i]]) + collections <- c(collections, list(collection)) + } + # Convert to doc_items object and return + parent <- links(catalog, rel == "self") + if (length(parent) > 0) { + parent <- parent[[1]] + parent$rel <- "parent" + parent <- list(parent) + } + doc_collections(list( + collections = collections, + links = parent + )) } #' @rdname static_functions diff --git a/man/stac_version.Rd b/man/stac_functions.Rd similarity index 90% rename from man/stac_version.Rd rename to man/stac_functions.Rd index 113d226b..8c208f70 100644 --- a/man/stac_version.Rd +++ b/man/stac_functions.Rd @@ -1,10 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stac-funs.R -\name{stac_version} +\name{stac_functions} +\alias{stac_functions} \alias{stac_version} +\alias{stac_type} \title{Utility functions} \usage{ stac_version(x, ...) + +stac_type(x) } \arguments{ \item{x}{either a \code{rstac_query} object expressing a STAC query diff --git a/man/static_functions.Rd b/man/static_functions.Rd index ce42b2d6..125c16e6 100644 --- a/man/static_functions.Rd +++ b/man/static_functions.Rd @@ -2,16 +2,19 @@ % Please edit documentation in R/static-funs.R \name{static_functions} \alias{static_functions} -\alias{stac_read} +\alias{read_stac} \alias{read_items} +\alias{read_collections} \alias{links} \alias{link_open} \title{Static functions} \usage{ -stac_read(url, ...) +read_stac(url, ...) read_items(collection, limit = 100, page = 1, progress = TRUE) +read_collections(catalog, limit = 100, page = 1, progress = TRUE) + links(x, ...) link_open(link, base_url = NULL) @@ -21,7 +24,8 @@ link_open(link, base_url = NULL) \item{...}{additional arguments. See details.} -\item{collection}{a \code{doc_collection} object to fetch all item links.} +\item{collection}{a \code{doc_collection} object to fetch all +\code{rel=="item"} links.} \item{limit}{an \code{integer} with defining the page size of items to fetch.} @@ -30,6 +34,8 @@ link_open(link, base_url = NULL) \item{progress}{a \code{logical} indicating if a progress bar must be shown or not. Defaults to \code{TRUE}.} +\item{catalog}{a \code{doc_catalog} object to fetch all \code{rel=="child"} links.} + \item{x}{any \code{rstac} document with \code{'links'} key entry.} \item{link}{a \code{doc_link} object, usually an element of \code{links} key entry.} @@ -84,12 +90,21 @@ evaluated against a \code{doc_link} item as a filter criteria. See examples. } \dontrun{ - x <- stac_read( - "https://s3.eu-central-1.wasabisys.com/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" + wv_url <- paste0( + "https://s3.eu-central-1.wasabisys.com", + "/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" ) + wv <- read_stac(wv_url) + stac_type(wv) # Collection + + # reads the second page of 5 links + wv_items <- read_items(wv, limit = 5, page = 2) - read_items(x, limit = 10, page = 2) # reads the second page of 10 links + # lists all links of the collection document that are not items + links(wv, rel != "item") + # lists all links of the items document + links(wv_items) } } diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index 5e0a27f3..425b0658 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -367,7 +367,7 @@ testthat::test_that("stac collection object", { get_request() testthat::expect_equal( - object = stac_subclass(s_col), + object = stac_type(s_col), expected = "doc_collections" ) From 5b2aa565c5f6fc4c42bd0ef06463c12d8496f96f Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 6 Feb 2024 14:18:20 +0100 Subject: [PATCH 14/35] Improve static functions --- NAMESPACE | 4 ++++ R/static-funs.R | 50 +++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 44 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c68d0a6f..175858eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,8 @@ S3method(items_reap,doc_items) S3method(items_sign,default) S3method(items_sign,doc_item) S3method(items_sign,doc_items) +S3method(link_open,doc_link) +S3method(links,rstac_doc) S3method(parse_params,ext_filter) S3method(parse_params,ext_query) S3method(parse_params,items) @@ -86,6 +88,8 @@ S3method(print,doc_link) S3method(print,doc_links) S3method(print,doc_queryables) S3method(print,rstac_query) +S3method(read_collections,catalog) +S3method(read_items,doc_collection) S3method(stac_type,rstac_doc) S3method(stac_version,doc_collections) S3method(stac_version,doc_items) diff --git a/R/static-funs.R b/R/static-funs.R index 1f9d3dde..a3506fcb 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -105,6 +105,14 @@ read_stac <- function(url, ...) { #' #' @export read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { + UseMethod("read_items", collection) +} + +#' @export +read_items.doc_collection <- function(collection, + limit = 100, + page = 1, + progress = TRUE) { check_collection(collection) rel <- NULL link_items <- links(collection, rel == "item") @@ -153,6 +161,14 @@ read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { #' #' @export read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { + UseMethod("read_collections", catalog) +} + +#' @export +read_collections.catalog <- function(catalog, + limit = 100, + page = 1, + progress = TRUE) { check_catalog(catalog) rel <- NULL link_collections <- links(catalog, rel == "child") @@ -200,13 +216,25 @@ read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { #' #' @export links <- function(x, ...) { + UseMethod("links") +} + +#' @export +links.rstac_doc <- function(x, ...) { exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) sel <- !logical(length(x$links)) for (expr in exprs) { - sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) + sel <- sel & map_lgl(x$links, function(x) { + tryCatch( + eval(expr, envir = x), + error = function(e) { + FALSE + } + ) + }) } structure(x$links[sel], class = c("doc_links", "list")) } @@ -215,15 +243,17 @@ links <- function(x, ...) { #' #' @export link_open <- function(link, base_url = NULL) { - if (is.list(link)) { - check_link(link) - url <- link$href - if (!is.null(base_url)) - url <- resolve_url(base_url, url) - else if ("rstac:base_url" %in% names(link)) - url <- resolve_url(link[["rstac:base_url"]], url) - } else if (is.character(link)) - url <- link + UseMethod("link_open", link) +} + +#' @export +link_open.doc_link <- function(link, base_url = NULL) { + check_link(link) + url <- link$href + if (!is.null(base_url)) + url <- resolve_url(base_url, url) + else if ("rstac:base_url" %in% names(link)) + url <- resolve_url(link[["rstac:base_url"]], url) content <- jsonlite::read_json(url) # create an rstac doc from content and return as_rstac_doc(content, base_url = url) From f763744488e269e8cb772f7fd1e0b7d44ac027d4 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Thu, 8 Feb 2024 00:42:57 +0100 Subject: [PATCH 15/35] Add items_as_tibble() function --- NAMESPACE | 3 +++ R/items-funs.R | 47 ++++++++++++++++++++++++++++++++++++++++++ R/items-utils.R | 28 +++++++------------------ man/items_functions.Rd | 16 ++++++++++++++ 4 files changed, 73 insertions(+), 21 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 175858eb..ea34455d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,8 @@ S3method(items_as_sf,doc_item) S3method(items_as_sf,doc_items) S3method(items_as_sfc,doc_item) S3method(items_as_sfc,doc_items) +S3method(items_as_tibble,doc_item) +S3method(items_as_tibble,doc_items) S3method(items_assets,default) S3method(items_assets,doc_item) S3method(items_assets,doc_items) @@ -184,6 +186,7 @@ export(has_assets) export(items) export(items_as_sf) export(items_as_sfc) +export(items_as_tibble) export(items_assets) export(items_bbox) export(items_compact) diff --git a/R/items-funs.R b/R/items-funs.R index 8713e95f..bff8353e 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -146,6 +146,8 @@ #' #' \item `items_as_sfc()`: a `sfc` object. #' +#' \item `items_as_tibble()`: a `tibble` object. +#' #' \item `items_intersects()`: a `logical` vector. #' #' \item `items_properties()`: returns a `character` value with all properties @@ -208,6 +210,11 @@ #' get_request() %>% items_fetch(progress = FALSE) #' #' stac_item %>% items_reap(field = c("properties", "datetime")) +#' +#' stac_item %>% items_as_sf() +#' +#' stac_item %>% items_as_tibble() +#' #' } #' #' @name items_functions @@ -652,6 +659,46 @@ items_as_sfc.doc_items <- function(items, crs = 4326) { sf::st_sfc(lapply(items$features, get_geom), crs = crs) } +#' @rdname items_functions +#' +#' @export +items_as_tibble <- function(items) { + UseMethod("items_as_tibble", items) +} + +#' @rdname items_functions +#' +#' @export +items_as_tibble.doc_item <- function(items) { + check_item(items) + non_atomic <- non_atomic_properties(items) + items$properties[non_atomic] <- lapply(items$properties[non_atomic], list) + data <- list(items$properties) + data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) + structure( + data, + class = c("tbl_df", "tbl", "data.frame"), + row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) + ) +} + +#' @rdname items_functions +#' +#' @export +items_as_tibble.doc_items <- function(items) { + check_items(items) + non_atomic <- non_atomic_properties(items) + data <- lapply(items$features, function(item) { + item$properties[non_atomic] <- lapply(item$properties[non_atomic], list) + item$properties + }) + data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) + structure( + data, + class = c("tbl_df", "tbl", "data.frame"), + row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) + ) +} #' @rdname items_functions #' diff --git a/R/items-utils.R b/R/items-utils.R index eb7beaa1..f339caff 100644 --- a/R/items-utils.R +++ b/R/items-utils.R @@ -20,25 +20,11 @@ eval_filter_fn <- function(f, filter_fn) { value } -items_as_tibble <- function(items) { - non_atomic_props <- function(items) { - unique(unlist(lapply(items$features, function(item) { - non_atomic <- vapply(item$properties, function(x) { - is.null(x) || !is.atomic(x) || length(x) > 1 - }, FUN.VALUE = logical(1), USE.NAMES = FALSE) - names(item$properties)[non_atomic] - }))) - } - atomic <- setdiff(items_properties(items), non_atomic_props(items)) - data <- lapply(items$features, function(item) { - values <- item$properties[atomic] - names(values) <- atomic - values - }) - data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) - structure( - data, - class = c("tbl_df", "tbl", "data.frame"), - row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) - ) +non_atomic_properties <- function(items) { + unique(unlist(lapply(items$features, function(item) { + non_atomic <- vapply(item$properties, function(x) { + length(x) == 0 || !is.atomic(x) || length(x) > 1 + }, FUN.VALUE = logical(1), USE.NAMES = FALSE) + names(item$properties)[non_atomic] + }))) } diff --git a/man/items_functions.Rd b/man/items_functions.Rd index 08ada638..d3b64bb9 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -41,6 +41,9 @@ \alias{items_as_sfc} \alias{items_as_sfc.doc_item} \alias{items_as_sfc.doc_items} +\alias{items_as_tibble} +\alias{items_as_tibble.doc_item} +\alias{items_as_tibble.doc_items} \alias{items_intersects} \alias{items_intersects.doc_item} \alias{items_intersects.doc_items} @@ -127,6 +130,12 @@ items_as_sfc(items, crs = 4326) \method{items_as_sfc}{doc_items}(items, crs = 4326) +items_as_tibble(items) + +\method{items_as_tibble}{doc_item}(items) + +\method{items_as_tibble}{doc_items}(items) + items_intersects(items, geom, ..., crs = 4326) \method{items_intersects}{doc_item}(items, geom, ..., crs = 4326) @@ -200,6 +209,8 @@ otherwise or a \code{list}. \item \code{items_as_sfc()}: a \code{sfc} object. +\item \code{items_as_tibble()}: a \code{tibble} object. + \item \code{items_intersects()}: a \code{logical} vector. \item \code{items_properties()}: returns a \code{character} value with all properties @@ -347,6 +358,11 @@ stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% get_request() \%>\% items_fetch(progress = FALSE) stac_item \%>\% items_reap(field = c("properties", "datetime")) + +stac_item \%>\% items_as_sf() + +stac_item \%>\% items_as_tibble() + } } From 6f06b07b990d46b854d0fd5ea3e9693ec9875352 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Thu, 8 Feb 2024 01:24:44 +0100 Subject: [PATCH 16/35] Add as.character() S3 for cql2_spatial class --- NAMESPACE | 1 + R/cql2-adv_comp.R | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ea34455d..9b585560 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(after_response,queryables) S3method(after_response,search) S3method(after_response,stac) S3method(as.character,cql2_filter) +S3method(as.character,cql2_spatial) S3method(assets_download,default) S3method(assets_download,doc_item) S3method(assets_download,doc_items) diff --git a/R/cql2-adv_comp.R b/R/cql2-adv_comp.R index e81b8fe3..f406d8fd 100644 --- a/R/cql2-adv_comp.R +++ b/R/cql2-adv_comp.R @@ -137,6 +137,11 @@ get_spatial.GEOMETRYCOLLECTION <- function(x) { ) } +#' @export +as.character.cql2_spatial <- function(x, ...) { + to_text(x) +} + # temporal_op temporal_op <- function(op) { function(a, b) { From 25e509faa4998a9f37de0b0a7528e033d8368329 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Thu, 8 Feb 2024 17:06:02 +0100 Subject: [PATCH 17/35] Update vignettes. Extend filter expressions to read_items() and read_collections() --- R/static-funs.R | 18 ++++++++++++------ vignettes/rstac-01-intro.Rmd | 12 ++++++------ vignettes/rstac-03-cql2-mpc.Rmd | 8 ++++---- 3 files changed, 22 insertions(+), 16 deletions(-) diff --git a/R/static-funs.R b/R/static-funs.R index a3506fcb..dd94cec8 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -104,18 +104,21 @@ read_stac <- function(url, ...) { #' @rdname static_functions #' #' @export -read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { +read_items <- function(collection, ..., + limit = 100, + page = 1, + progress = TRUE) { UseMethod("read_items", collection) } #' @export -read_items.doc_collection <- function(collection, +read_items.doc_collection <- function(collection, ..., limit = 100, page = 1, progress = TRUE) { check_collection(collection) rel <- NULL - link_items <- links(collection, rel == "item") + link_items <- links(collection, rel == "item", ...) if (is.null(limit) || limit < 1) limit <- length(link_items) limit <- max(1, as.integer(limit)) @@ -160,18 +163,21 @@ read_items.doc_collection <- function(collection, #' @rdname static_functions #' #' @export -read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { +read_collections <- function(catalog, ..., + limit = 100, + page = 1, + progress = TRUE) { UseMethod("read_collections", catalog) } #' @export -read_collections.catalog <- function(catalog, +read_collections.catalog <- function(catalog, ..., limit = 100, page = 1, progress = TRUE) { check_catalog(catalog) rel <- NULL - link_collections <- links(catalog, rel == "child") + link_collections <- links(catalog, rel == "child", ...) if (is.null(limit) || limit < 1) limit <- length(link_collections) limit <- max(1, as.integer(limit)) diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd index 8b24c04d..203f78bd 100644 --- a/vignettes/rstac-01-intro.Rmd +++ b/vignettes/rstac-01-intro.Rmd @@ -176,7 +176,7 @@ s_obj |> get_request() ``` -#### `STACItem` object{-} +#### `Item` object{-} ```{r item} s_obj |> @@ -185,7 +185,7 @@ s_obj |> get_request() ``` -#### `STACItemCollection` object{-} +#### `Items` object{-} ```{r item-collection} s_obj |> @@ -194,18 +194,18 @@ s_obj |> ``` -Besides, the `rstac` package provides several auxiliary functions for `STACItem` and `STACItemCollection` objects. These auxiliary functions operate at the item or asset level. Functions dedicated to items have the prefix `items_`. Otherwise, asset-oriented functions have the prefix `assets_` +Besides, the `rstac` package provides several auxiliary functions for `Item` and `Items` objects. These auxiliary functions operate at the item or asset level. Functions dedicated to items have the prefix `items_`. Otherwise, asset-oriented functions have the prefix `assets_` ## Items functions{-} -The `STACItemCollection` object have some facilitating functions to manipulate/extract information, for example: +The `Items` object have some facilitating functions to manipulate/extract information, for example: - **`items_fields()`:** Lists fields names inside an item. -- **`items_filter()`:** Performs a filter by items according to expressions operating on the properties of a `STACItemCollection` object. +- **`items_filter()`:** Performs a filter by items according to expressions operating on the properties of a `Items` object. - **`items_fetch()`:** Performs the pagination of items. - **`items_length()`:** Returns the number of items in an object. - **`items_matched()`:** Returns the number of items matching the search criteria. -- **`items_assets()`:** Returns the assets name from `STACItemCollection` and `STACItem` objects. +- **`items_assets()`:** Returns the assets name from `Items` and `Item` objects. It is interesting to verify the fields of items before filtering: diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd index 7398c7cd..af70d9cb 100644 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ b/vignettes/rstac-03-cql2-mpc.Rmd @@ -55,7 +55,7 @@ planetary_computer CQL2 expressions can be constructed using properties that refer to attributes of items. A list of all properties supported by a collection can be obtained by accessing the `/collections//queryables` endpoint. Filter expressions can use properties listed in this endpoint. -In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queriables and make a `GET` request to the service. +In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queryables and make a `GET` request to the service. ```{r queryables} planetary_computer |> @@ -84,7 +84,7 @@ stac_items <- planetary_computer |> In that example, our filter expression used a temporal (`t_intersects`) and a spatial (`s_intersects`) operators. `t_intersects()` only accepts interval as it second argument, which we created using function `cql2_interval()`. `s_intersects()` spatial operator only accepts GeoJSON objects as its arguments. This is why we had to convert the bounding box vector (`bbox`) into a structure representing a GeoJSON object using the function `cql2_bbox_as_geojson()`. We embrace the arguments using `{{` to evaluate them before make the request. -`items` is a `STACItemCollection` object containing 8 items that matched our search criteria. +`items` is an `Items` object containing 8 items that matched our search criteria. ```{r items-length} stac_items @@ -92,7 +92,7 @@ stac_items ## Exploring data{-} -A `STACItemCollection` is a regular GeoJSON object. It is a collection of `STACItem` entries that stores metadata on assets. Users can convert a `STACItemCollection` to a `sf` object containing the properties field as columns. Here we depict the items footprint. +An `Items` is a regular GeoJSON object. It is a collection of `Item` entries that stores metadata on assets. Users can convert a `Items` to a `sf` object containing the properties field as columns. Here we depict the items footprint. ```{r geojson-to-sf} sf <- items_as_sf(stac_items) @@ -224,7 +224,7 @@ stac_items |> ## Analyzing STAC Metadata{-} -`STACItem` objects are features of `STACItemCollection` and store information about assets. +`Item` objects are features of `Items` and store information about assets. ```{r items-fetch} stac_items <- planetary_computer |> From 9ed2a29511bb786d18d4d5b192c1b570ef53a2a4 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Thu, 8 Feb 2024 19:09:45 +0100 Subject: [PATCH 18/35] Fix documentation --- man/static_functions.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/static_functions.Rd b/man/static_functions.Rd index 125c16e6..fc93ace1 100644 --- a/man/static_functions.Rd +++ b/man/static_functions.Rd @@ -11,9 +11,9 @@ \usage{ read_stac(url, ...) -read_items(collection, limit = 100, page = 1, progress = TRUE) +read_items(collection, ..., limit = 100, page = 1, progress = TRUE) -read_collections(catalog, limit = 100, page = 1, progress = TRUE) +read_collections(catalog, ..., limit = 100, page = 1, progress = TRUE) links(x, ...) From a66bc90d452768eeff65f469a3798ab484ecd6b1 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Sun, 11 Feb 2024 02:29:41 +0100 Subject: [PATCH 19/35] Add items_sign_...() functions --- NAMESPACE | 2 + R/signatures.R | 116 +++++++++++++++++++++++---- man/items_sign_bdc.Rd | 66 +++++++++++++++ man/items_sign_planetary_computer.Rd | 88 ++++++++++++++++++++ man/sign_bdc.Rd | 37 --------- man/sign_planetary_computer.Rd | 55 ------------- 6 files changed, 255 insertions(+), 109 deletions(-) create mode 100644 man/items_sign_bdc.Rd create mode 100644 man/items_sign_planetary_computer.Rd delete mode 100644 man/sign_bdc.Rd delete mode 100644 man/sign_planetary_computer.Rd diff --git a/NAMESPACE b/NAMESPACE index 9b585560..79b799f8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -202,6 +202,8 @@ export(items_next) export(items_properties) export(items_reap) export(items_sign) +export(items_sign_bdc) +export(items_sign_planetary_computer) export(link_open) export(links) export(post_request) diff --git a/R/signatures.R b/R/signatures.R index cd9a5fe9..2a6b856f 100644 --- a/R/signatures.R +++ b/R/signatures.R @@ -3,9 +3,26 @@ ms_token <- new_env() #' @title Signature in hrefs provided by the STAC from the Brazil Data Cube #' project. #' -#' @description To sign the hrefs with your token you need to store it in an +#' @description +#' These functions provide support to access assets from Brazil Data Cube. +#' +#' \itemize{ +#' \item `items_sign_bdc()`: `r lifecycle::badge('experimental')` +#' A simplified function to sign assets' URL from Brazil Data Cube +#' to be able to access the data. +#' +#' \item `sign_bdc()`: Creates a signing function to be +#' used by `items_sign()`. This function sign all the assets' URL. +#' } +#' +#' To sign the hrefs with your token you need to store it in an #' environment variable in `BDC_ACCESS_KEY`or use `acess_token` parameter. #' +#' @param items a `doc_item` or `doc_items` object +#' representing the result of `/stac/search`, +#' \code{/collections/{collectionId}/items} or +#' \code{/collections/{collectionId}/items/{itemId}} endpoints. +#' #' @param access_token a `character` with the access token parameter to access #' Brazil Data Cube assets. #' @@ -13,6 +30,11 @@ ms_token <- new_env() #' function of the `httr` package. #' #' @return a `function` that signs each item assets. +#' \itemize{ +#' \item `items_sign_bdc()`: items with signed assets URLs. +#' +#' \item `sign_bdc()`: a function to to be passed to `items_sign()`. +#' } #' #' @examples #' \dontrun{ @@ -23,10 +45,25 @@ ms_token <- new_env() #' stac_search() %>% #' get_request() #' -#' # signing each item href -#' stac_obj %>% items_sign(sign_fn = sign_bdc(access_token = "123")) +#' # the new way to authenticate: +#' stac_obj <- stac_obj %>% +#' items_sign_bdc("") +#' +#' # this is the old way of authentication (still works): +#' # stac_obj %>% +#' # items_sign(sign_fn = sign_bdc(access_token = "")) #' } #' +#' @name items_sign_bdc +#' +#' @export +items_sign_bdc <- function(items, access_token = NULL, ...) { + sign_fn <- sign_bdc(access_token) + items_sign(items, sign_fn) +} + +#' @rdname items_sign_bdc +#' #' @export sign_bdc <- function(access_token = NULL, ...) { @@ -98,15 +135,31 @@ sign_bdc <- function(access_token = NULL, ...) { return(sign_item) } -#' @title Signature in hrefs provided by the STAC from Microsoft's Planetary -#' Computer. +#' @title Signs URL to access assets from Microsoft's Planetary Computer. +#' +#' @description +#' These functions provide support to access assets from Planetary Computer. #' -#' @description To perform the signing of the hrefs a request is sent to -#' Planetary Computer servers and the returned content corresponds to the -#' token that will be used in the href. +#' \itemize{ +#' \item `items_sign_planetary_computer()`: `r lifecycle::badge('experimental')` +#' A simplified function to sign assets' URL from Microsoft Planetary +#' Computer to be able to access the data. +#' +#' \item `sign_planetary_computer()`: Creates a signing function to be +#' used by `items_sign()`. This function sign all the assets' URL. +#' } +#' +#' @param items a `doc_item` or `doc_items` object +#' representing the result of `/stac/search`, +#' \code{/collections/{collectionId}/items} or +#' \code{/collections/{collectionId}/items/{itemId}} endpoints. +#' +#' @param subscription_key the `subscription-key` to access restricted +#' assets in Microsoft Planetary Computer. You can keep this parameter +#' empty for non-protected assets. #' #' @param ... additional parameters can be supplied to the `GET` function -#' of the `httr` package. +#' of the `httr` package. #' #' @param headers a named character vector with headers key-value content. #' @@ -115,7 +168,13 @@ sign_bdc <- function(access_token = NULL, ...) { #' By default is used: #' `"https://planetarycomputer.microsoft.com/api/sas/v1/token"` #' -#' @return a `function` that signs each item assets. +#' @return +#' \itemize{ +#' \item `items_sign_planetary_computer()`: items with signed assets URLs. +#' +#' \item `sign_planetary_computer()`: a function to to be passed to +#' `items_sign()`. +#' } #' #' @examples #' \dontrun{ @@ -125,8 +184,13 @@ sign_bdc <- function(access_token = NULL, ...) { #' bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% #' get_request() #' -#' # signing each asset href -#' stac_obj %>% items_sign(sign_fn = sign_planetary_computer()) +#' # the new way to authenticate: +#' stac_obj <- stac_obj %>% +#' items_sign_planetary_computer() +#' +#' # this is the old way of authentication (still works): +#' # stac_obj <- stac_obj %>% +#' # items_sign(sign_fn = sign_planetary_computer()) #' #' # example of access to collections that require authentication #' stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% @@ -135,14 +199,32 @@ sign_bdc <- function(access_token = NULL, ...) { #' datetime = "2019-01-01/2019-01-28") %>% #' post_request() #' -#' # signing each asset href -#' # stac_obj %>% items_sign( -#' # sign_fn = sign_planetary_computer( -#' # headers = c("Ocp-Apim-Subscription-Key" = ) +#' # the new way to authenticate: +#' # stac_obj <- stac_obj %>% +#' # items_sign_planetary_computer("") +#' +#' # this is the old way of authentication (still works): +#' # stac_obj <- stac_obj %>% +#' # items_sign( +#' # sign_fn = sign_planetary_computer( +#' # headers = c("Ocp-Apim-Subscription-Key" = ) +#' # ) #' # ) -#' # ) #' } #' +#' @name items_sign_planetary_computer +#' @export +items_sign_planetary_computer <- function(items, subscription_key = NULL, ...) { + header <- NULL + if (!is.null(subscription_key)) + header <- httr::add_headers( + c("Ocp-Apim-Subscription-Key" = subscription_key) + ) + sign_fn <- sign_planetary_computer(header) + items_sign(items, sign_fn) +} + +#' @rdname items_sign_planetary_computer #' @export sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { # general info diff --git a/man/items_sign_bdc.Rd b/man/items_sign_bdc.Rd new file mode 100644 index 00000000..993c5667 --- /dev/null +++ b/man/items_sign_bdc.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/signatures.R +\name{items_sign_bdc} +\alias{items_sign_bdc} +\alias{sign_bdc} +\title{Signature in hrefs provided by the STAC from the Brazil Data Cube +project.} +\usage{ +items_sign_bdc(items, access_token = NULL, ...) + +sign_bdc(access_token = NULL, ...) +} +\arguments{ +\item{items}{a \code{doc_item} or \code{doc_items} object +representing the result of \verb{/stac/search}, +\code{/collections/{collectionId}/items} or +\code{/collections/{collectionId}/items/{itemId}} endpoints.} + +\item{access_token}{a \code{character} with the access token parameter to access +Brazil Data Cube assets.} + +\item{...}{additional parameters can be supplied to the \code{GET} +function of the \code{httr} package.} +} +\value{ +a \code{function} that signs each item assets. +\itemize{ +\item \code{items_sign_bdc()}: items with signed assets URLs. + +\item \code{sign_bdc()}: a function to to be passed to \code{items_sign()}. +} +} +\description{ +These functions provide support to access assets from Brazil Data Cube. + +\itemize{ +\item \code{items_sign_bdc()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +A simplified function to sign assets' URL from Brazil Data Cube +to be able to access the data. + +\item \code{sign_bdc()}: Creates a signing function to be +used by \code{items_sign()}. This function sign all the assets' URL. +} + +To sign the hrefs with your token you need to store it in an +environment variable in \code{BDC_ACCESS_KEY}or use \code{acess_token} parameter. +} +\examples{ +\dontrun{ + # doc_items object + stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% + stac_search(collections = "CB4-16D-2", + datetime = "2019-06-01/2019-08-01") \%>\% + stac_search() \%>\% + get_request() + + # the new way to authenticate: + stac_obj <- stac_obj \%>\% + items_sign_bdc("") + + # this is the old way of authentication (still works): + # stac_obj \%>\% + # items_sign(sign_fn = sign_bdc(access_token = "")) +} + +} diff --git a/man/items_sign_planetary_computer.Rd b/man/items_sign_planetary_computer.Rd new file mode 100644 index 00000000..2e557cbb --- /dev/null +++ b/man/items_sign_planetary_computer.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/signatures.R +\name{items_sign_planetary_computer} +\alias{items_sign_planetary_computer} +\alias{sign_planetary_computer} +\title{Signs URL to access assets from Microsoft's Planetary Computer.} +\usage{ +items_sign_planetary_computer(items, subscription_key = NULL, ...) + +sign_planetary_computer(..., headers = NULL, token_url = NULL) +} +\arguments{ +\item{items}{a \code{doc_item} or \code{doc_items} object +representing the result of \verb{/stac/search}, +\code{/collections/{collectionId}/items} or +\code{/collections/{collectionId}/items/{itemId}} endpoints.} + +\item{subscription_key}{the \code{subscription-key} to access restricted +assets in Microsoft Planetary Computer. You can keep this parameter +empty for non-protected assets.} + +\item{...}{additional parameters can be supplied to the \code{GET} function +of the \code{httr} package.} + +\item{headers}{a named character vector with headers key-value content.} + +\item{token_url}{a \code{character} with the URL that generates the tokens +in the Microsoft service. +By default is used: +\code{"https://planetarycomputer.microsoft.com/api/sas/v1/token"}} +} +\value{ +\itemize{ +\item \code{items_sign_planetary_computer()}: items with signed assets URLs. + +\item \code{sign_planetary_computer()}: a function to to be passed to +\code{items_sign()}. +} +} +\description{ +These functions provide support to access assets from Planetary Computer. + +\itemize{ +\item \code{items_sign_planetary_computer()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +A simplified function to sign assets' URL from Microsoft Planetary +Computer to be able to access the data. + +\item \code{sign_planetary_computer()}: Creates a signing function to be +used by \code{items_sign()}. This function sign all the assets' URL. +} +} +\examples{ +\dontrun{ + # doc_items object + stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") \%>\% + stac_search(collections = "sentinel-2-l2a", + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) \%>\% + get_request() + + # the new way to authenticate: + stac_obj <- stac_obj \%>\% + items_sign_planetary_computer() + + # this is the old way of authentication (still works): + # stac_obj <- stac_obj \%>\% + # items_sign(sign_fn = sign_planetary_computer()) + + # example of access to collections that require authentication + stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + stac_search(collections = c("sentinel-1-rtc"), + bbox = c(-64.8597, -10.4919, -64.79272527, -10.4473), + datetime = "2019-01-01/2019-01-28") \%>\% + post_request() + + # the new way to authenticate: + # stac_obj <- stac_obj \%>\% + # items_sign_planetary_computer("") + + # this is the old way of authentication (still works): + # stac_obj <- stac_obj \%>\% + # items_sign( + # sign_fn = sign_planetary_computer( + # headers = c("Ocp-Apim-Subscription-Key" = ) + # ) + # ) +} + +} diff --git a/man/sign_bdc.Rd b/man/sign_bdc.Rd deleted file mode 100644 index 5ec133a3..00000000 --- a/man/sign_bdc.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/signatures.R -\name{sign_bdc} -\alias{sign_bdc} -\title{Signature in hrefs provided by the STAC from the Brazil Data Cube -project.} -\usage{ -sign_bdc(access_token = NULL, ...) -} -\arguments{ -\item{access_token}{a \code{character} with the access token parameter to access -Brazil Data Cube assets.} - -\item{...}{additional parameters can be supplied to the \code{GET} -function of the \code{httr} package.} -} -\value{ -a \code{function} that signs each item assets. -} -\description{ -To sign the hrefs with your token you need to store it in an -environment variable in \code{BDC_ACCESS_KEY}or use \code{acess_token} parameter. -} -\examples{ -\dontrun{ - # doc_items object - stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% - stac_search(collections = "CB4-16D-2", - datetime = "2019-06-01/2019-08-01") \%>\% - stac_search() \%>\% - get_request() - - # signing each item href - stac_obj \%>\% items_sign(sign_fn = sign_bdc(access_token = "123")) -} - -} diff --git a/man/sign_planetary_computer.Rd b/man/sign_planetary_computer.Rd deleted file mode 100644 index 700a9d34..00000000 --- a/man/sign_planetary_computer.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/signatures.R -\name{sign_planetary_computer} -\alias{sign_planetary_computer} -\title{Signature in hrefs provided by the STAC from Microsoft's Planetary -Computer.} -\usage{ -sign_planetary_computer(..., headers = NULL, token_url = NULL) -} -\arguments{ -\item{...}{additional parameters can be supplied to the \code{GET} function -of the \code{httr} package.} - -\item{headers}{a named character vector with headers key-value content.} - -\item{token_url}{a \code{character} with the URL that generates the tokens -in the Microsoft service. -By default is used: -\code{"https://planetarycomputer.microsoft.com/api/sas/v1/token"}} -} -\value{ -a \code{function} that signs each item assets. -} -\description{ -To perform the signing of the hrefs a request is sent to -Planetary Computer servers and the returned content corresponds to the -token that will be used in the href. -} -\examples{ -\dontrun{ - # doc_items object - stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") \%>\% - stac_search(collections = "sentinel-2-l2a", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) \%>\% - get_request() - - # signing each asset href - stac_obj \%>\% items_sign(sign_fn = sign_planetary_computer()) - - # example of access to collections that require authentication - stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - stac_search(collections = c("sentinel-1-rtc"), - bbox = c(-64.8597, -10.4919, -64.79272527, -10.4473), - datetime = "2019-01-01/2019-01-28") \%>\% - post_request() - - # signing each asset href - # stac_obj \%>\% items_sign( - # sign_fn = sign_planetary_computer( - # headers = c("Ocp-Apim-Subscription-Key" = ) - # ) - # ) -} - -} From a6ca11f178ab1a13575898822b973cf1eeeabcb5 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 13 Feb 2024 01:54:02 +0100 Subject: [PATCH 20/35] Fix vignettes on CRAN --- vignettes/rstac-01-intro.Rmd | 79 +++++++++++++-------------------- vignettes/rstac-02-cql2.Rmd | 2 + vignettes/rstac-03-cql2-mpc.Rmd | 61 +++++++++---------------- 3 files changed, 55 insertions(+), 87 deletions(-) diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd index 203f78bd..bde8ed16 100644 --- a/vignettes/rstac-01-intro.Rmd +++ b/vignettes/rstac-01-intro.Rmd @@ -16,22 +16,16 @@ vignette: > --- ```{r prepare, include = FALSE} -is_online <- tryCatch({ - res <- httr::GET("https://brazildatacube.dpi.inpe.br/stac/") - !httr::http_error(res) -}, error = function(e) { - FALSE -}) +not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") knitr::opts_chunk$set( collapse = TRUE, - comment = "#>", - eval = is_online + comment = "#>" ) library(tibble) ``` -```{r setup, eval=TRUE, echo=FALSE} +```{r setup, eval=not_on_cran, echo=FALSE} if (!requireNamespace("png")) install.packages("png") library(png) library(rstac) @@ -80,41 +74,41 @@ This tutorial use the STAC API made available by the [Brazil Data Cube (BDC)](ht Let's start by creating a query for the BDC catalog. -```{r queries-1, eval=TRUE} +```{r queries-1, eval=not_on_cran} s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") s_obj ``` The `RSTACQuery` object stores the metadata of the created query. This metadata can be accessed as a list element during query creation. -```{r base-url, eval=TRUE} +```{r base-url, eval=not_on_cran} s_obj$base_url ``` Endpoints are constructed through function concatenations provided by `rstac`. Some examples are shown below: -```{r queries-2, eval=TRUE} +```{r queries-2, eval=not_on_cran} s_obj |> collections() ``` -```{r queries-3, eval=TRUE} +```{r queries-3, eval=not_on_cran} s_obj |> collections("S2-16D-2") ``` -```{r queries-4, eval=TRUE} +```{r queries-4, eval=not_on_cran} s_obj |> collections("S2-16D-2") |> items() ``` -```{r queries-5, eval=TRUE} +```{r queries-5, eval=not_on_cran} s_obj |> collections("S2-16D-2") |> items(feature_id = "S2-16D_V2_015011_20190117") ``` -```{r queries-6, eval=TRUE} +```{r queries-6, eval=not_on_cran} s_obj |> stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> ext_query("bdc:tile" == "007004") @@ -131,7 +125,7 @@ These options are available in the `httr` package documentation in the [`config` ### HTTP GET: `get_request()`{-} -```{r request-1} +```{r request-1, eval=not_on_cran} s_obj |> collections(collection_id = "CB4-16D-2") |> items() |> @@ -140,7 +134,7 @@ s_obj |> ### HTTP POST: `post_request()`{-} -```{r request-2} +```{r request-2, eval=not_on_cran} s_obj |> stac_search( collections = c("CB4-16D-2", "S2-16D-2"), @@ -151,7 +145,7 @@ s_obj |> Example of providing an additional argument to HTTP verb in a request: -```{r request-3} +```{r request-3, eval=not_on_cran} s_obj |> stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> post_request(config = c(httr::add_headers("x-api-key" = "MY-KEY"))) @@ -163,14 +157,14 @@ Each `rstac` object is mapped according to the endpoints of the STAC spec. In th #### `STACCatalog` object{-} -```{r catalog} +```{r catalog, eval=not_on_cran} s_obj |> get_request() ``` #### `STACCollection` object{-} -```{r collection} +```{r collection, eval=not_on_cran} s_obj |> collections("S2-16D-2") |> get_request() @@ -178,7 +172,7 @@ s_obj |> #### `Item` object{-} -```{r item} +```{r item, eval=not_on_cran} s_obj |> collections("CB4-16D-2") |> items(feature_id = "CB4-16D_V2_000002_20230509") |> @@ -187,7 +181,7 @@ s_obj |> #### `Items` object{-} -```{r item-collection} +```{r item-collection, eval=not_on_cran} s_obj |> stac_search(collections = c("CB4_64_16D_STK", "S2-16D-2")) |> get_request() @@ -210,7 +204,7 @@ The `Items` object have some facilitating functions to manipulate/extract inform It is interesting to verify the fields of items before filtering: -```{r fields} +```{r fields, eval=not_on_cran} s_obj |> stac_search( collections = "CB4-16D-2", @@ -222,7 +216,7 @@ s_obj |> Let's filter items that have the percentage of clouds smaller than 10%: -```{r filter} +```{r filter, eval=not_on_cran} s_obj |> stac_search( collections = "CB4-16D-2", @@ -233,7 +227,7 @@ s_obj |> ``` Number of items returned in the query (in this case equal to the limit defined as parameter): -```{r length} +```{r length, eval=not_on_cran} s_obj |> stac_search( collections = "CB4-16D-2", @@ -244,7 +238,7 @@ s_obj |> ``` Number of matched items in the query: -```{r matched} +```{r matched, eval=not_on_cran} s_obj |> stac_search( collections = "CB4-16D-2", @@ -255,7 +249,7 @@ s_obj |> ``` Paginating all items that were matched in the query: -```{r fetch} +```{r fetch, eval=not_on_cran} items_fetched <- s_obj |> stac_search( collections = "CB4-16D-2", @@ -268,13 +262,13 @@ items_fetched ``` Note that all items was fetched: -```{r length-2} +```{r length-2, eval=not_on_cran} items_length(items_fetched) ``` Listing the assets of the retrieved items: -```{r assets} +```{r assets, eval=not_on_cran} items_assets(items_fetched) ``` @@ -292,7 +286,7 @@ For the URL you can add the GDAL library drivers for the following schemes: Listing the assets names of all items: -```{r assets-2} +```{r assets-2, eval=not_on_cran} s_obj |> stac_search( collections = "CB4-16D-2", @@ -304,7 +298,7 @@ s_obj |> Selecting assets that have names `"BAND14"` and `"NDVI"` -```{r assets-select} +```{r assets-select, eval=not_on_cran} selected_assets <- s_obj |> stac_search( collections = "CB4-16D-2", @@ -314,20 +308,20 @@ selected_assets <- s_obj |> assets_select(asset_names = c("BAND14", "NDVI")) ``` -```{r assets-3} +```{r assets-3, eval=not_on_cran} items_assets(selected_assets) ``` Listing asset urls from the selected bands: -```{r assets-url} +```{r assets-url, eval=not_on_cran} selected_assets |> assets_url() ``` Renaming assets using the pattern ` = ` -```{r assets-renamed} +```{r assets-renamed, eval=not_on_cran} renamed_assets <- selected_assets |> assets_rename(BAND14 = "B14") renamed_assets @@ -336,7 +330,7 @@ renamed_assets In the `assets` field of the output it can be seen that the asset's name has changed. It is also possible to check the asset names using the `items_assets()` function. -```{r assets-4} +```{r assets-4, eval=not_on_cran} items_assets(renamed_assets) ``` @@ -345,18 +339,7 @@ items_assets(renamed_assets) `rstac` also provides a helper function to plot preview assets (e.g. thumbnail and quicklook). -```{r asset-preview-check, eval=TRUE, include=FALSE, echo=FALSE} -is_accessible <- is_online && tryCatch({ - res <- httr::HEAD( - assets_url(items_fetched$features[[2]], asset_names = "thumbnail") - ) - !httr::http_error(res) -}, error = function(e) { - FALSE -}) -``` - -```{r plot-preview, eval=is_accessible, fig.height=3, fig.width=5} +```{r plot-preview, eval=not_on_cran, fig.height=3, fig.width=5} second_item <- items_fetched$features[[2]] second_item |> assets_url(asset_names = "thumbnail") |> diff --git a/vignettes/rstac-02-cql2.Rmd b/vignettes/rstac-02-cql2.Rmd index ad803492..7437aa24 100644 --- a/vignettes/rstac-02-cql2.Rmd +++ b/vignettes/rstac-02-cql2.Rmd @@ -16,6 +16,8 @@ vignette: > --- ```{r prepare, include = FALSE} +not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") + knitr::opts_chunk$set( collapse = TRUE, comment = "#>" diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd index af70d9cb..33bfc040 100644 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ b/vignettes/rstac-03-cql2-mpc.Rmd @@ -15,22 +15,16 @@ vignette: > --- ```{r, include = FALSE} -is_online <- tryCatch({ - res <- httr::GET("https://planetarycomputer.microsoft.com/api/stac/v1") - !httr::http_error(res) -}, error = function(e) { - FALSE -}) +not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") knitr::opts_chunk$set( collapse = TRUE, - comment = "#>", - eval = is_online + comment = "#>" ) ``` -```{r load-rstac, eval=TRUE} +```{r load-rstac, eval=not_on_cran} if (!requireNamespace("tmap")) install.packages("tmap") library(tmap) library(rstac) @@ -46,7 +40,7 @@ This tutorial is based on [reading STAC API data in Python](https://planetarycom To access Planetary Computer STAC API, we'll create a `rstac` query. -```{r connection, eval=TRUE} +```{r connection, eval=not_on_cran} planetary_computer <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") planetary_computer ``` @@ -57,7 +51,7 @@ CQL2 expressions can be constructed using properties that refer to attributes of In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queryables and make a `GET` request to the service. -```{r queryables} +```{r queryables, eval=not_on_cran} planetary_computer |> collections("landsat-c2-l2") |> queryables() |> @@ -68,7 +62,7 @@ planetary_computer |> Now we can use `rstac` to make a search query with CQL2 filter extension to obtain the items. -```{r cql2-search} +```{r cql2-search, eval=not_on_cran} time_range <- cql2_interval("2020-12-01", "2020-12-31") bbox <- c(-122.2751, 47.5469, -121.9613, 47.7458) area_of_interest = cql2_bbox_as_geojson(bbox) @@ -86,7 +80,7 @@ In that example, our filter expression used a temporal (`t_intersects`) and a sp `items` is an `Items` object containing 8 items that matched our search criteria. -```{r items-length} +```{r items-length, eval=not_on_cran} stac_items ``` @@ -94,7 +88,7 @@ stac_items An `Items` is a regular GeoJSON object. It is a collection of `Item` entries that stores metadata on assets. Users can convert a `Items` to a `sf` object containing the properties field as columns. Here we depict the items footprint. -```{r geojson-to-sf} +```{r geojson-to-sf, eval=not_on_cran} sf <- items_as_sf(stac_items) # create a function to plot a map @@ -112,7 +106,7 @@ plot_map(sf) Some collections use the `eo` extension, which allows us to sort items by attributes like cloud coverage. The next example selects the item with lowest cloud_cover attribute: -```{r lowest-cloud-cover} +```{r lowest-cloud-cover, eval=not_on_cran} cloud_cover <- stac_items |> items_reap(field = c("properties", "eo:cloud_cover")) selected_item <- stac_items$features[[which.min(cloud_cover)]] @@ -122,7 +116,7 @@ We use function `items_reap()` to extract cloud cover values from all features. Each STAC item have an `assets` field which describes files and provides link to access them. -```{r assets-list} +```{r assets-list, eval=not_on_cran} items_assets(selected_item) purrr::map_dfr(items_assets(selected_item), function(key) { @@ -132,18 +126,7 @@ purrr::map_dfr(items_assets(selected_item), function(key) { Here, we’ll inspect the `rendered_preview` asset. To plot this asset, we can use the helper function `preview_plot()` and provide a URL to be plotted. We use the function `assets_url()` to get the URL. This function extracts all available URLs in items. -```{r asset-preview-check, eval=TRUE, include=FALSE, echo=FALSE} -is_accessible <- is_online && tryCatch({ - res <- httr::HEAD( - assets_url(selected_item, asset_names = "rendered_preview") - ) - !httr::http_error(res) -}, error = function(e) { - FALSE -}) -``` - -```{r asset-preview, eval=is_accessible, fig.height=3, fig.width=5} +```{r asset-preview, eval=not_on_cran, fig.height=3, fig.width=5} selected_item$assets[["rendered_preview"]]$href selected_item |> @@ -157,7 +140,7 @@ The `rendered_preview` asset is generated dynamically by Planetary Computer API To sign URL in `rstac`, we can use `items_sign()` function. -```{r sign-item} +```{r sign-item, eval=not_on_cran} selected_item <- selected_item |> items_sign(sign_fn = sign_planetary_computer()) @@ -168,7 +151,7 @@ selected_item |> Everything after the `?` in that URL is a [SAS token](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) grants access to the data. See https://planetarycomputer.microsoft.com/docs/concepts/sas/ for more on using tokens to access data. -```{r url-check} +```{r url-check, eval=not_on_cran} library(httr) selected_item |> assets_url(asset_names = "blue") |> @@ -182,7 +165,7 @@ The 200 status code means that we were able to access the data using the signed We can load up that single COG file using packages like [stars](https://github.com/r-spatial/stars) or [terra](https://github.com/rspatial/terra). -```{r read-file} +```{r read-file, eval=not_on_cran} library(stars) selected_item |> assets_url(asset_names = "blue", append_gdalvsi = TRUE) |> @@ -198,7 +181,7 @@ In the previous step of this tutorial, we learned how to search for items by spe For instance, collections like `sentinel-2-l2a` and `landsat-c2-l2` both implement the [eo](https://github.com/stac-extensions/eo) STAC extension and include an `eo:cloud_cover` property. To filter your search results to only return items that have a cloud coverage of less than 20%, you can use: -```{r cql2-search-cloud} +```{r cql2-search-cloud, eval=not_on_cran} stac_items <- planetary_computer |> ext_filter( collection %in% c("sentinel-2-l2a", "landsat-c2-l2") && @@ -211,7 +194,7 @@ stac_items <- planetary_computer |> Here we search for `sentinel-2-l2a` and `landsat-c2-l2` assets. As a result, we have images from both collections in our search results. Users can rename the assets to have a common name in both collections. -```{r assets-rename} +```{r assets-rename, eval=not_on_cran} stac_items <- stac_items |> assets_select(asset_names = c("B11", "swir16")) |> assets_rename(B11 = "swir16") @@ -226,7 +209,7 @@ stac_items |> `Item` objects are features of `Items` and store information about assets. -```{r items-fetch} +```{r items-fetch, eval=not_on_cran} stac_items <- planetary_computer |> ext_filter( collection == "sentinel-2-l2a" && @@ -242,7 +225,7 @@ stac_items <- items_fetch(stac_items) We can use the metadata to plot cloud cover of a region over time, for example. -```{r cloud-cover-ts-plot} +```{r cloud-cover-ts-plot, eval=not_on_cran} library(dplyr) library(slider) library(ggplot2) @@ -265,7 +248,7 @@ df |> STAC organizes items in catalogs (`STACCatalog`) and collections (`STACCollection`). These JSON documents contains metadata of the dataset they refer to. For instance, here we look at the [Bands](https://github.com/stac-extensions/eo#band-object) available for [Landsat 8 Collection 2 Level 2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) data: -```{r collection-landsat-bands} +```{r collection-landsat-bands, eval=not_on_cran} landsat <- planetary_computer |> collections(collection_id = "landsat-c2-l2") |> get_request() @@ -276,7 +259,7 @@ purrr::map_dfr(landsat$summaries$`eo:bands`, tibble::as_tibble_row) We can see what [Assets](https://github.com/radiantearth/stac-spec/blob/master/item-spec/item-spec.md#asset-object) are available on our item with: -```{r landsat-assets} +```{r landsat-assets, eval=not_on_cran} purrr::map_dfr(landsat$item_assets, function(x) { tibble::as_tibble_row( purrr::compact(x[c("title", "description", "gsd")]) @@ -286,7 +269,7 @@ purrr::map_dfr(landsat$item_assets, function(x) { Some collections, like [Daymet](https://planetarycomputer.microsoft.com/dataset/daymet-daily-na) include collection-level assets. You can use the `assets` property to access those assets. -```{r collection-daymet} +```{r collection-daymet, eval=not_on_cran} daymet <- planetary_computer |> collections(collection_id = "daymet-daily-na") |> get_request() @@ -296,7 +279,7 @@ daymet Just like assets on items, these assets include links to data in Azure Blob Storage. -```{r daymet-assets} +```{r daymet-assets, eval=not_on_cran} items_assets(daymet) daymet |> From ccf5b9e402b90afc199547148c70f15c9f49cd07 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 13 Feb 2024 01:54:25 +0100 Subject: [PATCH 21/35] Fix tests on CRAN --- tests/testthat.R | 2 +- tests/testthat/test-ext_filter.R | 21 +++++++++++++++++++++ tests/testthat/test-rstac_objs.R | 2 +- 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/tests/testthat.R b/tests/testthat.R index 28b6789a..be8d8c4a 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -2,6 +2,6 @@ library(testthat) library(rstac) library(magrittr) -if (Sys.getenv("RSTAC_TESTS", unset = 0) == 1) { +if (identical(Sys.getenv("NOT_CRAN"), "true")) { test_check("rstac") } diff --git a/tests/testthat/test-ext_filter.R b/tests/testthat/test-ext_filter.R index f35d96b8..cea08fec 100644 --- a/tests/testthat/test-ext_filter.R +++ b/tests/testthat/test-ext_filter.R @@ -6,6 +6,9 @@ conformance_test <- function(q, expected_number) { } test_that("doc_conformance Test 7", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -253,6 +256,9 @@ test_that("doc_conformance Test 7", { }) test_that("doc_conformance Test 12", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -371,6 +377,9 @@ test_that("doc_conformance Test 12", { }) test_that("doc_conformance Test 16", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -458,6 +467,9 @@ test_that("doc_conformance Test 16", { }) test_that("doc_conformance Test 25", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -533,6 +545,9 @@ test_that("doc_conformance Test 25", { }) test_that("doc_conformance Test 34", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( @@ -686,6 +701,9 @@ test_that("doc_conformance Test 34", { }) test_that("doc_conformance Test 38", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") @@ -875,6 +893,9 @@ test_that("doc_conformance Test 38", { }) test_that("doc_conformance Test 45", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index 425b0658..5118ac86 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -368,7 +368,7 @@ testthat::test_that("stac collection object", { testthat::expect_equal( object = stac_type(s_col), - expected = "doc_collections" + expected = "Collections" ) testthat::expect_equal( From 8fd5eb243b406b5a348ef70204ec9fad43098890 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 13 Feb 2024 01:55:20 +0100 Subject: [PATCH 22/35] Update documentation --- R/search-query.R | 4 ++-- man/stac_search.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/search-query.R b/R/search-query.R index 1be4d79b..5c584dd0 100644 --- a/R/search-query.R +++ b/R/search-query.R @@ -58,8 +58,8 @@ #' #' @param intersects a `list` expressing GeoJSON geometries #' objects as specified in RFC 7946. Only returns items that intersect with -#' the provided geometry. To turn a GeoJSON into a list the packages -#' `geojsonsf` or `jsonlite` can be used. +#' the provided geometry. To turn a GeoJSON into a list the package +#' `jsonlite` can be used. #' #' @param limit an `integer` defining the maximum number of results #' to return. If not informed, it defaults to the service implementation. diff --git a/man/stac_search.Rd b/man/stac_search.Rd index 639c5601..3cabf7a7 100644 --- a/man/stac_search.Rd +++ b/man/stac_search.Rd @@ -61,8 +61,8 @@ interval or date-time informed in \code{datetime} are selected.} \item{intersects}{a \code{list} expressing GeoJSON geometries objects as specified in RFC 7946. Only returns items that intersect with -the provided geometry. To turn a GeoJSON into a list the packages -\code{geojsonsf} or \code{jsonlite} can be used.} +the provided geometry. To turn a GeoJSON into a list the package +\code{jsonlite} can be used.} \item{limit}{an \code{integer} defining the maximum number of results to return. If not informed, it defaults to the service implementation.} From 511a71b3fac05e45694ee1a5c4ac740997feb92d Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 13 Feb 2024 23:53:12 +0100 Subject: [PATCH 23/35] Fix dependencies, fix vignettes and README --- .Rbuildignore | 1 + .gitignore | 1 + DESCRIPTION | 30 +++-- NAMESPACE | 16 ++- NEWS.md | 5 +- R/ext_filter.R | 4 +- R/queryables-query.R | 12 +- R/rstac.R | 13 +- README.Rmd | 39 +++--- README.md | 80 ++++++------ man/ext_filter.Rd | 4 +- man/queryables.Rd | 12 +- man/rstac.Rd | 4 +- revdep/.gitignore | 7 ++ revdep/README.md | 32 +++++ revdep/cran.md | 7 ++ revdep/failures.md | 99 +++++++++++++++ revdep/problems.md | 1 + tests/testthat/test-assets_functions.R | 2 +- tests/testthat/test-examples.R | 6 +- tests/testthat/test-ext_filter.R | 14 +-- tests/testthat/test-internals.R | 2 +- tests/testthat/test-items_functions.R | 18 +-- tests/testthat/test-rstac_objs.R | 162 ++++++++++++------------- vignettes/rstac-01-intro.Rmd | 115 +++++++++--------- vignettes/rstac-02-cql2.Rmd | 2 +- vignettes/rstac-03-cql2-mpc.Rmd | 115 +++++++++--------- 27 files changed, 479 insertions(+), 324 deletions(-) create mode 100644 revdep/.gitignore create mode 100644 revdep/README.md create mode 100644 revdep/cran.md create mode 100644 revdep/failures.md create mode 100644 revdep/problems.md diff --git a/.Rbuildignore b/.Rbuildignore index 3bb3d729..7ddf1a05 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -12,3 +12,4 @@ ^doc$ ^Meta$ ^\.github$ +^revdep$ diff --git a/.gitignore b/.gitignore index bbaa6dd3..2476c105 100644 --- a/.gitignore +++ b/.gitignore @@ -42,3 +42,4 @@ docs inst/doc /doc/ /Meta/ +^revdep$ diff --git a/DESCRIPTION b/DESCRIPTION index a3624061..ec1c5e03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,10 +4,10 @@ Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", - role = c("aut")), + role = c("aut", "cre")), person("Felipe", "Carvalho", email = "lipecaso@gmail.com", - role = c("aut", "cre")), + role = c("aut")), person("Brazil Data Cube Team", email = "brazildatacube@inpe.br", role = c("aut")), @@ -26,28 +26,26 @@ RoxygenNote: 7.3.1 Depends: R (>= 3.5) Imports: - httr, - crayon, utils, + httr, jsonlite, - lifecycle, - magrittr, - tibble -Suggests: - testthat, + crayon, sf, - knitr, - rmarkdown, png, jpeg, - dplyr, - purrr, - slider, - leaflet, + grid, + magrittr +Suggests: + lifecycle, + testthat, + knitr, tmap, + leaflet, stars, + slider, ggplot2, - geojsonsf + purrr, + dplyr Collate: 'cql2-expr-funs.R' 'cql2-types.R' diff --git a/NAMESPACE b/NAMESPACE index 79b799f8..540c0421 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -219,16 +219,28 @@ export(stac_search) export(stac_type) export(stac_version) importFrom(crayon,bold) +importFrom(grid,grid.raster) importFrom(httr,GET) importFrom(httr,POST) importFrom(httr,add_headers) +importFrom(httr,build_url) importFrom(httr,content) importFrom(httr,http_type) +importFrom(httr,parse_url) importFrom(httr,status_code) importFrom(httr,write_disk) +importFrom(jpeg,readJPEG) importFrom(jsonlite,fromJSON) -importFrom(lifecycle,deprecated) +importFrom(jsonlite,read_json) importFrom(magrittr,"%>%") -importFrom(tibble,as_tibble) +importFrom(png,readPNG) +importFrom(sf,st_geometry) +importFrom(sf,st_geometry_type) +importFrom(sf,st_intersects) +importFrom(sf,st_sf) +importFrom(sf,st_sfc) +importFrom(sf,st_transform) importFrom(utils,URLdecode) importFrom(utils,modifyList) +importFrom(utils,setTxtProgressBar) +importFrom(utils,txtProgressBar) diff --git a/NEWS.md b/NEWS.md index 609a3cc6..777ec25e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,9 @@ # rstac (development version) -# rstac 1.0.0-beta (Pre-Release) +# rstac 1.0.0 (Released 2024-02-13) -* Add support to static catalogs +* Add support to static catalogs: +`read_stac()` # rstac 0.9.2-4 (Released 2023-06-15) diff --git a/R/ext_filter.R b/R/ext_filter.R index aa32d68f..6c3bac55 100644 --- a/R/ext_filter.R +++ b/R/ext_filter.R @@ -112,8 +112,8 @@ #' \dontrun{ #' # Standard comparison operators in rstac: #' # Creating a stac search query -#' req <- rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::stac_search(limit = 5) +#' req <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' stac_search(limit = 5) #' #' # Equal operator '=' with collection property #' req %>% ext_filter(collection == "sentinel-2-l2a") %>% post_request() diff --git a/R/queryables-query.R b/R/queryables-query.R index c970c108..82a1daf6 100644 --- a/R/queryables-query.R +++ b/R/queryables-query.R @@ -17,14 +17,14 @@ #' @examples #' \dontrun{ #' # Catalog's queryables -#' rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::queryables() %>% rstac::get_request() +#' stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' queryables() %>% get_request() #' #' # Collection's queryables -#' rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::collections(collection_id = "sentinel-2-l2a") %>% -#' rstac::queryables() %>% -#' rstac::get_request() +#' stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' collections(collection_id = "sentinel-2-l2a") %>% +#' queryables() %>% +#' get_request() #' } #' #' @export diff --git a/R/rstac.R b/R/rstac.R index 4f8cfbd4..d0aae7a0 100644 --- a/R/rstac.R +++ b/R/rstac.R @@ -58,11 +58,12 @@ NULL #' @export magrittr::`%>%` -#' @importFrom httr GET POST write_disk add_headers content status_code -#' http_type +#' @importFrom utils txtProgressBar setTxtProgressBar modifyList URLdecode +#' @importFrom httr write_disk http_type content status_code parse_url add_headers build_url GET POST +#' @importFrom jsonlite fromJSON read_json +#' @importFrom sf st_geometry st_geometry_type st_sf st_sfc st_transform st_intersects +#' @importFrom grid grid.raster +#' @importFrom png readPNG +#' @importFrom jpeg readJPEG #' @importFrom crayon bold -#' @importFrom utils modifyList URLdecode -#' @importFrom jsonlite fromJSON -#' @importFrom lifecycle deprecated -#' @importFrom tibble as_tibble NULL diff --git a/README.Rmd b/README.Rmd index a002bd77..7625aaca 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,9 +48,7 @@ install.packages("rstac") To install the development version of `rstac`, run the following commands ```{R install-dev, eval=FALSE} -# load necessary libraries -library(devtools) -install_github("brazil-data-cube/rstac") +remotes::install_github("brazil-data-cube/rstac") ``` Importing `rstac` package: @@ -106,10 +104,10 @@ containing a feature collection). ```{R bdc-items1, echo=TRUE} -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -17.35063, -42.53906, -12.98314), - limit = 100) |> + limit = 100) %>% get_request() it_obj @@ -121,9 +119,9 @@ HTTP requests, allowing the use of tokens from the authorization protocols OAuth an example of how to pass a parameter token on a HTTP request. ```{R bdc-items2, eval=FALSE} -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) |> + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% get_request(add_headers("x-api-key" = "MY-TOKEN")) ``` @@ -137,7 +135,7 @@ In the example below, we get how many items matched the search criteria: ```{R bdc-items3, echo=TRUE} # it_obj variable from the last code example -it_obj |> +it_obj %>% items_matched() ``` @@ -145,7 +143,7 @@ However, if we count how many items there are in `it_obj` variable, we get `10`, meaning that more items could be fetched from the STAC service: ```{R bdc-items4, echo=TRUE} -it_obj |> +it_obj %>% items_length() ``` @@ -153,10 +151,10 @@ it_obj |> ```{R bdc-items5, echo=TRUE} # fetch all items from server # (but don't stored them back in it_obj) -it_obj <- it_obj |> +it_obj <- it_obj %>% items_fetch(progress = FALSE) -it_obj |> +it_obj %>% items_length() ``` @@ -170,7 +168,7 @@ below downloads the `thumbnail` assets (.png files) of `10` items stored in `it_obj` variable. ```{R download, eval=FALSE} -download_items <- it_obj |> +download_items <- it_obj %>% assets_download(assets_name = "thumbnail", items_max = 10) ``` @@ -183,12 +181,12 @@ natural way. For a complete ```{R cql2, echo=TRUE} s_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -it_obj <- s_obj |> +it_obj <- s_obj %>% ext_filter( collection == "sentinel-2-l2a" && `s2:vegetation_percentage` >= 50 && `eo:cloud_cover` <= 10 && `s2:mgrs_tile` == "20LKP" && anyinteracts(datetime, interval("2020-06-01", "2020-09-30")) - ) |> + ) %>% post_request() ``` @@ -229,10 +227,9 @@ based on the STAC API specifications. 1. Make a project [fork](https://docs.github.com/en/github/getting-started-with-github/fork-a-repo). 2. Create a file inside the `R/` directory called `ext_{extension_name}.R`. -3. In the code, you need to specify a subclass name (e.g.`ext_subclass`) for -your extension in [`RSTACQuery`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/documents.R#L33-L40) function constructor, and implement the S3 generics methods: [`get_endpoint`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L87-L90), -[`before_request`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L93-L96), and [`after_response`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L99-L102). Using these S3 generics methods you -can define how parameters must be submitted to the HTTP request and the types -of the returned documents responses. See the implemented [ext_query](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_query.R) -API extension as an example. -4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) on the branch [dev](https://github.com/OldLipe/rstac/tree/dev). +3. In the code, you need to specify a subclass name (e.g.`my_subclass`) for +your extension and use it when calling [`rstac_query()`](https://github.com/brazil-data-cube/rstac/blob/master/R/query-funs.R) function. You also need to implement for your subclass the following S3 generic functions: [`before_request()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), [`after_response()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), and [`parse_params()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R). With these S3 generics methods you +can define how parameters should be submitted to the HTTP request and the types +of the returned documents. See the implemented [ext_filter](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_filter.R) +API extension as an example. +4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) on the most recent [development branch](https://github.com/brazil-data-cube/rstac/). diff --git a/README.md b/README.md index e00e8a95..a3f82682 100644 --- a/README.md +++ b/README.md @@ -44,9 +44,7 @@ To install the development version of `rstac`, run the following commands ``` r -# load necessary libraries -library(devtools) -install_github("brazil-data-cube/rstac") +remotes::install_github("brazil-data-cube/rstac") ``` Importing `rstac` package: @@ -102,26 +100,26 @@ containing a feature collection). ``` r -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -17.35063, -42.53906, -12.98314), - limit = 100) |> + limit = 100) %>% get_request() it_obj #> ###Items -#> - matched feature(s): 1072 -#> - features (100 item(s) / 972 not fetched): -#> - CB4-16D_V2_007004_20231101 -#> - CB4-16D_V2_007006_20231101 -#> - CB4-16D_V2_007005_20231101 -#> - CB4-16D_V2_008004_20231101 -#> - CB4-16D_V2_008006_20231101 -#> - CB4-16D_V2_008005_20231101 -#> - CB4-16D_V2_007004_20231016 -#> - CB4-16D_V2_007005_20231016 -#> - CB4-16D_V2_007006_20231016 -#> - CB4-16D_V2_008004_20231016 +#> - matched feature(s): 1096 +#> - features (100 item(s) / 996 not fetched): +#> - CB4-16D_V2_007004_20240101 +#> - CB4-16D_V2_007005_20240101 +#> - CB4-16D_V2_007006_20240101 +#> - CB4-16D_V2_008004_20240101 +#> - CB4-16D_V2_008006_20240101 +#> - CB4-16D_V2_008005_20240101 +#> - CB4-16D_V2_007004_20231219 +#> - CB4-16D_V2_007006_20231219 +#> - CB4-16D_V2_007005_20231219 +#> - CB4-16D_V2_008004_20231219 #> - ... with 90 more feature(s). #> - assets: #> BAND13, BAND14, BAND15, BAND16, CLEAROB, CMASK, EVI, NDVI, PROVENANCE, thumbnail, TOTALOB @@ -136,9 +134,9 @@ the code below, we present an example of how to pass a parameter token on a HTTP request. ``` r -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) |> + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% get_request(add_headers("x-api-key" = "MY-TOKEN")) ``` @@ -154,9 +152,9 @@ search criteria: ``` r # it_obj variable from the last code example -it_obj |> +it_obj %>% items_matched() -#> [1] 1072 +#> [1] 1096 ``` However, if we count how many items there are in `it_obj` variable, we @@ -164,7 +162,7 @@ get `10`, meaning that more items could be fetched from the STAC service: ``` r -it_obj |> +it_obj %>% items_length() #> [1] 100 ``` @@ -172,12 +170,12 @@ it_obj |> ``` r # fetch all items from server # (but don't stored them back in it_obj) -it_obj <- it_obj |> +it_obj <- it_obj %>% items_fetch(progress = FALSE) -it_obj |> +it_obj %>% items_length() -#> [1] 1072 +#> [1] 1096 ``` ### Download assets @@ -190,7 +188,7 @@ assets. The code below downloads the `thumbnail` assets (.png files) of `10` items stored in `it_obj` variable. ``` r -download_items <- it_obj |> +download_items <- it_obj %>% assets_download(assets_name = "thumbnail", items_max = 10) ``` @@ -203,12 +201,12 @@ easy and natural way. For a complete ``` r s_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -it_obj <- s_obj |> +it_obj <- s_obj %>% ext_filter( collection == "sentinel-2-l2a" && `s2:vegetation_percentage` >= 50 && `eo:cloud_cover` <= 10 && `s2:mgrs_tile` == "20LKP" && anyinteracts(datetime, interval("2020-06-01", "2020-09-30")) - ) |> + ) %>% post_request() ``` @@ -261,19 +259,21 @@ based on the STAC API specifications. [fork](https://docs.github.com/en/github/getting-started-with-github/fork-a-repo). 2. Create a file inside the `R/` directory called `ext_{extension_name}.R`. -3. In the code, you need to specify a subclass name - (e.g.`ext_subclass`) for your extension in - [`RSTACQuery`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/documents.R#L33-L40) - function constructor, and implement the S3 generics methods: - [`get_endpoint`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L87-L90), - [`before_request`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L93-L96), +3. In the code, you need to specify a subclass name (e.g.`my_subclass`) + for your extension and use it when calling + [`rstac_query()`](https://github.com/brazil-data-cube/rstac/blob/master/R/query-funs.R) + function. You also need to implement for your subclass the following + S3 generic functions: + [`before_request()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), + [`after_response()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), and - [`after_response`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L99-L102). - Using these S3 generics methods you can define how parameters must + [`parse_params()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R). + With these S3 generics methods you can define how parameters should be submitted to the HTTP request and the types of the returned - documents responses. See the implemented - [ext_query](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_query.R) - API extension as an example. + documents. See the implemented + [ext_filter](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_filter.R) + API extension as an example. 4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) - on the branch [dev](https://github.com/OldLipe/rstac/tree/dev). + on the most recent [development + branch](https://github.com/brazil-data-cube/rstac/). diff --git a/man/ext_filter.Rd b/man/ext_filter.Rd index 8f0fa024..e57b61d6 100644 --- a/man/ext_filter.Rd +++ b/man/ext_filter.Rd @@ -137,8 +137,8 @@ double quoted properties in R is to use the escape character (\verb{), for examp \dontrun{ # Standard comparison operators in rstac: # Creating a stac search query -req <- rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::stac_search(limit = 5) +req <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + stac_search(limit = 5) # Equal operator '=' with collection property req \%>\% ext_filter(collection == "sentinel-2-l2a") \%>\% post_request() diff --git a/man/queryables.Rd b/man/queryables.Rd index 82ebe633..d861ca08 100644 --- a/man/queryables.Rd +++ b/man/queryables.Rd @@ -22,14 +22,14 @@ or from a collection (\verb{/collections/\{collection_id\}/queryables}). \examples{ \dontrun{ # Catalog's queryables -rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::queryables() \%>\% rstac::get_request() +stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + queryables() \%>\% get_request() # Collection's queryables -rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::collections(collection_id = "sentinel-2-l2a") \%>\% - rstac::queryables() \%>\% - rstac::get_request() +stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + collections(collection_id = "sentinel-2-l2a") \%>\% + queryables() \%>\% + get_request() } } diff --git a/man/rstac.Rd b/man/rstac.Rd index 71076468..292a75e7 100644 --- a/man/rstac.Rd +++ b/man/rstac.Rd @@ -76,11 +76,11 @@ Useful links: } \author{ -\strong{Maintainer}: Felipe Carvalho \email{lipecaso@gmail.com} +\strong{Maintainer}: Rolf Simoes \email{rolfsimoes@gmail.com} Authors: \itemize{ - \item Rolf Simoes \email{rolfsimoes@gmail.com} + \item Felipe Carvalho \email{lipecaso@gmail.com} \item Brazil Data Cube Team \email{brazildatacube@inpe.br} } diff --git a/revdep/.gitignore b/revdep/.gitignore new file mode 100644 index 00000000..111ab324 --- /dev/null +++ b/revdep/.gitignore @@ -0,0 +1,7 @@ +checks +library +checks.noindex +library.noindex +cloud.noindex +data.sqlite +*.html diff --git a/revdep/README.md b/revdep/README.md new file mode 100644 index 00000000..f1ef036b --- /dev/null +++ b/revdep/README.md @@ -0,0 +1,32 @@ +# Platform + +|field |value | +|:--------|:----------------------------------------------------------------------------| +|version |R version 4.3.2 (2023-10-31) | +|os |Ubuntu 22.04.3 LTS | +|system |x86_64, linux-gnu | +|ui |RStudio | +|language |(EN) | +|collate |en_US.UTF-8 | +|ctype |en_US.UTF-8 | +|tz |Europe/Amsterdam | +|date |2024-02-13 | +|rstudio |2023.12.1+402 Ocean Storm (desktop) | +|pandoc |3.1.1 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown) | + +# Dependencies + +|package |old |new |Δ | +|:-------|:-------|:-----|:--| +|rstac |0.9.2-5 |1.0.0 |* | + +# Revdeps + +## Failed to check (3) + +|package |version |error |warning |note | +|:------------------|:-------|:-----|:-------|:----| +|BFS |? | | | | +|mapme.biodiversity |? | | | | +|sits |? | | | | + diff --git a/revdep/cran.md b/revdep/cran.md new file mode 100644 index 00000000..cb582d73 --- /dev/null +++ b/revdep/cran.md @@ -0,0 +1,7 @@ +## revdepcheck results + +We checked 3 reverse dependencies (0 from CRAN + 3 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. + + * We saw 0 new problems + * We failed to check 0 packages + diff --git a/revdep/failures.md b/revdep/failures.md new file mode 100644 index 00000000..5a2304ac --- /dev/null +++ b/revdep/failures.md @@ -0,0 +1,99 @@ +# BFS + +
+ +* Version: +* GitHub: https://github.com/brazil-data-cube/rstac +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` +# mapme.biodiversity + +
+ +* Version: +* GitHub: https://github.com/brazil-data-cube/rstac +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` +# sits + +
+ +* Version: +* GitHub: https://github.com/brazil-data-cube/rstac +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` diff --git a/revdep/problems.md b/revdep/problems.md new file mode 100644 index 00000000..9a207363 --- /dev/null +++ b/revdep/problems.md @@ -0,0 +1 @@ +*Wow, no problems at all. :)* \ No newline at end of file diff --git a/tests/testthat/test-assets_functions.R b/tests/testthat/test-assets_functions.R index 2735bc55..a07f10de 100644 --- a/tests/testthat/test-assets_functions.R +++ b/tests/testthat/test-assets_functions.R @@ -4,7 +4,7 @@ testthat::test_that("assets functions", { # assets_download----------------------------------------------------------- testthat::expect_equal( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", datetime = "2019-09-01/2019-11-01", diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index a9c0be55..68d711d7 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -6,9 +6,9 @@ testthat::test_that("examples rstac", { # test collections - /collections/ testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections() %>% - rstac::get_request(), + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections() %>% + get_request(), class = c("doc_collections", "rstac_doc")) # test collections items - /collections/{collection_id} diff --git a/tests/testthat/test-ext_filter.R b/tests/testthat/test-ext_filter.R index cea08fec..6ad8f81e 100644 --- a/tests/testthat/test-ext_filter.R +++ b/tests/testthat/test-ext_filter.R @@ -9,7 +9,7 @@ test_that("doc_conformance Test 7", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( @@ -259,7 +259,7 @@ test_that("doc_conformance Test 12", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( @@ -380,7 +380,7 @@ test_that("doc_conformance Test 16", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -470,7 +470,7 @@ test_that("doc_conformance Test 25", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( @@ -548,7 +548,7 @@ test_that("doc_conformance Test 34", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( type = "Polygon", @@ -704,7 +704,7 @@ test_that("doc_conformance Test 38", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -896,7 +896,7 @@ test_that("doc_conformance Test 45", { skip_if({ httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) }, "Test server is offline") - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R index 87da4bea..526a2b38 100644 --- a/tests/testthat/test-internals.R +++ b/tests/testthat/test-internals.R @@ -2,7 +2,7 @@ testthat::test_that("internals functions", { # skip cran check test testthat::skip_on_cran() - stac_obj <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") + stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") # check_query object testthat::expect_null( diff --git a/tests/testthat/test-items_functions.R b/tests/testthat/test-items_functions.R index 9fa70fb9..807ff4a1 100644 --- a/tests/testthat/test-items_functions.R +++ b/tests/testthat/test-items_functions.R @@ -2,13 +2,13 @@ testthat::test_that("items functions", { # skip cran check test testthat::skip_on_cran() - res <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 10) %>% get_request() - res_bbox <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_bbox <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 1, @@ -26,7 +26,7 @@ testthat::test_that("items functions", { .Dim = c(1L, 5L, 2L)) ) - res_geo <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_geo <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 1, @@ -34,13 +34,13 @@ testthat::test_that("items functions", { intersects = intersects_geojson) %>% post_request() - res_ext <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_ext <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search(collections = "CB4-16D-2", limit = 10) %>% ext_query("bdc:tile" %in% "007004") %>% post_request() - item_stac <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + item_stac <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% items(feature_id = "CB4-16D_V2_000002_20230509") %>% get_request() @@ -71,7 +71,7 @@ testthat::test_that("items functions", { # ok - stac_collection_list object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", limit = 500) %>% get_request(.) %>% @@ -112,7 +112,7 @@ testthat::test_that("items functions", { # provide wrong object testthat::expect_error( object = items_datetime( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) @@ -127,7 +127,7 @@ testthat::test_that("items functions", { testthat::expect_error( object = items_bbox( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) @@ -143,7 +143,7 @@ testthat::test_that("items functions", { # provide wrong object testthat::expect_error( object = items_assets( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index 5118ac86..0c9e9294 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -17,22 +17,22 @@ testthat::test_that("stac search object", { # Error when creating the stac object by parameter bbox testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-55.16335, -4.26325, -49.31739)) + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-55.16335, -4.26325, -49.31739)) ) # check object class of stac_search testthat::expect_equal( object = class( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = "-48.19039,-16.00871,-41.6341,-11.91345")), + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = "-48.19039,-16.00871,-41.6341,-11.91345")), expected = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12)), class = c("search", "rstac_query") @@ -41,8 +41,8 @@ testthat::test_that("stac search object", { # check object class of stac_search testthat::expect_s3_class( object = before_request( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12))), class = c("search", "rstac_query") @@ -51,24 +51,24 @@ testthat::test_that("stac search object", { # check object class of stac_search testthat::expect_error( object = after_response( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12)), NULL) ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)), class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = 10), + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = 10), class = c("search", "rstac_query") ) @@ -80,29 +80,29 @@ testthat::test_that("stac search object", { testthat::expect_error( object = suppressWarnings( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = "dddd") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = "dddd") ) ) testthat::expect_error( object = suppressWarnings( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = c(1, 2)) + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = c(1, 2)) ) ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(ids = c(1, 2)), + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(ids = c(1, 2)), class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(intersects = paste0( + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(intersects = paste0( "{\"type\":\"Polygon\",\"coordinates\":[[[-48.19039,-16.00871],", "[-41.6341,-16.00871],[-41.6341,-11.91345],[-48.19039,-11.91345],", "[-48.19039,-16.00871]]]}")), @@ -111,16 +111,16 @@ testthat::test_that("stac search object", { # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(collections = "ssss", ids = "aaa,bbb,ccc"), + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(collections = "ssss", ids = "aaa,bbb,ccc"), class = c("search", "rstac_query") ) # check GET request from stac_search object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) %>% get_request()), expected = "doc_items" @@ -128,15 +128,15 @@ testthat::test_that("stac search object", { # check for invalid stac endpoint testthat::expect_error( - object = rstac::stac("https://brazildataddddde.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildataddddde.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) %>% get_request() ) testthat::expect_error( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(intersects = "aaa") + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(intersects = "aaa") ) # Check extensions --------------------------------------------------------- @@ -145,7 +145,7 @@ testthat::test_that("stac search object", { testthat::expect_error( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% ext_query("bdc:tile" == "007004") %>% - rstac::stac_search(datetime = "2018-01-01/..") + stac_search(datetime = "2018-01-01/..") ) # check extension query - wrong query @@ -173,8 +173,8 @@ testthat::test_that("stac search object", { ) s_search <- - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search() + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search() # Check each operation in query extension ---------------------------------- @@ -261,16 +261,16 @@ testthat::test_that("stac search object", { # check object testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), regexp = "###Items" ) testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), regexp = "###Items" ) @@ -278,27 +278,27 @@ testthat::test_that("stac search object", { # Check errors in fixed date time------------------------------------------- # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-02-2012T00:00:00Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-02-2012T00:00:00Z") ) # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-2012-20T00:00:00Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-2012-20T00:00:00Z") ) # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-02-2012") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-02-2012") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2019-02-12T00:00:00Z")), + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2019-02-12T00:00:00Z")), expected = c("search") ) @@ -306,16 +306,16 @@ testthat::test_that("stac search object", { # check closed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search( + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search( datetime = "2019-02-12T00:00:00Z/2018-03-18T12:31:12Z") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search( + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search( datetime = "2018-02-12T00:00:00Z/2018-03-18T12:31:12Z")), expected = c("search") ) @@ -324,33 +324,33 @@ testthat::test_that("stac search object", { # check interval date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "./2018-03-18T12:31:12Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "./2018-03-18T12:31:12Z") ) # check interval date time - wrong pattern testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "../1008-03-2018T12:31:12Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "../1008-03-2018T12:31:12Z") ) # check interval date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::search(datetime = "2018-03-18T12:31:12Z/.") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + search(datetime = "2018-03-18T12:31:12Z/.") ) # check interval date time - wrong pattern testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-03-2018T12:31:12Z/..") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-03-2018T12:31:12Z/..") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-03-20T12:31:12Z/..")), + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-03-20T12:31:12Z/..")), expected = c("search") ) }) @@ -362,8 +362,8 @@ testthat::test_that("stac collection object", { # stac_collections---------------------------------------------------------- # check object class of stac collections - s_col <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections() %>% + s_col <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections() %>% get_request() testthat::expect_equal( @@ -386,8 +386,8 @@ testthat::test_that("stac collection object", { # check print stac object testthat::expect_output( - object = print(rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections()), + object = print(stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections()), regexp = "###rstac_query" ) @@ -398,8 +398,8 @@ testthat::test_that("stac collection object", { # check object class of stac collections s_colid <- - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections(collection_id = "CB4-16D-2") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections(collection_id = "CB4-16D-2") testthat::expect_null( object = s_colid$endpoint @@ -428,7 +428,7 @@ testthat::test_that("stac object", { # skip cran check test testthat::skip_on_cran() - stac_catalog <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_catalog <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request() testthat::expect_equal( @@ -439,14 +439,14 @@ testthat::test_that("stac object", { # check object class of stac testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/")), + stac("https://brazildatacube.dpi.inpe.br/stac/")), expected = "stac" ) # check request from stac object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request()), expected = "doc_catalog" ) @@ -454,7 +454,7 @@ testthat::test_that("stac object", { # check print stac_collection object testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac") %>% + stac("https://brazildatacube.dpi.inpe.br/stac") %>% get_request()), regexp = "###Catalog" ) @@ -466,13 +466,13 @@ testthat::test_that("stac item object", { # not provide collection id testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) ) # wrong date testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), datetime = "2018-02-01/.", @@ -481,7 +481,7 @@ testthat::test_that("stac item object", { # wrong bbox testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), datetime = "2018-02-01/..", @@ -491,7 +491,7 @@ testthat::test_that("stac item object", { # stac_collection_list object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/", + stac("https://brazildatacube.dpi.inpe.br/stac/", force_version = "0.9.0") %>% collections("CB4_64-1") %>% items( @@ -504,7 +504,7 @@ testthat::test_that("stac item object", { # stac_item object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4_64-1") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -517,7 +517,7 @@ testthat::test_that("stac item object", { # stac_item object testthat::expect_equal( object = stac_version( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4_64-1") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -527,7 +527,7 @@ testthat::test_that("stac item object", { expected = "0.9.0" ) - stac_item <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4-16D-2") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -553,20 +553,20 @@ testthat::test_that("queryables object", { testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), expected = c("queryables") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), expected = c("queryables") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("sentinel") %>% queryables()), expected = c("queryables") @@ -608,14 +608,14 @@ testthat::test_that("conformance object", { testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), expected = c("conformance") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), expected = c("conformance") ) diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd index bde8ed16..ca6d64c2 100644 --- a/vignettes/rstac-01-intro.Rmd +++ b/vignettes/rstac-01-intro.Rmd @@ -15,20 +15,18 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r prepare, include = FALSE} +```{r prepare, include=FALSE} not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) -library(tibble) -``` -```{r setup, eval=not_on_cran, echo=FALSE} if (!requireNamespace("png")) install.packages("png") -library(png) library(rstac) +library(png) + ``` # About rstac{-} @@ -40,7 +38,6 @@ the STAC API endpoints. For each endpoint, `rstac` has a specialized implementat ```{R endpoints, eval=TRUE, echo=FALSE} - data.frame( "**STAC** endpoints" = c( "`/`", "`/stac`","`/collections`", "`/collections/{collectionId}`", @@ -72,13 +69,17 @@ install.packages("rstac") This tutorial use the STAC API made available by the [Brazil Data Cube (BDC)](http://www.brazildatacube.org/en/home-page-2/) project. BDC is a research, development, and technological innovation project of the National Institute for Space Research (INPE), Brazil. -Let's start by creating a query for the BDC catalog. +Let's start by loading `rstac` and creating a query for the BDC catalog. + +```{r setup, eval=FALSE} +library(rstac) +``` ```{r queries-1, eval=not_on_cran} s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") s_obj ``` -The `RSTACQuery` object stores the metadata of the created query. +The `rstac_query` object stores the metadata of the created query. This metadata can be accessed as a list element during query creation. ```{r base-url, eval=not_on_cran} @@ -87,30 +88,30 @@ s_obj$base_url Endpoints are constructed through function concatenations provided by `rstac`. Some examples are shown below: ```{r queries-2, eval=not_on_cran} -s_obj |> +s_obj %>% collections() ``` ```{r queries-3, eval=not_on_cran} -s_obj |> +s_obj %>% collections("S2-16D-2") ``` ```{r queries-4, eval=not_on_cran} -s_obj |> - collections("S2-16D-2") |> +s_obj %>% + collections("S2-16D-2") %>% items() ``` ```{r queries-5, eval=not_on_cran} -s_obj |> - collections("S2-16D-2") |> +s_obj %>% + collections("S2-16D-2") %>% items(feature_id = "S2-16D_V2_015011_20190117") ``` ```{r queries-6, eval=not_on_cran} -s_obj |> - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> +s_obj %>% + stac_search(collections = c("CB4-16D-2", "S2-16D-2")) %>% ext_query("bdc:tile" == "007004") ``` @@ -126,28 +127,28 @@ These options are available in the `httr` package documentation in the [`config` ### HTTP GET: `get_request()`{-} ```{r request-1, eval=not_on_cran} -s_obj |> - collections(collection_id = "CB4-16D-2") |> - items() |> +s_obj %>% + collections(collection_id = "CB4-16D-2") %>% + items() %>% get_request() ``` ### HTTP POST: `post_request()`{-} ```{r request-2, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = c("CB4-16D-2", "S2-16D-2"), datetime = "2021-01-01/2021-01-31", - limit = 400) |> + limit = 400) %>% post_request() ``` Example of providing an additional argument to HTTP verb in a request: ```{r request-3, eval=not_on_cran} -s_obj |> - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> +s_obj %>% + stac_search(collections = c("CB4-16D-2", "S2-16D-2")) %>% post_request(config = c(httr::add_headers("x-api-key" = "MY-KEY"))) ``` @@ -158,32 +159,32 @@ Each `rstac` object is mapped according to the endpoints of the STAC spec. In th #### `STACCatalog` object{-} ```{r catalog, eval=not_on_cran} -s_obj |> +s_obj %>% get_request() ``` #### `STACCollection` object{-} ```{r collection, eval=not_on_cran} -s_obj |> - collections("S2-16D-2") |> +s_obj %>% + collections("S2-16D-2") %>% get_request() ``` #### `Item` object{-} ```{r item, eval=not_on_cran} -s_obj |> - collections("CB4-16D-2") |> - items(feature_id = "CB4-16D_V2_000002_20230509") |> +s_obj %>% + collections("CB4-16D-2") %>% + items(feature_id = "CB4-16D_V2_000002_20230509") %>% get_request() ``` #### `Items` object{-} ```{r item-collection, eval=not_on_cran} -s_obj |> - stac_search(collections = c("CB4_64_16D_STK", "S2-16D-2")) |> +s_obj %>% + stac_search(collections = c("CB4_64_16D_STK", "S2-16D-2")) %>% get_request() ``` @@ -205,57 +206,57 @@ The `Items` object have some facilitating functions to manipulate/extract inform It is interesting to verify the fields of items before filtering: ```{r fields, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> + limit = 100) %>% + post_request() %>% items_fields(field = "properties") ``` Let's filter items that have the percentage of clouds smaller than 10%: ```{r filter, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> + limit = 100) %>% + post_request() %>% items_filter(properties$`eo:cloud_cover` < 10) ``` Number of items returned in the query (in this case equal to the limit defined as parameter): ```{r length, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> + limit = 100) %>% + post_request() %>% items_length() ``` Number of matched items in the query: ```{r matched, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> + limit = 100) %>% + post_request() %>% items_matched() ``` Paginating all items that were matched in the query: ```{r fetch, eval=not_on_cran} -items_fetched <- s_obj |> +items_fetched <- s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 500) |> - post_request() |> + limit = 500) %>% + post_request() %>% items_fetch(progress = FALSE) items_fetched @@ -287,24 +288,24 @@ For the URL you can add the GDAL library drivers for the following schemes: Listing the assets names of all items: ```{r assets-2, eval=not_on_cran} -s_obj |> +s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 10) |> - post_request() |> + limit = 10) %>% + post_request() %>% items_assets() ``` Selecting assets that have names `"BAND14"` and `"NDVI"` ```{r assets-select, eval=not_on_cran} -selected_assets <- s_obj |> +selected_assets <- s_obj %>% stac_search( collections = "CB4-16D-2", datetime = "2019-01-01/2019-12-31", - limit = 10) |> - post_request() |> + limit = 10) %>% + post_request() %>% assets_select(asset_names = c("BAND14", "NDVI")) ``` @@ -315,14 +316,14 @@ items_assets(selected_assets) Listing asset urls from the selected bands: ```{r assets-url, eval=not_on_cran} -selected_assets |> +selected_assets %>% assets_url() ``` Renaming assets using the pattern ` = ` ```{r assets-renamed, eval=not_on_cran} -renamed_assets <- selected_assets |> +renamed_assets <- selected_assets %>% assets_rename(BAND14 = "B14") renamed_assets ``` @@ -341,8 +342,8 @@ items_assets(renamed_assets) ```{r plot-preview, eval=not_on_cran, fig.height=3, fig.width=5} second_item <- items_fetched$features[[2]] -second_item |> - assets_url(asset_names = "thumbnail") |> +second_item %>% + assets_url(asset_names = "thumbnail") %>% preview_plot() ``` @@ -350,4 +351,4 @@ Here, we selected the second item of `items_fetched`'s features and plotted its # Conclusion{-} -The `rstac` package can be useful for querying and working with satellite imagery data from STAC APIs. It offers a simple interface for searching STAC items, exploring the results, and working with assets. Additional functionalities include reading and plotting preview images. This tutorial has provided a short introduction on how to use the package. For more about CQL2 in `rstac`, type the command `?ext_filter`. +The `rstac` package can be useful for querying and working with satellite imagery data from STAC APIs. It offers a simple interface for searching STAC items, exploring the results, and working with assets. Additional functions include reading and plotting preview images. This tutorial has provided a short introduction on how to use the package. For more about CQL2 in `rstac`, type the command `?ext_filter`. diff --git a/vignettes/rstac-02-cql2.Rmd b/vignettes/rstac-02-cql2.Rmd index 7437aa24..ebdbcaf3 100644 --- a/vignettes/rstac-02-cql2.Rmd +++ b/vignettes/rstac-02-cql2.Rmd @@ -58,7 +58,7 @@ Note how properties `vehicle_height` and `bridge_clearance` are represented in t In the R language, the JSON above could be represented by nested lists, which would be somewhat cumbersome to write. To produce valid CQL2 filter expressions, we use the R abstract syntax tree (AST) from R expressions that can be converted to TEXT or JSON formats. Let us see the same previous example written in R CQL2: -```{r setup} +```{r setup, message=FALSE, warning=FALSE} library(rstac) ``` diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd index 33bfc040..0b5aa751 100644 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ b/vignettes/rstac-03-cql2-mpc.Rmd @@ -24,10 +24,16 @@ knitr::opts_chunk$set( ``` -```{r load-rstac, eval=not_on_cran} -if (!requireNamespace("tmap")) install.packages("tmap") -library(tmap) +```{r load-rstac, eval=not_on_cran, message=FALSE, warning=FALSE} library(rstac) +library(tmap) +library(leaflet) +library(stars) +library(slider) +library(ggplot2) +library(purrr) +library(dplyr) +library(httr) ``` # Introduction{-} @@ -52,9 +58,9 @@ CQL2 expressions can be constructed using properties that refer to attributes of In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queryables and make a `GET` request to the service. ```{r queryables, eval=not_on_cran} -planetary_computer |> - collections("landsat-c2-l2") |> - queryables() |> +planetary_computer %>% + collections("landsat-c2-l2") %>% + queryables() %>% get_request() ``` @@ -67,12 +73,12 @@ time_range <- cql2_interval("2020-12-01", "2020-12-31") bbox <- c(-122.2751, 47.5469, -121.9613, 47.7458) area_of_interest = cql2_bbox_as_geojson(bbox) -stac_items <- planetary_computer |> +stac_items <- planetary_computer %>% ext_filter( collection == "landsat-c2-l2" && t_intersects(datetime, {{time_range}}) && s_intersects(geometry, {{area_of_interest}}) - ) |> + ) %>% post_request() ``` @@ -93,9 +99,7 @@ sf <- items_as_sf(stac_items) # create a function to plot a map plot_map <- function(x) { - library(tmap) - library(leaflet) - current.mode <- tmap_mode("view") + tmap_mode("view") tm_basemap(providers[["Stamen.Watercolor"]]) + tm_shape(x) + tm_borders() @@ -107,7 +111,7 @@ plot_map(sf) Some collections use the `eo` extension, which allows us to sort items by attributes like cloud coverage. The next example selects the item with lowest cloud_cover attribute: ```{r lowest-cloud-cover, eval=not_on_cran} -cloud_cover <- stac_items |> +cloud_cover <- stac_items %>% items_reap(field = c("properties", "eo:cloud_cover")) selected_item <- stac_items$features[[which.min(cloud_cover)]] ``` @@ -119,8 +123,8 @@ Each STAC item have an `assets` field which describes files and provides link to ```{r assets-list, eval=not_on_cran} items_assets(selected_item) -purrr::map_dfr(items_assets(selected_item), function(key) { - tibble::tibble(asset = key, description = selected_item$assets[[key]]$title) +map_dfr(items_assets(selected_item), function(key) { + tibble(asset = key, description = selected_item$assets[[key]]$title) }) ``` @@ -129,8 +133,8 @@ Here, we’ll inspect the `rendered_preview` asset. To plot this asset, we can u ```{r asset-preview, eval=not_on_cran, fig.height=3, fig.width=5} selected_item$assets[["rendered_preview"]]$href -selected_item |> - assets_url(asset_names = "rendered_preview") |> +selected_item %>% + assets_url(asset_names = "rendered_preview") %>% preview_plot() ``` @@ -141,22 +145,21 @@ The `rendered_preview` asset is generated dynamically by Planetary Computer API To sign URL in `rstac`, we can use `items_sign()` function. ```{r sign-item, eval=not_on_cran} -selected_item <- selected_item |> +selected_item <- selected_item %>% items_sign(sign_fn = sign_planetary_computer()) -selected_item |> - assets_url(asset_names = "blue") |> +selected_item %>% + assets_url(asset_names = "blue") %>% substr(1, 255) ``` Everything after the `?` in that URL is a [SAS token](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) grants access to the data. See https://planetarycomputer.microsoft.com/docs/concepts/sas/ for more on using tokens to access data. ```{r url-check, eval=not_on_cran} -library(httr) -selected_item |> - assets_url(asset_names = "blue") |> - httr::HEAD() |> - httr::status_code() +selected_item %>% + assets_url(asset_names = "blue") %>% + HEAD() %>% + status_code() ``` The 200 status code means that we were able to access the data using the signed URL with the SAS token included. @@ -166,10 +169,9 @@ The 200 status code means that we were able to access the data using the signed We can load up that single COG file using packages like [stars](https://github.com/r-spatial/stars) or [terra](https://github.com/rspatial/terra). ```{r read-file, eval=not_on_cran} -library(stars) -selected_item |> - assets_url(asset_names = "blue", append_gdalvsi = TRUE) |> - stars::read_stars(RasterIO = list(nBufXSize = 512, nBufYSize = 512)) |> +selected_item %>% + assets_url(asset_names = "blue", append_gdalvsi = TRUE) %>% + read_stars(RasterIO = list(nBufXSize = 512, nBufYSize = 512)) %>% plot(main = "blue") ``` @@ -182,24 +184,24 @@ In the previous step of this tutorial, we learned how to search for items by spe For instance, collections like `sentinel-2-l2a` and `landsat-c2-l2` both implement the [eo](https://github.com/stac-extensions/eo) STAC extension and include an `eo:cloud_cover` property. To filter your search results to only return items that have a cloud coverage of less than 20%, you can use: ```{r cql2-search-cloud, eval=not_on_cran} -stac_items <- planetary_computer |> +stac_items <- planetary_computer %>% ext_filter( collection %in% c("sentinel-2-l2a", "landsat-c2-l2") && t_intersects(datetime, {{time_range}}) && s_intersects(geometry, {{area_of_interest}}) && `eo:cloud_cover` < 20 - ) |> + ) %>% post_request() ``` Here we search for `sentinel-2-l2a` and `landsat-c2-l2` assets. As a result, we have images from both collections in our search results. Users can rename the assets to have a common name in both collections. ```{r assets-rename, eval=not_on_cran} -stac_items <- stac_items |> - assets_select(asset_names = c("B11", "swir16")) |> +stac_items <- stac_items %>% + assets_select(asset_names = c("B11", "swir16")) %>% assets_rename(B11 = "swir16") -stac_items |> +stac_items %>% items_assets() ``` @@ -210,14 +212,14 @@ stac_items |> `Item` objects are features of `Items` and store information about assets. ```{r items-fetch, eval=not_on_cran} -stac_items <- planetary_computer |> +stac_items <- planetary_computer %>% ext_filter( collection == "sentinel-2-l2a" && t_intersects(datetime, interval("2020-01-01", "2020-12-31")) && s_intersects(geometry, {{ cql2_bbox_as_geojson(c(-124.2751, 45.5469, -123.9613, 45.7458)) }}) - ) |> + ) %>% post_request() stac_items <- items_fetch(stac_items) @@ -226,19 +228,15 @@ stac_items <- items_fetch(stac_items) We can use the metadata to plot cloud cover of a region over time, for example. ```{r cloud-cover-ts-plot, eval=not_on_cran} -library(dplyr) -library(slider) -library(ggplot2) - -df <- items_as_sf(stac_items) |> - dplyr::mutate(datetime = as.Date(datetime)) |> - dplyr::group_by(datetime) |> - dplyr::summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) |> - dplyr::mutate(`eo:cloud_cover` = slider::slide_mean(`eo:cloud_cover`, before = 3, after = 3)) - -df |> - ggplot2::ggplot() + - ggplot2::geom_line(ggplot2::aes(x = datetime, y = `eo:cloud_cover`)) +df <- items_as_sf(stac_items) %>% + mutate(datetime = as.Date(datetime)) %>% + group_by(datetime) %>% + summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) %>% + mutate(`eo:cloud_cover` = slide_mean(`eo:cloud_cover`, before = 3, after = 3)) + +df %>% + ggplot() + + geom_line(aes(x = datetime, y = `eo:cloud_cover`)) ``` `cql2_bbox_as_geojson()` is a `rstac` helper function and it must be evaluated before the request. This is why we embraced it with `{{`. We use `items_fetch()` to retrieve all paginated items matched in the search. @@ -249,20 +247,19 @@ df |> STAC organizes items in catalogs (`STACCatalog`) and collections (`STACCollection`). These JSON documents contains metadata of the dataset they refer to. For instance, here we look at the [Bands](https://github.com/stac-extensions/eo#band-object) available for [Landsat 8 Collection 2 Level 2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) data: ```{r collection-landsat-bands, eval=not_on_cran} -landsat <- planetary_computer |> - collections(collection_id = "landsat-c2-l2") |> +landsat <- planetary_computer %>% + collections(collection_id = "landsat-c2-l2") %>% get_request() -library(purrr) -purrr::map_dfr(landsat$summaries$`eo:bands`, tibble::as_tibble_row) +map_dfr(landsat$summaries$`eo:bands`, as_tibble) ``` We can see what [Assets](https://github.com/radiantearth/stac-spec/blob/master/item-spec/item-spec.md#asset-object) are available on our item with: ```{r landsat-assets, eval=not_on_cran} -purrr::map_dfr(landsat$item_assets, function(x) { - tibble::as_tibble_row( - purrr::compact(x[c("title", "description", "gsd")]) +map_dfr(landsat$item_assets, function(x) { + as_tibble( + compact(x[c("title", "description", "gsd")]) ) }) ``` @@ -270,8 +267,8 @@ purrr::map_dfr(landsat$item_assets, function(x) { Some collections, like [Daymet](https://planetarycomputer.microsoft.com/dataset/daymet-daily-na) include collection-level assets. You can use the `assets` property to access those assets. ```{r collection-daymet, eval=not_on_cran} -daymet <- planetary_computer |> - collections(collection_id = "daymet-daily-na") |> +daymet <- planetary_computer %>% + collections(collection_id = "daymet-daily-na") %>% get_request() daymet @@ -282,8 +279,8 @@ Just like assets on items, these assets include links to data in Azure Blob Stor ```{r daymet-assets, eval=not_on_cran} items_assets(daymet) -daymet |> - assets_select(asset_names = "zarr-abfs") |> +daymet %>% + assets_select(asset_names = "zarr-abfs") %>% assets_url() ``` From e0cb2eeb894ec613c3aa9d4b526b92ee8d531465 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 00:00:23 +0100 Subject: [PATCH 24/35] Update NEWS.md --- NEWS.md | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 777ec25e..d2e5ae4a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,16 @@ # rstac (development version) -# rstac 1.0.0 (Released 2024-02-13) - -* Add support to static catalogs: -`read_stac()` +# rstac 1.0.0 (Released 2024-02-14) + +* Add support to static catalogs; +* `read_stac()`: read any STAC document from an URL (e.g. Catalog, Collection, Items, or Item); +* `links()`: extract and filter links from a STAC document; +* `link_open()`: open the document referenced by the provided link; +* `read_items()`: read items listed in links section of the provided Collection document; +* `read_collections()`: read collections listed in links section of the provided Catalog document; +* Provide new functions to facilitate work with items; +* `items_as_sf()` / `items_as_sfc()`: convert items into sf objects +* `items_intersects()`: is a helper function to test what items intersect some given geometry. # rstac 0.9.2-4 (Released 2023-06-15) From 9304ad2584a5f159f521a7e47aecf25d7332d440 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 00:02:49 +0100 Subject: [PATCH 25/35] Fix maintainer --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ec1c5e03..bae696ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,10 +4,10 @@ Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", - role = c("aut", "cre")), + role = c("aut")), person("Felipe", "Carvalho", email = "lipecaso@gmail.com", - role = c("aut")), + role = c("aut", "cre")), person("Brazil Data Cube Team", email = "brazildatacube@inpe.br", role = c("aut")), From 416294d35b01c93c1634128b50f6a326f340fecf Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 00:17:00 +0100 Subject: [PATCH 26/35] Remove vignettes from dev branch. Added it into vignettes branch --- DESCRIPTION | 4 +- vignettes/.gitignore | 2 - vignettes/rstac-01-intro.Rmd | 354 -------------------------------- vignettes/rstac-02-cql2.Rmd | 234 --------------------- vignettes/rstac-03-cql2-mpc.Rmd | 290 -------------------------- 5 files changed, 2 insertions(+), 882 deletions(-) delete mode 100644 vignettes/.gitignore delete mode 100644 vignettes/rstac-01-intro.Rmd delete mode 100644 vignettes/rstac-02-cql2.Rmd delete mode 100644 vignettes/rstac-03-cql2-mpc.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index bae696ae..ec1c5e03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,10 +4,10 @@ Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", - role = c("aut")), + role = c("aut", "cre")), person("Felipe", "Carvalho", email = "lipecaso@gmail.com", - role = c("aut", "cre")), + role = c("aut")), person("Brazil Data Cube Team", email = "brazildatacube@inpe.br", role = c("aut")), diff --git a/vignettes/.gitignore b/vignettes/.gitignore deleted file mode 100644 index 097b2416..00000000 --- a/vignettes/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.html -*.R diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd deleted file mode 100644 index ca6d64c2..00000000 --- a/vignettes/rstac-01-intro.Rmd +++ /dev/null @@ -1,354 +0,0 @@ ---- -title: "Introduction to rstac package" -author: "Rolf Simoes, Felipe Carvalho, and Gilberto Camara" -date: "2023-01-09" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{Introduction to rstac package} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r prepare, include=FALSE} -not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") - -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) - -if (!requireNamespace("png")) install.packages("png") -library(rstac) -library(png) - -``` - -# About rstac{-} - -This document will introduce the concepts of the `rstac` package. `rstac` is an R client library for STAC that fully supports STAC API v1.0.0 and its earlier versions (>= v0.8.0). - -The table shows the functions implemented by the `rstac` package according to -the STAC API endpoints. For each endpoint, `rstac` has a specialized implementation. - - -```{R endpoints, eval=TRUE, echo=FALSE} -data.frame( - "**STAC** endpoints" = c( - "`/`", "`/stac`","`/collections`", "`/collections/{collectionId}`", - "`/collections/{collectionId}/items`", "`/collections/{collectionId}/items/{itemId}`", "`/search`", "`/stac/search`", - "`/conformance`", "`/collections/{collectionId}/queryables`" - ), "`rstac` functions" = c( - "`stac()`", "`stac()`", "`collections()`", "`collections(collection_id)`", - "`items()`", "`items(feature_id)`", "`stac_search()`", "`stac_search()`", - "`conformance()`", "`queryables()`" - ), "API version" = c( - ">= 0.9.0", "< 0.9.0", ">= 0.9.0", ">= 0.9.0", ">= 0.9.0", ">= 0.9.0", - ">= 0.9.0", "< 0.9.0", ">= 0.9.0", ">= 1.0.0" - ), - check.names = FALSE -) %>% knitr::kable(format = "markdown") -``` - -The `rstac` package makes the requests explicitly. The `rstac` pipeline creates the endpoints with function concatenations and then requests them. - -## Getting started{-} - -Let's start by installing the `rstac` package: - -```{r installing, eval=FALSE} -install.packages("rstac") -``` - -## Creating queries{-} - -This tutorial use the STAC API made available by the [Brazil Data Cube (BDC)](http://www.brazildatacube.org/en/home-page-2/) project. BDC is a research, development, and technological innovation project of the National Institute for Space Research (INPE), Brazil. - -Let's start by loading `rstac` and creating a query for the BDC catalog. - -```{r setup, eval=FALSE} -library(rstac) -``` - -```{r queries-1, eval=not_on_cran} -s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") -s_obj -``` -The `rstac_query` object stores the metadata of the created query. -This metadata can be accessed as a list element during query creation. - -```{r base-url, eval=not_on_cran} -s_obj$base_url -``` -Endpoints are constructed through function concatenations provided by `rstac`. Some examples are shown below: - -```{r queries-2, eval=not_on_cran} -s_obj %>% - collections() -``` - -```{r queries-3, eval=not_on_cran} -s_obj %>% - collections("S2-16D-2") -``` - -```{r queries-4, eval=not_on_cran} -s_obj %>% - collections("S2-16D-2") %>% - items() -``` - -```{r queries-5, eval=not_on_cran} -s_obj %>% - collections("S2-16D-2") %>% - items(feature_id = "S2-16D_V2_015011_20190117") -``` - -```{r queries-6, eval=not_on_cran} -s_obj %>% - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) %>% - ext_query("bdc:tile" == "007004") -``` - -## Making requests{-} - -`rstac` package supports **GET** and **POST** HTTP -methods. With future updates to the STAC specifications, it is intended to -support other methods such as **PUT** and **DELETE**. -In addition, it is possible to add more configuration options to the request, -such as headers (`httr::add_headers()`) and cookies (`httr::set_cookies()`). -These options are available in the `httr` package documentation in the [`config`](https://httr.r-lib.org/reference/config.html). - -### HTTP GET: `get_request()`{-} - -```{r request-1, eval=not_on_cran} -s_obj %>% - collections(collection_id = "CB4-16D-2") %>% - items() %>% - get_request() -``` - -### HTTP POST: `post_request()`{-} - -```{r request-2, eval=not_on_cran} -s_obj %>% - stac_search( - collections = c("CB4-16D-2", "S2-16D-2"), - datetime = "2021-01-01/2021-01-31", - limit = 400) %>% - post_request() -``` - -Example of providing an additional argument to HTTP verb in a request: - -```{r request-3, eval=not_on_cran} -s_obj %>% - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) %>% - post_request(config = c(httr::add_headers("x-api-key" = "MY-KEY"))) -``` - -## Visualization of the documents{-} - -Each `rstac` object is mapped according to the endpoints of the STAC spec. In this way, each object has a different view. The format for viewing objects is in **Markdown**. - -#### `STACCatalog` object{-} - -```{r catalog, eval=not_on_cran} -s_obj %>% - get_request() -``` - -#### `STACCollection` object{-} - -```{r collection, eval=not_on_cran} -s_obj %>% - collections("S2-16D-2") %>% - get_request() -``` - -#### `Item` object{-} - -```{r item, eval=not_on_cran} -s_obj %>% - collections("CB4-16D-2") %>% - items(feature_id = "CB4-16D_V2_000002_20230509") %>% - get_request() -``` - -#### `Items` object{-} - -```{r item-collection, eval=not_on_cran} -s_obj %>% - stac_search(collections = c("CB4_64_16D_STK", "S2-16D-2")) %>% - get_request() -``` - - -Besides, the `rstac` package provides several auxiliary functions for `Item` and `Items` objects. These auxiliary functions operate at the item or asset level. Functions dedicated to items have the prefix `items_`. Otherwise, asset-oriented functions have the prefix `assets_` - -## Items functions{-} - -The `Items` object have some facilitating functions to manipulate/extract information, for example: - -- **`items_fields()`:** Lists fields names inside an item. -- **`items_filter()`:** Performs a filter by items according to expressions operating on the properties of a `Items` object. -- **`items_fetch()`:** Performs the pagination of items. -- **`items_length()`:** Returns the number of items in an object. -- **`items_matched()`:** Returns the number of items matching the search criteria. -- **`items_assets()`:** Returns the assets name from `Items` and `Item` objects. - - -It is interesting to verify the fields of items before filtering: - -```{r fields, eval=not_on_cran} -s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) %>% - post_request() %>% - items_fields(field = "properties") -``` - -Let's filter items that have the percentage of clouds smaller than 10%: - -```{r filter, eval=not_on_cran} -s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) %>% - post_request() %>% - items_filter(properties$`eo:cloud_cover` < 10) -``` -Number of items returned in the query (in this case equal to the limit defined as parameter): - -```{r length, eval=not_on_cran} -s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) %>% - post_request() %>% - items_length() -``` -Number of matched items in the query: - -```{r matched, eval=not_on_cran} -s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) %>% - post_request() %>% - items_matched() -``` -Paginating all items that were matched in the query: - -```{r fetch, eval=not_on_cran} -items_fetched <- s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 500) %>% - post_request() %>% - items_fetch(progress = FALSE) - -items_fetched -``` -Note that all items was fetched: - -```{r length-2, eval=not_on_cran} -items_length(items_fetched) -``` - -Listing the assets of the retrieved items: - -```{r assets, eval=not_on_cran} -items_assets(items_fetched) -``` - - -## Assets functions{-} - -- **`assets_download()`:** Downloads the assets provided by the STAC API. -- **`assets_url()`:** Returns a character vector with each asset href. -For the URL you can add the GDAL library drivers for the following schemes: - - HTTP/HTTPS files; - - S3 (AWS S3); - - GS (Google Cloud Storage). -- **`assets_select()`:** Selects the assets of each item by its name. -- **`assets_rename()`:** Rename each asset using a named list or a function. - -Listing the assets names of all items: - -```{r assets-2, eval=not_on_cran} -s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 10) %>% - post_request() %>% - items_assets() -``` - -Selecting assets that have names `"BAND14"` and `"NDVI"` - -```{r assets-select, eval=not_on_cran} -selected_assets <- s_obj %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 10) %>% - post_request() %>% - assets_select(asset_names = c("BAND14", "NDVI")) -``` - -```{r assets-3, eval=not_on_cran} -items_assets(selected_assets) -``` - -Listing asset urls from the selected bands: - -```{r assets-url, eval=not_on_cran} -selected_assets %>% - assets_url() -``` - -Renaming assets using the pattern ` = ` - -```{r assets-renamed, eval=not_on_cran} -renamed_assets <- selected_assets %>% - assets_rename(BAND14 = "B14") -renamed_assets -``` - -In the `assets` field of the output it can be seen that the asset's name has changed. -It is also possible to check the asset names using the `items_assets()` function. - -```{r assets-4, eval=not_on_cran} -items_assets(renamed_assets) -``` - - -## Asset preview{-} - -`rstac` also provides a helper function to plot preview assets (e.g. thumbnail and quicklook). - -```{r plot-preview, eval=not_on_cran, fig.height=3, fig.width=5} -second_item <- items_fetched$features[[2]] -second_item %>% - assets_url(asset_names = "thumbnail") %>% - preview_plot() -``` - -Here, we selected the second item of `items_fetched`'s features and plotted its `thumbnail` asset. - -# Conclusion{-} - -The `rstac` package can be useful for querying and working with satellite imagery data from STAC APIs. It offers a simple interface for searching STAC items, exploring the results, and working with assets. Additional functions include reading and plotting preview images. This tutorial has provided a short introduction on how to use the package. For more about CQL2 in `rstac`, type the command `?ext_filter`. diff --git a/vignettes/rstac-02-cql2.Rmd b/vignettes/rstac-02-cql2.Rmd deleted file mode 100644 index ebdbcaf3..00000000 --- a/vignettes/rstac-02-cql2.Rmd +++ /dev/null @@ -1,234 +0,0 @@ ---- -title: "CQL2 examples" -author: "Rolf Simoes, Felipe Carvalho, and Gilberto Camara" -date: "2022-12-16" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{CQL2 examples} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r prepare, include = FALSE} -not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") - -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -# Introduction{-} - -CQL2 is an OGC standard that enables complex filter expressions on OAFeat3 or STAC web services. CQL2 standard states that expressions can be represented in JSON or TEXT formats. Our implementation intends to convert native R expressions into CQL2 valid expressions without needing cumbersome nested lists or dictionaries. Also, we can make CQL2 filter requisition in JSON or TEXT formats with the same filter representation. - -# Translating R expressions to CQL2 syntax{-} - -To explain the difference between the TEXT and JSON CQL2 representation, let's start with a simple example. In the following code, we have a valid CQL2 expression (in TEXT format) that refers to two properties, `vehicle_height` and `bridge_clearance`. - -```{verbatim} -vehicle_height > (bridge_clearance - 1)) -``` - -This filter expression can be passed in the HTTP GET verb implemented by the service to retrieve only those features that satisfy the condition. The same expression can be represented in JSON format, which is more suitable for HTTP POST requests: - -```{verbatim} -{ - "op": ">", - "args": [ - {"property":"vehicle_height"}, - { - "op": "-", - "args": [ - {"property":"bridge_clearance"}, - 1 - ] - } - ] -} -``` - -Note how properties `vehicle_height` and `bridge_clearance` are represented in this format. They are elements of an object containing a `property` member. Also, they go as arguments of operators (in this case,`>` and `-` operators). - -In the R language, the JSON above could be represented by nested lists, which would be somewhat cumbersome to write. To produce valid CQL2 filter expressions, we use the R abstract syntax tree (AST) from R expressions that can be converted to TEXT or JSON formats. Let us see the same previous example written in R CQL2: - -```{r setup, message=FALSE, warning=FALSE} -library(rstac) -``` - -```{r text-1} -cql2_text(vehicle_height > (bridge_clearance - 1)) # TEXT format -``` - -```{r json-1} -cql2_json(vehicle_height > (bridge_clearance - 1)) # JSON format -``` - -In both cases, the same CQL2 object representation is built from the expression using AST of R expression evaluation. Then, the object is converted into TEXT or JSON format. - -CQL2 filters in TEXT format are sometimes represented the same way as in the R expression. However, this should only sometimes be the case, as we can see in some examples provided below. - -## Data types and literal values{-} - -A literal value is any part of a CQL2 filter expression used the same as specified in the expression. - -The scalar data types are: `character string`, `number`, `boolean`, `timestamp`, and `date`. - -**character string** -```{r string} -cql2_text("Via dell'Avvento") -cql2_json("Via dell'Avvento") -``` - - -**number** -```{r number} -cql2_text(3.1415) -cql2_json(-100) -``` - -**boolean** -```{r boolean} -cql2_text(TRUE) -cql2_json(FALSE) -``` - -**timestamp** -```{r timestamp} -cql2_text(timestamp("1969-07-20T20:17:40Z")) -cql2_json(timestamp("1969-07-20T20:17:40Z")) -``` - -**date** -```{r date} -cql2_text(date("1969-07-20")) -cql2_json(date("1969-07-20")) -``` - -## Property references{-} - -The property of an item can be evaluated in the CQL2 filter expression by its name. - -```{r property} -cql2_text(windSpeed > 1) -cql2_json(windSpeed > 1) -``` - -## Standard comparison predicates{-} - -A comparison predicate evaluates if two scalar expressions satisfy the specified comparison operator. - -The standard comparison operators are: `=`, `!=`, `<`, `>`, `<=`, `>=`, and `IS NULL`. - -```{r comparison-1} -cql2_text(city == "Crato") -cql2_json(city == "Jacareí") -``` - -```{r comparison-2} -cql2_text(avg(windSpeed) < 4) -cql2_json(avg(windSpeed) < 4) -``` - -```{r comparison-3} -cql2_text(balance - 150.0 > 0) -cql2_json(balance - 150.0 > 0) -``` - -```{r comparison-4} -cql2_text(updated >= date('1970-01-01')) -cql2_json(updated >= date('1970-01-01')) -``` - -**`IS NULL` operator** - -```{r is-null} -cql2_text(!is_null(geometry)) -cql2_json(!is_null(geometry)) -``` - -## Advanced comparison operators{-} - -A comparison predicate evaluates if two scalar expressions satisfy the specified comparison operator. - -Advanced comparison operators are: `LIKE`, `BETWEEN`, and `IN`. - -**`LIKE` operator** - -```{r like} -cql2_text(name %like% "Smith%") -cql2_json(name %like% "Smith%") -``` - -**`BETWEEN` operator** - -```{r between} -cql2_text(between(depth, 100.0, 150.0)) -cql2_json(between(depth, 100.0, 150.0)) -``` - -**`IN` operator** - -```{r in-1} -cql2_text(cityName %in% list('Toronto', 'Frankfurt', 'Tokyo', 'New York')) -cql2_json(cityName %in% list('Toronto', 'Frankfurt', 'Tokyo', 'New York')) -``` -```{r in-2} -cql2_text(!category %in% list(1, 2, 3, 4)) -cql2_json(!category %in% list(1, 2, 3, 4)) -``` - -## Spatial operators{-} - -A spatial predicate evaluates if two spatial expressions satisfy the specified spatial operator. - -The supported spatial operators are: `S_INTERSECTS`, `S_EQUALS`, `S_DISJOINT`, `S_TOUCHES`, `S_WITHIN`, `S_OVERLAPS`, `S_CROSSES`, and `S_CONTAINS`. - - -```{R spatial, message=FALSE} -poly <- list( - type = "Polygon", - coordinates = list( - rbind( - c(0,0), - c(0,1), - c(0,1) - ) - )) -cql2_text(s_intersects(geometry, {{poly}})) -cql2_json(s_intersects(geometry, {{poly}})) -``` - -> Note: We provide an escape to evaluate user variables using `{{` or `!!`. Both symbols are largely used in the R Data Science community. - -## Temporal operators{-} - -A temporal predicate evaluates if two temporal expressions satisfy the specified temporal operator. - -The supported temporal operators are: `T_AFTER`, `T_BEFORE`, `T_CONTAINS`, `T_DISJOINT`, `T_DURING`, `T_EQUALS`, `T_FINISHEDBY`, `T_FINISHES`, `T_INTERSECTS`, `T_MEETS`, `T_METBY`, `T_OVERLAPPEDBY`, `T_OVERLAPS`, `T_STARTEDBY`, and `T_STARTS`. - -```{r temporal} -cql2_text(t_intersects(event_date, interval("1969-07-16T05:32:00Z", "1969-07-24T16:50:35Z"))) -cql2_json(t_intersects(event_date, interval("1969-07-16T05:32:00Z", "1969-07-24T16:50:35Z"))) -``` - -## Support for functions in CQL2{-} - -Functions allow implementations to extend the language. - -**Example of a function that returns a geometry value.** - -```{r functions} -cql2_text(s_within(road, Buffer(geometry, 10, "m"))) -cql2_json(s_within(road, Buffer(geometry, 10, "m"))) -``` - -# Conclusion{-} - -In conclusion, this tutorial has demonstrated using the `rstac` package to build CQL2 expressions, making it easier for R users to write syntactically correct filter criteria for STAC services. This functionality can be an alternative for users to construct CQL2 expressions easily and efficiently. For more about CQL2 in `rstac`, type the command `?ext_filter`. diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd deleted file mode 100644 index 0b5aa751..00000000 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ /dev/null @@ -1,290 +0,0 @@ ---- -title: "Reading Planetary Computer Data using CQL2 filter extension" -date: "2022-12-21" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{Reading Planetary Computer Data using CQL2 filter extension} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -not_on_cran <- identical(Sys.getenv("NOT_CRAN"), "true") - -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - - -```{r load-rstac, eval=not_on_cran, message=FALSE, warning=FALSE} -library(rstac) -library(tmap) -library(leaflet) -library(stars) -library(slider) -library(ggplot2) -library(purrr) -library(dplyr) -library(httr) -``` - -# Introduction{-} - -This tutorial will use the open-source package `rstac` to search data in Planetary Computer's SpatioTemporal Asset Catalog (STAC) service. STAC services can be accessed through STAC API endpoints, which allow users to search datasets using various parameters such as space and time. In addition to demonstrating the use of `rstac`, the tutorial will explain the Common Query Language (CQL2) filter extension to narrow the search results and find datasets that meet specific criteria in the STAC API. - -This tutorial is based on [reading STAC API data in Python](https://planetarycomputer.microsoft.com/docs/quickstarts/reading-stac/). - -# Reading data from STAC API{-} - -To access Planetary Computer STAC API, we'll create a `rstac` query. - -```{r connection, eval=not_on_cran} -planetary_computer <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -planetary_computer -``` - -## Listing supported properties in CQL2{-} - -CQL2 expressions can be constructed using properties that refer to attributes of items. A list of all properties supported by a collection can be obtained by accessing the `/collections//queryables` endpoint. Filter expressions can use properties listed in this endpoint. - -In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queryables and make a `GET` request to the service. - -```{r queryables, eval=not_on_cran} -planetary_computer %>% - collections("landsat-c2-l2") %>% - queryables() %>% - get_request() -``` - -## Searching with CQL2{-} - -Now we can use `rstac` to make a search query with CQL2 filter extension to obtain the items. - -```{r cql2-search, eval=not_on_cran} -time_range <- cql2_interval("2020-12-01", "2020-12-31") -bbox <- c(-122.2751, 47.5469, -121.9613, 47.7458) -area_of_interest = cql2_bbox_as_geojson(bbox) - -stac_items <- planetary_computer %>% - ext_filter( - collection == "landsat-c2-l2" && - t_intersects(datetime, {{time_range}}) && - s_intersects(geometry, {{area_of_interest}}) - ) %>% - post_request() -``` - -In that example, our filter expression used a temporal (`t_intersects`) and a spatial (`s_intersects`) operators. `t_intersects()` only accepts interval as it second argument, which we created using function `cql2_interval()`. `s_intersects()` spatial operator only accepts GeoJSON objects as its arguments. This is why we had to convert the bounding box vector (`bbox`) into a structure representing a GeoJSON object using the function `cql2_bbox_as_geojson()`. We embrace the arguments using `{{` to evaluate them before make the request. - -`items` is an `Items` object containing 8 items that matched our search criteria. - -```{r items-length, eval=not_on_cran} -stac_items -``` - -## Exploring data{-} - -An `Items` is a regular GeoJSON object. It is a collection of `Item` entries that stores metadata on assets. Users can convert a `Items` to a `sf` object containing the properties field as columns. Here we depict the items footprint. - -```{r geojson-to-sf, eval=not_on_cran} -sf <- items_as_sf(stac_items) - -# create a function to plot a map -plot_map <- function(x) { - tmap_mode("view") - tm_basemap(providers[["Stamen.Watercolor"]]) + - tm_shape(x) + - tm_borders() -} - -plot_map(sf) -``` - -Some collections use the `eo` extension, which allows us to sort items by attributes like cloud coverage. The next example selects the item with lowest cloud_cover attribute: - -```{r lowest-cloud-cover, eval=not_on_cran} -cloud_cover <- stac_items %>% - items_reap(field = c("properties", "eo:cloud_cover")) -selected_item <- stac_items$features[[which.min(cloud_cover)]] -``` - -We use function `items_reap()` to extract cloud cover values from all features. - -Each STAC item have an `assets` field which describes files and provides link to access them. - -```{r assets-list, eval=not_on_cran} -items_assets(selected_item) - -map_dfr(items_assets(selected_item), function(key) { - tibble(asset = key, description = selected_item$assets[[key]]$title) -}) -``` - -Here, we’ll inspect the `rendered_preview` asset. To plot this asset, we can use the helper function `preview_plot()` and provide a URL to be plotted. We use the function `assets_url()` to get the URL. This function extracts all available URLs in items. - -```{r asset-preview, eval=not_on_cran, fig.height=3, fig.width=5} -selected_item$assets[["rendered_preview"]]$href - -selected_item %>% - assets_url(asset_names = "rendered_preview") %>% - preview_plot() -``` - -The `rendered_preview` asset is generated dynamically by Planetary Computer API using raw data. We can access the raw data, stored as Cloud Optimized GeoTIFFs (COG) in Azure Blob Storage, using the other assets. These assets are in private Azure Blob Storage containers and is necessary to sign them to have access to the data, otherwise, you’ll get a 404 (forbidden) status code. - -## Signing items{-} - -To sign URL in `rstac`, we can use `items_sign()` function. - -```{r sign-item, eval=not_on_cran} -selected_item <- selected_item %>% - items_sign(sign_fn = sign_planetary_computer()) - -selected_item %>% - assets_url(asset_names = "blue") %>% - substr(1, 255) -``` - -Everything after the `?` in that URL is a [SAS token](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) grants access to the data. See https://planetarycomputer.microsoft.com/docs/concepts/sas/ for more on using tokens to access data. - -```{r url-check, eval=not_on_cran} -selected_item %>% - assets_url(asset_names = "blue") %>% - HEAD() %>% - status_code() -``` - -The 200 status code means that we were able to access the data using the signed URL with the SAS token included. - -## Reading files{-} - -We can load up that single COG file using packages like [stars](https://github.com/r-spatial/stars) or [terra](https://github.com/rspatial/terra). - -```{r read-file, eval=not_on_cran} -selected_item %>% - assets_url(asset_names = "blue", append_gdalvsi = TRUE) %>% - read_stars(RasterIO = list(nBufXSize = 512, nBufYSize = 512)) %>% - plot(main = "blue") -``` - -We used the `assets_url()` method with the `append_gdalvsi = TRUE` parameter to insert `/vsicurl` in the URL. This allows the GDAL VSI driver to access the data using HTTP. - -# Searching on additional properties{-} - -In the previous step of this tutorial, we learned how to search for items by specifying the space and time parameters. However, the Planetary Computer's STAC API offers even more flexibility by allowing you to search for items based on additional properties. - -For instance, collections like `sentinel-2-l2a` and `landsat-c2-l2` both implement the [eo](https://github.com/stac-extensions/eo) STAC extension and include an `eo:cloud_cover` property. To filter your search results to only return items that have a cloud coverage of less than 20%, you can use: - -```{r cql2-search-cloud, eval=not_on_cran} -stac_items <- planetary_computer %>% - ext_filter( - collection %in% c("sentinel-2-l2a", "landsat-c2-l2") && - t_intersects(datetime, {{time_range}}) && - s_intersects(geometry, {{area_of_interest}}) && - `eo:cloud_cover` < 20 - ) %>% - post_request() -``` - -Here we search for `sentinel-2-l2a` and `landsat-c2-l2` assets. As a result, we have images from both collections in our search results. Users can rename the assets to have a common name in both collections. - -```{r assets-rename, eval=not_on_cran} -stac_items <- stac_items %>% - assets_select(asset_names = c("B11", "swir16")) %>% - assets_rename(B11 = "swir16") - -stac_items %>% - items_assets() -``` - -`assets_rename()` uses parameter mapper that is used to rename asset names. The parameter can be either a named list or a function that is called against each asset metadata. A last parameter was included to force band renaming. - -## Analyzing STAC Metadata{-} - -`Item` objects are features of `Items` and store information about assets. - -```{r items-fetch, eval=not_on_cran} -stac_items <- planetary_computer %>% - ext_filter( - collection == "sentinel-2-l2a" && - t_intersects(datetime, interval("2020-01-01", "2020-12-31")) && - s_intersects(geometry, {{ - cql2_bbox_as_geojson(c(-124.2751, 45.5469, -123.9613, 45.7458)) - }}) - ) %>% - post_request() - -stac_items <- items_fetch(stac_items) -``` - -We can use the metadata to plot cloud cover of a region over time, for example. - -```{r cloud-cover-ts-plot, eval=not_on_cran} -df <- items_as_sf(stac_items) %>% - mutate(datetime = as.Date(datetime)) %>% - group_by(datetime) %>% - summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) %>% - mutate(`eo:cloud_cover` = slide_mean(`eo:cloud_cover`, before = 3, after = 3)) - -df %>% - ggplot() + - geom_line(aes(x = datetime, y = `eo:cloud_cover`)) -``` - -`cql2_bbox_as_geojson()` is a `rstac` helper function and it must be evaluated before the request. This is why we embraced it with `{{`. We use `items_fetch()` to retrieve all paginated items matched in the search. - - -# Working with STAC Catalogs and Collections{-} - -STAC organizes items in catalogs (`STACCatalog`) and collections (`STACCollection`). These JSON documents contains metadata of the dataset they refer to. For instance, here we look at the [Bands](https://github.com/stac-extensions/eo#band-object) available for [Landsat 8 Collection 2 Level 2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) data: - -```{r collection-landsat-bands, eval=not_on_cran} -landsat <- planetary_computer %>% - collections(collection_id = "landsat-c2-l2") %>% - get_request() - -map_dfr(landsat$summaries$`eo:bands`, as_tibble) -``` - -We can see what [Assets](https://github.com/radiantearth/stac-spec/blob/master/item-spec/item-spec.md#asset-object) are available on our item with: - -```{r landsat-assets, eval=not_on_cran} -map_dfr(landsat$item_assets, function(x) { - as_tibble( - compact(x[c("title", "description", "gsd")]) - ) -}) -``` - -Some collections, like [Daymet](https://planetarycomputer.microsoft.com/dataset/daymet-daily-na) include collection-level assets. You can use the `assets` property to access those assets. - -```{r collection-daymet, eval=not_on_cran} -daymet <- planetary_computer %>% - collections(collection_id = "daymet-daily-na") %>% - get_request() - -daymet -``` - -Just like assets on items, these assets include links to data in Azure Blob Storage. - -```{r daymet-assets, eval=not_on_cran} -items_assets(daymet) - -daymet %>% - assets_select(asset_names = "zarr-abfs") %>% - assets_url() -``` - -# Learn more{-} - -For more about the Planetary Computer's STAC API, see [Using tokens for data access](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) and the [STAC API reference](https://planetarycomputer.microsoft.com/docs/reference/stac/). -For more about CQL2 in `rstac`, type the command `?ext_filter`. From 957b22974dc1a73e2999380c0991a5025def9f07 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 01:45:45 +0100 Subject: [PATCH 27/35] Remove dependencies --- DESCRIPTION | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ec1c5e03..edfedf3a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,14 +38,7 @@ Imports: Suggests: lifecycle, testthat, - knitr, - tmap, - leaflet, - stars, - slider, - ggplot2, - purrr, - dplyr + knitr Collate: 'cql2-expr-funs.R' 'cql2-types.R' From 8a18a309f43eaae03f9a8e9feabc8a5b7323d6cc Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 02:16:40 +0100 Subject: [PATCH 28/35] Remove revdep folder --- .gitignore | 1 - revdep/.gitignore | 7 ---- revdep/README.md | 32 --------------- revdep/cran.md | 7 ---- revdep/failures.md | 99 ---------------------------------------------- revdep/problems.md | 1 - 6 files changed, 147 deletions(-) delete mode 100644 revdep/.gitignore delete mode 100644 revdep/README.md delete mode 100644 revdep/cran.md delete mode 100644 revdep/failures.md delete mode 100644 revdep/problems.md diff --git a/.gitignore b/.gitignore index 2476c105..bbaa6dd3 100644 --- a/.gitignore +++ b/.gitignore @@ -42,4 +42,3 @@ docs inst/doc /doc/ /Meta/ -^revdep$ diff --git a/revdep/.gitignore b/revdep/.gitignore deleted file mode 100644 index 111ab324..00000000 --- a/revdep/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -checks -library -checks.noindex -library.noindex -cloud.noindex -data.sqlite -*.html diff --git a/revdep/README.md b/revdep/README.md deleted file mode 100644 index f1ef036b..00000000 --- a/revdep/README.md +++ /dev/null @@ -1,32 +0,0 @@ -# Platform - -|field |value | -|:--------|:----------------------------------------------------------------------------| -|version |R version 4.3.2 (2023-10-31) | -|os |Ubuntu 22.04.3 LTS | -|system |x86_64, linux-gnu | -|ui |RStudio | -|language |(EN) | -|collate |en_US.UTF-8 | -|ctype |en_US.UTF-8 | -|tz |Europe/Amsterdam | -|date |2024-02-13 | -|rstudio |2023.12.1+402 Ocean Storm (desktop) | -|pandoc |3.1.1 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown) | - -# Dependencies - -|package |old |new |Δ | -|:-------|:-------|:-----|:--| -|rstac |0.9.2-5 |1.0.0 |* | - -# Revdeps - -## Failed to check (3) - -|package |version |error |warning |note | -|:------------------|:-------|:-----|:-------|:----| -|BFS |? | | | | -|mapme.biodiversity |? | | | | -|sits |? | | | | - diff --git a/revdep/cran.md b/revdep/cran.md deleted file mode 100644 index cb582d73..00000000 --- a/revdep/cran.md +++ /dev/null @@ -1,7 +0,0 @@ -## revdepcheck results - -We checked 3 reverse dependencies (0 from CRAN + 3 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. - - * We saw 0 new problems - * We failed to check 0 packages - diff --git a/revdep/failures.md b/revdep/failures.md deleted file mode 100644 index 5a2304ac..00000000 --- a/revdep/failures.md +++ /dev/null @@ -1,99 +0,0 @@ -# BFS - -
- -* Version: -* GitHub: https://github.com/brazil-data-cube/rstac -* Source code: NA -* Number of recursive dependencies: 0 - -
- -## Error before installation - -### Devel - -``` - - - - - - -``` -### CRAN - -``` - - - - - - -``` -# mapme.biodiversity - -
- -* Version: -* GitHub: https://github.com/brazil-data-cube/rstac -* Source code: NA -* Number of recursive dependencies: 0 - -
- -## Error before installation - -### Devel - -``` - - - - - - -``` -### CRAN - -``` - - - - - - -``` -# sits - -
- -* Version: -* GitHub: https://github.com/brazil-data-cube/rstac -* Source code: NA -* Number of recursive dependencies: 0 - -
- -## Error before installation - -### Devel - -``` - - - - - - -``` -### CRAN - -``` - - - - - - -``` diff --git a/revdep/problems.md b/revdep/problems.md deleted file mode 100644 index 9a207363..00000000 --- a/revdep/problems.md +++ /dev/null @@ -1 +0,0 @@ -*Wow, no problems at all. :)* \ No newline at end of file From defbdb23bb8d0a208cf1e22fdc0907fb80ea01cd Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 02:18:21 +0100 Subject: [PATCH 29/35] Fix maintainer --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index edfedf3a..ae667379 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,10 +4,10 @@ Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", - role = c("aut", "cre")), + role = c("aut")), person("Felipe", "Carvalho", email = "lipecaso@gmail.com", - role = c("aut")), + role = c("aut", "cre")), person("Brazil Data Cube Team", email = "brazildatacube@inpe.br", role = c("aut")), From deb978bb99a4df41e5eb9f4e15669d8cb2d1e970 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 13:54:15 +0100 Subject: [PATCH 30/35] Add items_select() (closes #146) --- DESCRIPTION | 1 - NAMESPACE | 2 ++ R/items-funs.R | 30 ++++++++++++++++++++++++++++++ man/items_functions.Rd | 13 +++++++++++++ man/rstac.Rd | 4 ++-- 5 files changed, 47 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ae667379..494df321 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -80,4 +80,3 @@ Collate: 'rstac.R' 'rstac-funs.R' Roxygen: list(markdown = TRUE) -VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 540c0421..5400e132 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,7 @@ S3method(items_properties,doc_items) S3method(items_reap,default) S3method(items_reap,doc_item) S3method(items_reap,doc_items) +S3method(items_select,doc_items) S3method(items_sign,default) S3method(items_sign,doc_item) S3method(items_sign,doc_items) @@ -201,6 +202,7 @@ export(items_matched) export(items_next) export(items_properties) export(items_reap) +export(items_select) export(items_sign) export(items_sign_bdc) export(items_sign_planetary_computer) diff --git a/R/items-funs.R b/R/items-funs.R index bff8353e..399392a9 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -77,6 +77,9 @@ #' #' @param geom a `sf` or `sfc` object. #' +#' @param selection an `integer` vector containing the indices of the items +#' to select. +#' #' @param ... additional arguments. See details. #' #' @details @@ -153,6 +156,8 @@ #' \item `items_properties()`: returns a `character` value with all properties #' of all items. #' +#' \item `items_select()`: select features from an items object. +#' #' } #' #' @examples @@ -215,6 +220,8 @@ #' #' stac_item %>% items_as_tibble() #' +#' stac_item %>% items_select(c(1, 4, 10, 20)) +#' #' } #' #' @name items_functions @@ -751,3 +758,26 @@ items_properties.doc_items <- function(items) { names(item$properties) })))) } + +#' @rdname items_functions +#' +#' @export +items_select <- function(items, selection) { + UseMethod("items_select", items) +} + +#' @rdname items_functions +#' +#' @export +items_select.doc_items <- function(items, selection) { + check_items(items) + items$features <- items$features[selection] + # clear numberMatched information + if ("search:metadata" %in% names(items)) + items$`search:metadata`$matched <- NULL + if ("context" %in% names(items)) + items$`context`$matched <- NULL + if ("numberMatched" %in% names(items)) + items$numberMatched <- NULL + items +} diff --git a/man/items_functions.Rd b/man/items_functions.Rd index d3b64bb9..dd25fdce 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -50,6 +50,8 @@ \alias{items_properties} \alias{items_properties.doc_item} \alias{items_properties.doc_items} +\alias{items_select} +\alias{items_select.doc_items} \title{Items functions} \usage{ items_length(items) @@ -147,6 +149,10 @@ items_properties(items) \method{items_properties}{doc_item}(items) \method{items_properties}{doc_items}(items) + +items_select(items, selection) + +\method{items_select}{doc_items}(items, selection) } \arguments{ \item{items}{a \code{doc_items} object.} @@ -177,6 +183,9 @@ and returns an item signed.} \item{crs}{a \code{character} representing the geometry projection.} \item{geom}{a \code{sf} or \code{sfc} object.} + +\item{selection}{an \code{integer} vector containing the indices of the items +to select.} } \value{ \itemize{ @@ -216,6 +225,8 @@ otherwise or a \code{list}. \item \code{items_properties()}: returns a \code{character} value with all properties of all items. +\item \code{items_select()}: select features from an items object. + } } \description{ @@ -363,6 +374,8 @@ stac_item \%>\% items_as_sf() stac_item \%>\% items_as_tibble() +stac_item \%>\% items_select(c(1, 4, 10, 20)) + } } diff --git a/man/rstac.Rd b/man/rstac.Rd index 292a75e7..71076468 100644 --- a/man/rstac.Rd +++ b/man/rstac.Rd @@ -76,11 +76,11 @@ Useful links: } \author{ -\strong{Maintainer}: Rolf Simoes \email{rolfsimoes@gmail.com} +\strong{Maintainer}: Felipe Carvalho \email{lipecaso@gmail.com} Authors: \itemize{ - \item Felipe Carvalho \email{lipecaso@gmail.com} + \item Rolf Simoes \email{rolfsimoes@gmail.com} \item Brazil Data Cube Team \email{brazildatacube@inpe.br} } From b823b0c78195d7308aafb3568f35ab2eb595908b Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 14:37:54 +0100 Subject: [PATCH 31/35] Check reverse dependencies --- .Rbuildignore | 1 + revdep/.gitignore | 7 +++++++ 2 files changed, 8 insertions(+) create mode 100644 revdep/.gitignore diff --git a/.Rbuildignore b/.Rbuildignore index 7ddf1a05..b2675245 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ ^Meta$ ^\.github$ ^revdep$ +^cran-comments\.md$ diff --git a/revdep/.gitignore b/revdep/.gitignore new file mode 100644 index 00000000..111ab324 --- /dev/null +++ b/revdep/.gitignore @@ -0,0 +1,7 @@ +checks +library +checks.noindex +library.noindex +cloud.noindex +data.sqlite +*.html From 8189a848d99e5fcd15a397609570a6367c505b72 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 15:34:39 +0100 Subject: [PATCH 32/35] Add revdep --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index bbaa6dd3..ad486f19 100644 --- a/.gitignore +++ b/.gitignore @@ -42,3 +42,5 @@ docs inst/doc /doc/ /Meta/ +/revdep/ +cran-comments.md From f70299f9c43e68ea653c64c51973de6fbbf5876c Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 15:37:53 +0100 Subject: [PATCH 33/35] Removing revdep --- .gitignore | 2 +- revdep/.gitignore | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) delete mode 100644 revdep/.gitignore diff --git a/.gitignore b/.gitignore index ad486f19..df17249c 100644 --- a/.gitignore +++ b/.gitignore @@ -42,5 +42,5 @@ docs inst/doc /doc/ /Meta/ -/revdep/ +/revdep2/ cran-comments.md diff --git a/revdep/.gitignore b/revdep/.gitignore deleted file mode 100644 index 111ab324..00000000 --- a/revdep/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -checks -library -checks.noindex -library.noindex -cloud.noindex -data.sqlite -*.html From 2f4b36f69063add353d7231a9d15d72b81c838ca Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 15:39:55 +0100 Subject: [PATCH 34/35] Fix .gitignore --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index df17249c..ad486f19 100644 --- a/.gitignore +++ b/.gitignore @@ -42,5 +42,5 @@ docs inst/doc /doc/ /Meta/ -/revdep2/ +/revdep/ cran-comments.md From b6aba27b73131bfee2fcc8f8b49c722761aeb1c9 Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Wed, 14 Feb 2024 15:53:52 +0100 Subject: [PATCH 35/35] Update NEWS.md --- NEWS.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index d2e5ae4a..0d1e8a1f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,3 @@ -# rstac (development version) - # rstac 1.0.0 (Released 2024-02-14) * Add support to static catalogs;