From 2a89741c3b3c1cd3865555c4a727f64bf0bd8a9d Mon Sep 17 00:00:00 2001 From: edzer Date: Tue, 16 Jan 2024 14:55:30 +0100 Subject: [PATCH] fixes #2313 --- R/RcppExports.R | 8 +++---- R/geom-measures.R | 2 +- R/init.R | 2 +- R/proj.R | 26 +++++++++++++++------- man/proj_tools.Rd | 8 ++++--- man/st_transform.Rd | 2 +- src/RcppExports.cpp | 17 ++++++++------- src/proj.cpp | 47 +++++++++++++++++++++------------------- tests/spatstat.Rout.save | 8 +++---- 9 files changed, 68 insertions(+), 52 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 56174ff6a..aa9e80abf 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -301,8 +301,8 @@ CPL_get_pipelines <- function(crs, authority, AOI, Use, grid_availability, accur .Call(`_sf_CPL_get_pipelines`, crs, authority, AOI, Use, grid_availability, accuracy, strict_containment, axis_order_auth_compl) } -CPL_get_data_dir <- function(b = FALSE) { - .Call(`_sf_CPL_get_data_dir`, b) +CPL_get_data_dir <- function(from_proj = FALSE) { + .Call(`_sf_CPL_get_data_dir`, from_proj) } CPL_is_network_enabled <- function(b = FALSE) { @@ -313,8 +313,8 @@ CPL_enable_network <- function(url, enable = TRUE) { .Call(`_sf_CPL_enable_network`, url, enable) } -CPL_set_data_dir <- function(data_dir) { - .Call(`_sf_CPL_set_data_dir`, data_dir) +CPL_set_data_dir <- function(data_dir, with_proj) { + .Call(`_sf_CPL_set_data_dir`, data_dir, with_proj) } CPL_use_proj4_init_rules <- function(v) { diff --git a/R/geom-measures.R b/R/geom-measures.R index 97f22e5ce..4c85df450 100644 --- a/R/geom-measures.R +++ b/R/geom-measures.R @@ -128,7 +128,7 @@ st_perimeter = function(x, ...) { if (!requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") # note that units are handled appropriately by lwgeom - lwgeom::st_perimeter(x) + lwgeom::st_perimeter_lwgeom(x) } } diff --git a/R/init.R b/R/init.R index a29f96320..8152e3485 100644 --- a/R/init.R +++ b/R/init.R @@ -92,7 +92,7 @@ load_gdal <- function() { if (!identical(Sys.getenv("R_SF_USE_PROJ_DATA"), "true")) { if (file.exists(prj <- system.file("proj", package = "sf")[1])) { # nocov start - if (! CPL_set_data_dir(prj)) { # if TRUE, uses C API to set path, leaving PROJ_LIB / PROJ_DATA alone + if (! sf_proj_search_paths(prj)) { # if TRUE, uses C API to set path, leaving PROJ_LIB / PROJ_DATA alone save_and_replace("PROJ_LIB", prj, .sf_cache) save_and_replace("PROJ_DATA", prj, .sf_cache) } diff --git a/R/proj.R b/R/proj.R index ee217998d..3b9a3acd0 100644 --- a/R/proj.R +++ b/R/proj.R @@ -3,7 +3,7 @@ #' @param type character; one of `have_datum_files`, `proj`, `ellps`, `datum`, `units`, `path`, or `prime_meridians`; see Details. #' @param path character; PROJ search path to be set #' @export -#' @details \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). +#' @details \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). `path` returns the `PROJ_INFO.searchpath` field directly, as a single string with path separaters (`:` or `;`). #' #' for PROJ >= 6, \code{sf_proj_info} does not provide option \code{type = "datums"}. #' PROJ < 6 does not provide the option \code{type = "prime_meridians"}. @@ -18,10 +18,10 @@ sf_proj_info = function(type = "proj", path) { return(CPL_have_datum_files(0)) if (type == "path") - return(CPL_get_data_dir(FALSE)) + return(CPL_get_data_dir(TRUE)) if (!missing(path) && is.character(path)) - return(invisible(unique(CPL_set_data_dir(path)))) + return(invisible(unique(CPL_set_data_dir(path, TRUE)))) if (type == "network") return(CPL_is_network_enabled(TRUE)) @@ -81,16 +81,26 @@ sf_project = function(from = character(0), to = character(0), pts, keep = FALSE, #' Manage PROJ settings #' -#' Manage PROJ search path and network settings -#' @param paths the search path to be set; omit if no paths need to be set +#' Query or manage PROJ search path and network settings +#' @param paths the search path to be set; omit if paths need to be queried +#' @param with_proj logical; if `NA` set for both GDAL and PROJ, otherwise set either for PROJ (TRUE) or GDAL (FALSE) #' @return `sf_proj_search_paths()` returns the search path (possibly after setting it) #' @name proj_tools #' @export -sf_proj_search_paths = function(paths = character(0)) { +sf_proj_search_paths = function(paths = character(0), with_proj = NA) { if (length(paths) == 0) CPL_get_data_dir(FALSE) - else - CPL_set_data_dir(as.character(paths)) # set + else { + if (is.na(with_proj) || !isTRUE(with_proj)) + CPL_set_data_dir(as.character(paths), FALSE) # set GDAL + if (is.na(with_proj) || isTRUE(with_proj)) { # set for PROJ + if (length(paths) > 1) { + paths = paste0(paths, collapse = .Platform$path.sep) + message(paste("setting proj path(s) to", paths)) + } + CPL_set_data_dir(as.character(paths), TRUE) + } + } } #' @param enable logical; set this to enable (TRUE) or disable (FALSE) the proj network search facility diff --git a/man/proj_tools.Rd b/man/proj_tools.Rd index f23ddc066..26454aa55 100644 --- a/man/proj_tools.Rd +++ b/man/proj_tools.Rd @@ -7,7 +7,7 @@ \alias{sf_proj_pipelines} \title{Manage PROJ settings} \usage{ -sf_proj_search_paths(paths = character(0)) +sf_proj_search_paths(paths = character(0), with_proj = NA) sf_proj_network(enable = FALSE, url = character(0)) @@ -24,7 +24,9 @@ sf_proj_pipelines( ) } \arguments{ -\item{paths}{the search path to be set; omit if no paths need to be set} +\item{paths}{the search path to be set; omit if paths need to be queried} + +\item{with_proj}{logical; if \code{NA} set for both GDAL and PROJ, otherwise set either for PROJ (TRUE) or GDAL (FALSE)} \item{enable}{logical; set this to enable (TRUE) or disable (FALSE) the proj network search facility} @@ -74,5 +76,5 @@ vector with the URL of the CDN used (or specified with \code{url}). pipelines along with their accuracy; \code{NA} accuracy indicates ballpark accuracy. } \description{ -Manage PROJ search path and network settings +Query or manage PROJ search path and network settings } diff --git a/man/st_transform.Rd b/man/st_transform.Rd index 526f2005f..f848bad26 100644 --- a/man/st_transform.Rd +++ b/man/st_transform.Rd @@ -101,7 +101,7 @@ The \code{st_transform} method for \code{sfg} objects assumes that the CRS of th For a discussion of using \code{options}, see \url{https://github.com/r-spatial/sf/issues/280} and \url{https://github.com/r-spatial/sf/issues/1983} -\code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). +\code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). \code{path} returns the \code{PROJ_INFO.searchpath} field directly, as a single string with path separaters (\code{:} or \verb{;}). for PROJ >= 6, \code{sf_proj_info} does not provide option \code{type = "datums"}. PROJ < 6 does not provide the option \code{type = "prime_meridians"}. diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 389f86fca..1b7adf161 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1053,13 +1053,13 @@ BEGIN_RCPP END_RCPP } // CPL_get_data_dir -Rcpp::CharacterVector CPL_get_data_dir(bool b); -RcppExport SEXP _sf_CPL_get_data_dir(SEXP bSEXP) { +Rcpp::CharacterVector CPL_get_data_dir(bool from_proj); +RcppExport SEXP _sf_CPL_get_data_dir(SEXP from_projSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< bool >::type b(bSEXP); - rcpp_result_gen = Rcpp::wrap(CPL_get_data_dir(b)); + Rcpp::traits::input_parameter< bool >::type from_proj(from_projSEXP); + rcpp_result_gen = Rcpp::wrap(CPL_get_data_dir(from_proj)); return rcpp_result_gen; END_RCPP } @@ -1087,13 +1087,14 @@ BEGIN_RCPP END_RCPP } // CPL_set_data_dir -Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir); -RcppExport SEXP _sf_CPL_set_data_dir(SEXP data_dirSEXP) { +Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj); +RcppExport SEXP _sf_CPL_set_data_dir(SEXP data_dirSEXP, SEXP with_projSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type data_dir(data_dirSEXP); - rcpp_result_gen = Rcpp::wrap(CPL_set_data_dir(data_dir)); + Rcpp::traits::input_parameter< bool >::type with_proj(with_projSEXP); + rcpp_result_gen = Rcpp::wrap(CPL_set_data_dir(data_dir, with_proj)); return rcpp_result_gen; END_RCPP } @@ -1534,7 +1535,7 @@ static const R_CallMethodDef CallEntries[] = { {"_sf_CPL_get_data_dir", (DL_FUNC) &_sf_CPL_get_data_dir, 1}, {"_sf_CPL_is_network_enabled", (DL_FUNC) &_sf_CPL_is_network_enabled, 1}, {"_sf_CPL_enable_network", (DL_FUNC) &_sf_CPL_enable_network, 2}, - {"_sf_CPL_set_data_dir", (DL_FUNC) &_sf_CPL_set_data_dir, 1}, + {"_sf_CPL_set_data_dir", (DL_FUNC) &_sf_CPL_set_data_dir, 2}, {"_sf_CPL_use_proj4_init_rules", (DL_FUNC) &_sf_CPL_use_proj4_init_rules, 1}, {"_sf_CPL_proj_version", (DL_FUNC) &_sf_CPL_proj_version, 1}, {"_sf_CPL_proj_is_valid", (DL_FUNC) &_sf_CPL_proj_is_valid, 1}, diff --git a/src/proj.cpp b/src/proj.cpp index e1cd30702..e235ca73c 100644 --- a/src/proj.cpp +++ b/src/proj.cpp @@ -185,22 +185,20 @@ Rcpp::DataFrame CPL_get_pipelines(Rcpp::CharacterVector crs, Rcpp::CharacterVect } // [[Rcpp::export]] -Rcpp::CharacterVector CPL_get_data_dir(bool b = false) { - Rcpp::CharacterVector ret(2); - ret[0] = proj_info().searchpath; +Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) { + if (from_proj) { + Rcpp::CharacterVector ret(proj_info().searchpath); + return ret; + } else { #if GDAL_VERSION_NUM >= 3000300 - char **ogr_sp = OSRGetPROJSearchPaths(); - Rcpp::CharacterVector ogr_sp_sf = charpp2CV(ogr_sp); - ret[1] = ogr_sp_sf[0]; - CSLDestroy(ogr_sp); + char **ogr_sp = OSRGetPROJSearchPaths(); + Rcpp::CharacterVector ogr_sp_sf = charpp2CV(ogr_sp); + CSLDestroy(ogr_sp); + return ogr_sp_sf; #else - ret[1] = "requires GDAL >= 3.0.3"; + Rcpp::stop("requires GDAL >= 3.0.3"); #endif - Rcpp::CharacterVector nms(2); - nms(0) = "PROJ"; - nms(1) = "GDAL"; - ret.attr("names") = nms; - return ret; + } } // [[Rcpp::export]] @@ -240,16 +238,21 @@ Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable } // [[Rcpp::export]] -Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir) { - if (data_dir.size() != 1) - Rcpp::stop("data_dir should be size 1 character vector"); // #nocov - std::string dd = Rcpp::as(data_dir); - const char *cp = dd.c_str(); - proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp); +Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj) { + if (with_proj) { + if (data_dir.size() != 1) + Rcpp::stop("data_dir should be size 1 character vector"); // #nocov + std::string dd = Rcpp::as(data_dir); + const char *cp = dd.c_str(); + proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp); + } else { #if GDAL_VERSION_NUM >= 3000000 - std::vector dirs = create_options(data_dir, true); - OSRSetPROJSearchPaths(dirs.data()); + std::vector dirs = create_options(data_dir, true); + OSRSetPROJSearchPaths(dirs.data()); +#else + Rcpp::stop("setting proj search path for GDAL requires GDAL >= 3.0.0"); #endif + } return true; } @@ -452,7 +455,7 @@ Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable #endif } -Rcpp::CharacterVector CPL_get_data_dir(bool b = false) { +Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) { #if PROJ_VERSION_MAJOR >= 7 return Rcpp::CharacterVector(proj_info().searchpath); #else diff --git a/tests/spatstat.Rout.save b/tests/spatstat.Rout.save index ea11f9e34..6a9f289a5 100644 --- a/tests/spatstat.Rout.save +++ b/tests/spatstat.Rout.save @@ -1,5 +1,5 @@ -R version 4.3.1 (2023-06-16) -- "Beagle Scouts" +R version 4.3.2 (2023-10-31) -- "Eye Holes" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) @@ -144,9 +144,9 @@ First 10 features: 8 point POINT (843278.5 287241.6) 9 point POINT (648477.7 235466.6) 10 point POINT (852593 267248.3) -Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon) : +Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon, : rthomas is not an exported function from spatstat.random. -Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon) : +Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon, : The spatstat function rThomas did not return a valid result. Consult the help file. Error message from spatstat: Error in spatstat_fun(..., win = spatstat.geom::as.owin(x)) : @@ -166,4 +166,4 @@ In st_as_sfc.owin(spatstat.geom::as.owin(x)) : > > proc.time() user system elapsed - 2.011 0.116 2.121 + 2.039 1.402 1.935