Skip to content

Commit

Permalink
accept old crs; add a fix_crs to R and C++ code; #1225
Browse files Browse the repository at this point in the history
  • Loading branch information
edzer committed Jan 11, 2020
1 parent 2161a40 commit 5ddf26d
Show file tree
Hide file tree
Showing 5 changed files with 76 additions and 44 deletions.
8 changes: 4 additions & 4 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,14 +17,14 @@ CPL_gdal_version <- function(what = "RELEASE_NAME") {
.Call('_sf_CPL_gdal_version', PACKAGE = 'sf', what)
}

CPL_crs_parameters <- function(crs) {
.Call('_sf_CPL_crs_parameters', PACKAGE = 'sf', crs)
}

CPL_wkt_from_user_input <- function(input) {
.Call('_sf_CPL_wkt_from_user_input', PACKAGE = 'sf', input)
}

CPL_crs_parameters <- function(crs) {
.Call('_sf_CPL_crs_parameters', PACKAGE = 'sf', crs)
}

CPL_crs_equivalent <- function(crs1, crs2) {
.Call('_sf_CPL_crs_equivalent', PACKAGE = 'sf', crs1, crs2)
}
Expand Down
17 changes: 15 additions & 2 deletions R/crs.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,11 +75,24 @@ st_crs.character = function(x, ...) {
}
}

fix_crs = function(x) {
if (all(c("epsg", "proj4string") %in% names(x))) {
# warning("old-style crs object detected; please recreate object with a modern sf::st_crs()")
x = unclass(x)
if (!is.na(x$epsg))
st_crs(x$epsg)
else
st_crs(x$proj4string)
} else
x
}


#' @name st_crs
#' @param parameters logical; \code{FALSE} by default; if \code{TRUE} return a list of coordinate reference system parameters, with named elements \code{SemiMajor}, \code{InvFlattening}, \code{units_gdal}, \code{IsVertical}, \code{WktPretty}, and \code{Wkt}
#' @export
st_crs.sfc = function(x, ..., parameters = FALSE) {
crs = attr(x, "crs")
crs = fix_crs(attr(x, "crs"))
if (parameters) {
if (is.na(crs))
list()
Expand Down Expand Up @@ -299,7 +312,7 @@ is.na.crs = function(x) {
x = st_crs(x[["proj4string"]]) # FIXME: should this be only for some transition period? Add test?
}
if (is.na(x))
NA
NA_character_
else if (is.numeric(name) || name %in% names(x))
x[[name]]
else {
Expand Down
4 changes: 2 additions & 2 deletions R/sfc.R
Original file line number Diff line number Diff line change
Expand Up @@ -215,8 +215,8 @@ print.sfc = function(x, ..., n = 5L, what = "Geometry set for", append = "") {
cat(paste0("geographic CRS: ", p$Name, "\n"))
else
cat(paste0("projected CRS: ", p$Name, "\n"))
if (!is.na(crs$epsg))
cat(paste0("epsg (SRID): ", crs$epsg, "\n"))
# if (!is.na(crs$epsg))
# cat(paste0("epsg (SRID): ", crs$epsg, "\n"))
}
if (attr(x, "precision") != 0.0) {
cat(paste0("precision: "))
Expand Down
22 changes: 11 additions & 11 deletions src/RcppExports.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -49,25 +49,25 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
// CPL_crs_parameters
Rcpp::List CPL_crs_parameters(Rcpp::List crs);
RcppExport SEXP _sf_CPL_crs_parameters(SEXP crsSEXP) {
// CPL_wkt_from_user_input
Rcpp::CharacterVector CPL_wkt_from_user_input(Rcpp::CharacterVector input);
RcppExport SEXP _sf_CPL_wkt_from_user_input(SEXP inputSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< Rcpp::List >::type crs(crsSEXP);
rcpp_result_gen = Rcpp::wrap(CPL_crs_parameters(crs));
Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type input(inputSEXP);
rcpp_result_gen = Rcpp::wrap(CPL_wkt_from_user_input(input));
return rcpp_result_gen;
END_RCPP
}
// CPL_wkt_from_user_input
Rcpp::CharacterVector CPL_wkt_from_user_input(Rcpp::CharacterVector input);
RcppExport SEXP _sf_CPL_wkt_from_user_input(SEXP inputSEXP) {
// CPL_crs_parameters
Rcpp::List CPL_crs_parameters(Rcpp::List crs);
RcppExport SEXP _sf_CPL_crs_parameters(SEXP crsSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type input(inputSEXP);
rcpp_result_gen = Rcpp::wrap(CPL_wkt_from_user_input(input));
Rcpp::traits::input_parameter< Rcpp::List >::type crs(crsSEXP);
rcpp_result_gen = Rcpp::wrap(CPL_crs_parameters(crs));
return rcpp_result_gen;
END_RCPP
}
Expand Down Expand Up @@ -1119,8 +1119,8 @@ static const R_CallMethodDef CallEntries[] = {
{"_sf_CPL_gdal_init", (DL_FUNC) &_sf_CPL_gdal_init, 0},
{"_sf_CPL_gdal_cleanup_all", (DL_FUNC) &_sf_CPL_gdal_cleanup_all, 0},
{"_sf_CPL_gdal_version", (DL_FUNC) &_sf_CPL_gdal_version, 1},
{"_sf_CPL_crs_parameters", (DL_FUNC) &_sf_CPL_crs_parameters, 1},
{"_sf_CPL_wkt_from_user_input", (DL_FUNC) &_sf_CPL_wkt_from_user_input, 1},
{"_sf_CPL_crs_parameters", (DL_FUNC) &_sf_CPL_crs_parameters, 1},
{"_sf_CPL_crs_equivalent", (DL_FUNC) &_sf_CPL_crs_equivalent, 2},
{"_sf_CPL_crs_from_input", (DL_FUNC) &_sf_CPL_crs_from_input, 1},
{"_sf_CPL_roundtrip", (DL_FUNC) &_sf_CPL_roundtrip, 1},
Expand Down
69 changes: 44 additions & 25 deletions src/gdal.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,51 @@ void handle_error(OGRErr err) {
}
}

Rcpp::CharacterVector wkt_from_spatial_reference(OGRSpatialReference *srs) { // FIXME: add options?
char *cp;
#if GDAL_VERSION_MAJOR >= 3
const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL };
OGRErr err = srs->exportToWkt(&cp, options);
#else
OGRErr err = srs->exportToPrettyWkt(&cp);
#endif
if (err != OGRERR_NONE)
Rcpp::stop("OGR error: cannot export to WKT");
Rcpp::CharacterVector out(cp);
CPLFree(cp);
return out;
}

// [[Rcpp::export]]
Rcpp::CharacterVector CPL_wkt_from_user_input(Rcpp::CharacterVector input) {
OGRSpatialReference *srs = new OGRSpatialReference;
srs = handle_axis_order(srs);
handle_error(srs->SetFromUserInput((const char *) input[0]));
Rcpp::CharacterVector out = wkt_from_spatial_reference(srs);
delete srs;
return(out);
}

Rcpp::List fix_old_style(Rcpp::List crs) {
Rcpp::CharacterVector n = crs.attr("names");
if (n[0] == "epsg") { // create new:
Rcpp::List ret(2);
Rcpp::CharacterVector proj4string = crs[1];
ret[0] = proj4string[0];
ret[1] = CPL_wkt_from_user_input(proj4string);
Rcpp::CharacterVector names(2);
names(0) = "input";
names(1) = "wkt";
ret.attr("names") = names;
ret.attr("class") = "crs";
return ret;
} else
return crs;
}

OGRSpatialReference *OGRSrs_from_crs(Rcpp::List crs) {
// fix old-style crs:
crs = fix_old_style(crs);
OGRSpatialReference *dest = NULL;
Rcpp::CharacterVector wkt = crs[1];
if (! Rcpp::CharacterVector::is_na(wkt[0])) {
Expand Down Expand Up @@ -224,31 +268,6 @@ int epsg_from_crs(Rcpp::List crs) {
return(NA_INTEGER);
}

Rcpp::CharacterVector wkt_from_spatial_reference(OGRSpatialReference *srs) { // FIXME: add options?
char *cp;
#if GDAL_VERSION_MAJOR >= 3
const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL };
OGRErr err = srs->exportToWkt(&cp, options);
#else
OGRErr err = srs->exportToPrettyWkt(&cp);
#endif
if (err != OGRERR_NONE)
Rcpp::stop("OGR error: cannot export to WKT");
Rcpp::CharacterVector out(cp);
CPLFree(cp);
return out;
}

// [[Rcpp::export]]
Rcpp::CharacterVector CPL_wkt_from_user_input(Rcpp::CharacterVector input) {
OGRSpatialReference *srs = new OGRSpatialReference;
srs = handle_axis_order(srs);
handle_error(srs->SetFromUserInput((const char *) input[0]));
Rcpp::CharacterVector out = wkt_from_spatial_reference(srs);
delete srs;
return(out);
}

// [[Rcpp::export]]
Rcpp::LogicalVector CPL_crs_equivalent(Rcpp::List crs1, Rcpp::List crs2) {

Expand Down

0 comments on commit 5ddf26d

Please sign in to comment.