Skip to content

Commit

Permalink
Data.frame layers (#83)
Browse files Browse the repository at this point in the history 
Co-authored-by: Anna Krystalli <[email protected]>
  • Loading branch information
@maelle @annakrystalli
maelle and annakrystalli authored Apr 26, 2022
1 parent b137b8b commit 9f46042
Show file tree
Hide file tree
Showing 91 changed files with 1,423 additions and 470 deletions.
17 changes: 12 additions & 5 deletions R/info.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
title = purrr::map_chr(wfs_layers, ~.x$getTitle()),
abstract = purrr::map_chr(wfs_layers, ~getAbstractNull(.x)),
class = purrr::map_chr(wfs_layers, ~.x$getClassName()),
format = "sf"
format = purrr::map_chr(wfs_layers, guess_layer_format)
) %>%
tidyr::separate(
.data$layer_name,
Expand All @@ -44,9 +44,8 @@ emodnet_get_layer_info <- memoise::memoise(.emodnet_get_layer_info)
Both cannot be {usethis::ui_value('NULL')}")
}

if(is.null(wfs)){
wfs <- emodnet_init_wfs_client(service, service_version)
}else{check_wfs(wfs)}
wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
check_wfs(wfs)

caps <- wfs$getCapabilities()

Expand All @@ -58,7 +57,7 @@ emodnet_get_layer_info <- memoise::memoise(.emodnet_get_layer_info)
title = purrr::map_chr(caps$getFeatureTypes(), ~.x$getTitle()),
abstract = purrr::map_chr(caps$getFeatureTypes(), ~getAbstractNull(.x)),
class = purrr::map_chr(caps$getFeatureTypes(), ~.x$getClassName()),
format = "sf"
format = purrr::map_chr(caps$getFeatureTypes(), guess_layer_format)
) %>%
tidyr::separate(.data$layer_name, into = c("layer_namespace", "layer_name"),
sep = ":")
Expand Down Expand Up @@ -96,3 +95,11 @@ getAbstractNull <- function(x){
abstract <- x$getAbstract()
ifelse(is.null(abstract), "", abstract)
}

guess_layer_format <- function(layer) {
if (any(layer$getDescription(pretty = T)$type == "geometry")) {
"sf"
} else {
"data.frame"
}
}
19 changes: 7 additions & 12 deletions R/layer_attributes.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,10 +32,9 @@ layer_attributes_summarise <- function(wfs = NULL,
layer_attribute_descriptions <- function(wfs = NULL,
service = NULL,
service_version = "2.0.0", layer) {
if(is.null(wfs)){
wfs <- emodnet_init_wfs_client(service,
service_version)
}else{check_wfs(wfs)}

wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
check_wfs(wfs)

get_layer_metadata(layer, wfs)$getDescription(pretty = TRUE)
}
Expand Down Expand Up @@ -86,10 +85,8 @@ layer_attribute_inspect <- function(wfs = NULL,
service_version = "2.0.0",
layer, attribute) {

if(is.null(wfs)){
wfs <- emodnet_init_wfs_client(service,
service_version)
}else{check_wfs(wfs)}
wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
check_wfs(wfs)

layer <- match.arg(layer, several.ok = FALSE,
choices = emodnet_get_wfs_info(wfs)$layer_name)
Expand Down Expand Up @@ -137,10 +134,8 @@ layer_attributes_tbl <- function(wfs = NULL,
service = NULL,
service_version = "2.0.0", layer) {

if(is.null(wfs)){
wfs <- emodnet_init_wfs_client(service,
service_version)
}else{check_wfs(wfs)}
wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
check_wfs(wfs)

layer <- match.arg(layer, several.ok = FALSE,
choices = emodnet_get_wfs_info(wfs)$layer_name)
Expand Down
69 changes: 49 additions & 20 deletions R/layers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,20 +68,32 @@ emodnet_get_layers <- function(wfs = NULL, service = NULL, service_version = "2.

if (is.null(wfs) & is.null(service)) {
usethis::ui_stop(
"Please provide a valid {usethis::ui_field('service')} name or {usethis::ui_field('wfs')} object.
"Please provide a valid {usethis::ui_field('service')} name or {usethis::ui_field('wfs')} object.
Both cannot be {usethis::ui_value('NULL')} at the same time."
)
}

if (is.null(wfs)) {
wfs <- emodnet_init_wfs_client(service, service_version)
}
wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)

check_wfs(wfs)

# check layers -----------------------------------------
layers <- match.arg(layers, several.ok = TRUE,
choices = emodnet_get_wfs_info(wfs)$layer_name)
layers <- match.arg(
layers,
several.ok = TRUE,
choices = emodnet_get_wfs_info(wfs)$layer_name
)

formats <- purrr::map_chr(layers, get_layer_format, wfs)
if (any(formats != "sf") && reduce_layers) {
rlang::abort(
c(
"Can't reduce layers when one is a data.frame",
i = sprintf("data.frame layer(s): %s", toString(layers[formats == "data.frame"]))
)

)
}

# check filter vector -----------------------------------------
cql_filter <- cql_filter %||% rep(NA, times = length(layers))
Expand Down Expand Up @@ -156,10 +168,16 @@ check_layer_crs <- function(layer_sf, layer, wfs) {


checkmate_crs <- function(sf, crs = NULL) {

if (checkmate::test_null(sf)) {
return(sf)
}

# data.frame layers
if (!inherits(sf, "sf")) {
return(sf)
}

if (is.na(sf::st_crs(sf)) || is.null(sf::st_crs(sf))) {
usethis::ui_warn("{usethis::ui_field('crs')} missing from `sf` object.")

Expand All @@ -179,7 +197,7 @@ checkmate_crs <- function(sf, crs = NULL) {
standardise_crs <- function(out, crs = NULL) {

if (checkmate::test_class(out, "list")) {
purrr::map(out, ~checkmate_crs(.x, crs = crs))
purrr::map(out, ~checkmate_crs(.x, crs = crs))
} else {
checkmate_crs(out, crs = crs)
}
Expand All @@ -194,24 +212,31 @@ ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL,
if (is.na(cql_filter)) {cql_filter <- NULL}
if (is.null(cql_filter)) {
# get layer without cql_filter
tryCatch(
tryCatch({

layer <- wfs$getFeatures(namespaced_x, ...)

layer <- wfs$getFeatures(namespaced_x, ...) %>%
check_layer_crs(layer = x, wfs = wfs),
if (inherits(layer, "sf")) {
layer <- check_layer_crs(layer, layer = x, wfs = wfs)
}
},
error = function(e) {
usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")
}
}
)
} else {
# get layer using cql_filter
tryCatch(
layer <- wfs$getFeatures(namespaced_x,
cql_filter = utils::URLencode(cql_filter),
...) %>%
check_layer_crs(layer = x, wfs = wfs),
tryCatch({

layer <- wfs$getFeatures(namespaced_x, cql_filter = utils::URLencode(cql_filter), ...)

if (inherits(layer, "sf")) {
layer <- check_layer_crs(layer, layer = x, wfs = wfs)
}
},
error = function(e) {
usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")
}
}
)
}
return(layer)
Expand All @@ -220,12 +245,16 @@ ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL,
namespace_layer_names <- function(wfs, layers) {

info <- emodnet_get_wfs_info(wfs)
layers <- match.arg(layers, choices = info$layer_name,
several.ok = TRUE)
layers <- match.arg(layers, choices = info$layer_name, several.ok = TRUE)

# get layer namespace from info and concatenate with layer name. Otherwise
# empty list returned in capabilities$findFeatureTypeByName
info[info$layer_name %in% layers,
c("layer_namespace", "layer_name")] %>%
c("layer_namespace", "layer_name")] %>%
apply(1, FUN = function(x){paste0(x, collapse=":")})
}

get_layer_format <- function(layer, wfs) {
layers <- emodnet_get_wfs_info(wfs)
layers$format[layers$layer_name == layer]
}
2 changes: 1 addition & 1 deletion tests/testthat/_snaps/layer_attributes.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# layer_attribute_descriptions works
# layer attributes stuff works

name type minOccurs maxOccurs nillable
1 id integer 0 1 TRUE
Expand Down
5 changes: 5 additions & 0 deletions tests/testthat/_snaps/layers.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,3 +11,8 @@

'arg' should be one of "mediseh_cor_abs_pnt", "mediseh_cor_abs_poly", "mediseh_cymodocea_pnt", "Species_gridded_abundances_10year", "Species_gridded_abundances_2year", "Species_gridded_abundances_3year", "Species_gridded_abundance_all", "mediseh_halophila_pnt", "mediseh_maerl_pnt", "mediseh_maerl_poly", "mediseh_posidonia_model", "mediseh_coral_model", "mediseh_maerl_model", "OOPS_errors", "OOPS_metadata", "OOPS_products", "OOPS_products_vliz", "OOPS_regions", "OOPS_summaries", "mediseh_cor_pnt", "mediseh_cor_poly", "mediseh_posidonia_abs", "mediseh_posidonia_nodata", "mediseh_posidonia_current_pnt", "mediseh_posidonia_current_shape", "mediseh_posidonia_historical_shape", "mediseh_posidonia_historical_pnt", "mediseh_ruppia_c_pnt", "mediseh_ruppia_m_pnt", "mediseh_zostera_m_pnt", "mediseh_zostera_n_pnt", "grey_seal", "harbour_seal"

# works when data.frame layer

Can't reduce layers when one is a data.frame
i data.frame layer(s): OOPS_summaries, OOPS_metadata

Loading

0 comments on commit 9f46042

Please sign in to comment.