diff --git a/R/RcppExports.R b/R/RcppExports.R index 000c470..e67eff3 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -49,10 +49,6 @@ sfg_multipolygon_impl <- function(mply) { .Call(`_arcgisutils_sfg_multipolygon_impl`, mply) } -sfc_multipolygon_impl <- function(mply) { - .Call(`_arcgisutils_sfc_multipolygon_impl`, mply) -} - transpose_impl <- function(x, names_template) { .Call(`_arcgisutils_transpose_impl`, x, names_template) } diff --git a/R/as-esri-geometry.R b/R/as-esri-geometry.R index a16d34b..2982b62 100644 --- a/R/as-esri-geometry.R +++ b/R/as-esri-geometry.R @@ -111,13 +111,11 @@ as_geometry <- function(x, crs, ...) { #' @export as_geometry.POINT <- function(x, crs = 4326, ..., call = rlang::current_env()) { - crs_text <- validate_crs(crs, call = call) dims <- determine_dims(x) - geometry <- switch( - dims, + geometry <- switch(dims, "xy" = sfc_point_xy(list(x))[[1]], "xyz" = sfc_point_xyz(list(x))[[1]], "xyzm" = sfc_point_xyzm(list(x))[[1]], @@ -145,8 +143,7 @@ as_geometry.MULTILINESTRING <- function( x, crs = 4326, ..., - call = rlang::current_env() -) { + call = rlang::current_env()) { crs_text <- validate_crs(crs, call = call) geometry <- sfc_multilinestring_impl(list(x))[[1]] @@ -158,7 +155,6 @@ as_geometry.POLYGON <- function(x, crs = 4326, ..., call = rlang::current_env()) crs_text <- validate_crs(crs, call = call) geometry <- sfg_polygon_impl(x) c(hasZ = has_z(x), hasM = has_m(x), geometry, crs_text) - } #' @export @@ -166,10 +162,9 @@ as_geometry.MULTIPOLYGON <- function( x, crs = 4326, ..., - call = rlang::current_env() -) { + call = rlang::current_env()) { crs_text <- validate_crs(crs, call = call) - geometry <- sfc_multipolygon_impl(list(x))[[1]] + geometry <- sfg_polygon_impl(unlist(x, recursive = FALSE)) res <- c(hasZ = has_z(x), hasM = has_m(x), geometry, crs_text) res } @@ -198,7 +193,6 @@ as_features <- function(x, ..., call = rlang::caller_env()) { #' @export as_features.sfc <- function(x, ..., call = rlang::caller_env()) { - geoms <- featureset_geometry(x, call = call) res <- lapply( @@ -211,7 +205,6 @@ as_features.sfc <- function(x, ..., call = rlang::caller_env()) { #' @export as_features.sf <- function(x, ...) { - geo <- sf::st_geometry(x) geom_list <- featureset_geometry(geo, call = call) x <- sf::st_drop_geometry(x) @@ -243,7 +236,6 @@ as_features.sf <- function(x, ...) { transpose(x), SIMPLIFY = FALSE ) - } rows @@ -251,7 +243,6 @@ as_features.sf <- function(x, ...) { #' @export as_features.data.frame <- function(x, ...) { - # handle dates are_dates <- which(vapply(x, is_date, logical(1))) for (col in are_dates) { @@ -272,7 +263,6 @@ as_features.data.frame <- function(x, ...) { rows <- lapply(fields, function(.x) list(attributes = .x)) rows - } @@ -293,9 +283,7 @@ as_featureset.sfc <- function( crs = sf::st_crs(x), ..., arg = rlang::caller_arg(x), - call = rlang::caller_env() -) { - + call = rlang::caller_env()) { # check CRS first # TODO have better CRS handling. We prefer having _no_ crs over # a wrong one. @@ -335,9 +323,7 @@ as_featureset.sf <- function( crs = sf::st_crs(x), ..., arg = rlang::caller_arg(x), - call = rlang::caller_env() -) { - + call = rlang::caller_env()) { # check CRS first if (is.na(sf::st_crs(x)) && is.na(sf::st_crs(crs))) { cli::cli_warn( @@ -387,7 +373,6 @@ as_featureset.sf <- function( fields, SIMPLIFY = FALSE ) - } c( @@ -401,7 +386,6 @@ as_featureset.sf <- function( #' @export as_featureset.data.frame <- function(x, ...) { - # handle dates are_dates <- which(vapply(x, is_date, logical(1))) for (col in are_dates) { @@ -417,7 +401,6 @@ as_featureset.data.frame <- function(x, ...) { fields <- transpose(x) rows <- lapply(fields, function(.x) list(attributes = .x)) c(list(features = rows)) - } @@ -431,7 +414,6 @@ as_featureset.data.frame <- function(x, ...) { #' @keywords internal #' @noRd featureset_geometry <- function(x, call = rlang::caller_env()) { - # extract geometry x <- sf::st_geometry(x) @@ -451,8 +433,7 @@ featureset_geometry <- function(x, call = rlang::caller_env()) { } # convert geometry - geo_conversion_fn <- switch( - geom_type, + geo_conversion_fn <- switch(geom_type, "POINT" = sfc_point_impl, "MULTIPOINT" = sfc_multipoint_impl, "LINESTRING" = sfc_linestring_impl, @@ -462,7 +443,6 @@ featureset_geometry <- function(x, call = rlang::caller_env()) { ) rlang::set_names(list(geo_conversion_fn(x)), esri_geo_type) - } @@ -500,4 +480,6 @@ featureset_geometry <- function(x, call = rlang::caller_env()) { # sfg object conversion --------------------------------------------------- - +sfc_multipolygon_impl <- function(x) { + sfc_polygon_impl(unlist(x, recursive = FALSE)) +} diff --git a/R/esri-field-mapping.R b/R/esri-field-mapping.R index ea1aa5d..ce0cb96 100644 --- a/R/esri-field-mapping.R +++ b/R/esri-field-mapping.R @@ -122,6 +122,7 @@ get_ptype <- function(field_type, n = 1, call = rlang::caller_env()) { #' @export #' @rdname field_mapping +#' @param n the number of rows to create in the prototype table ptype_tbl <- function(fields, n = 0, call = rlang::caller_env()) { ftype <- fields[["type"]] fname <- fields[["name"]] diff --git a/R/utils-requests.R b/R/utils-requests.R index e591947..921dd97 100644 --- a/R/utils-requests.R +++ b/R/utils-requests.R @@ -57,7 +57,6 @@ fetch_layer_metadata <- function(url, token = NULL, call = rlang::caller_env()) #' #' Nothing. Used for it's side effect. If an error code is encountered in the #' response an error is thrown with the error code and the error message. -#' @details #' @export #' @family requests #' @examples diff --git a/man/field_mapping.Rd b/man/field_mapping.Rd index f6cd3ee..4d4d260 100644 --- a/man/field_mapping.Rd +++ b/man/field_mapping.Rd @@ -40,6 +40,8 @@ For more information about error calls, see \ifelse{html}{\link[rlang:topic-erro \item{field_type}{a character of a desired Esri field type. See details for more.} +\item{n}{the number of rows to create in the prototype table} + \item{fields}{a data.frame containing, at least, the columns \code{type} and \code{name}. Typically retrieved from the \code{field} metadata from a \code{FeatureLayer} or \code{Table}. Also can use the output of \code{infer_esri_type()}.} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index f0e29b7..7a388e0 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -142,17 +142,6 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// sfc_multipolygon_impl -List sfc_multipolygon_impl(List mply); -RcppExport SEXP _arcgisutils_sfc_multipolygon_impl(SEXP mplySEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< List >::type mply(mplySEXP); - rcpp_result_gen = Rcpp::wrap(sfc_multipolygon_impl(mply)); - return rcpp_result_gen; -END_RCPP -} // transpose_impl SEXP transpose_impl(SEXP x, SEXP names_template); RcppExport SEXP _arcgisutils_transpose_impl(SEXP xSEXP, SEXP names_templateSEXP) { @@ -179,7 +168,6 @@ static const R_CallMethodDef CallEntries[] = { {"_arcgisutils_sfc_polygon_impl", (DL_FUNC) &_arcgisutils_sfc_polygon_impl, 1}, {"_arcgisutils_sfg_multipolygon_inner_impl", (DL_FUNC) &_arcgisutils_sfg_multipolygon_inner_impl, 1}, {"_arcgisutils_sfg_multipolygon_impl", (DL_FUNC) &_arcgisutils_sfg_multipolygon_impl, 1}, - {"_arcgisutils_sfc_multipolygon_impl", (DL_FUNC) &_arcgisutils_sfc_multipolygon_impl, 1}, {"_arcgisutils_transpose_impl", (DL_FUNC) &_arcgisutils_transpose_impl, 2}, {NULL, NULL, 0} }; diff --git a/src/esri-geometry.cpp b/src/esri-geometry.cpp index a282f21..6dff13f 100644 --- a/src/esri-geometry.cpp +++ b/src/esri-geometry.cpp @@ -282,21 +282,21 @@ List sfg_multipolygon_impl(List mply) { } -// [[Rcpp::export]] -List sfc_multipolygon_impl(List mply) { +// // [[Rcpp::export]] +// List sfc_multipolygon_impl(List mply) { - int n = mply.length(); +// int n = mply.length(); - // preallocate result list - // each MULTIPOLYGON feature - List res(n); +// // preallocate result list +// // each MULTIPOLYGON feature +// List res(n); - for (int i = 0; i < n; i++) { - List mpoly = mply[i]; - res[i] = sfg_multipolygon_impl(mpoly); - } +// for (int i = 0; i < n; i++) { +// List mpoly = mply[i]; +// res[i] = sfg_multipolygon_impl(mpoly); +// } - return res; +// return res; -} +// } diff --git a/tests/testthat/test-rbind-results.R b/tests/testthat/test-rbind-results.R index 24cc9ca..360b320 100644 --- a/tests/testthat/test-rbind-results.R +++ b/tests/testthat/test-rbind-results.R @@ -24,22 +24,19 @@ test_that("rbind data.frames", { }) test_that("rbind NULL & list(NULL)", { - # should return empty df res <- rbind_results(NULL) - expect_identical(res, data.frame()) + expect_identical(res, structure(data.frame(), null_elements = integer())) # one null res <- rbind_results(list(NULL)) - expect_identical(res, data.frame()) + expect_identical(res, structure(data.frame(), null_elements = 1L)) # multiple res <- rbind_results(list(NULL, NULL)) - expect_identical(res, data.frame()) + expect_identical(res, structure(data.frame(), null_elements = 1:2)) }) test_that("rbind errors on non-df objects", { expect_error(rbind_results(list(iris, NULL, "a"))) }) - -