From bbf95cfd3d515f314ce4400bd6666fa3fe2623df Mon Sep 17 00:00:00 2001 From: Edzer Pebesma Date: Sat, 16 May 2020 15:47:03 +0200 Subject: [PATCH 1/4] support writing aspatial tables with st_write() addresses #1345 --- R/RcppExports.R | 4 ++-- R/read.R | 23 ++++++++++++++++++----- src/RcppExports.cpp | 9 +++++---- src/gdal_write.cpp | 33 ++++++++++++++++++++++++--------- 4 files changed, 49 insertions(+), 20 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index ec77e4278..36655e0ad 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -141,8 +141,8 @@ CPL_gdal_warper <- function(infile, outfile, options, oo, doo) { .Call('_sf_CPL_gdal_warper', PACKAGE = 'sf', infile, outfile, options, oo, doo) } -CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn = FALSE, delete_layer = FALSE) { - .Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn, delete_layer) +CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn = FALSE, delete_layer = FALSE, write_geometries = TRUE) { + .Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn, delete_layer, write_geometries) } CPL_geos_binop <- function(sfc0, sfc1, op, par = 0.0, pattern = "", prepared = FALSE) { diff --git a/R/read.R b/R/read.R index 48d85d1b9..1c03603be 100644 --- a/R/read.R +++ b/R/read.R @@ -424,8 +424,15 @@ st_write.sf = function(obj, dsn, layer = NULL, ..., # this seems to be always a good idea: dsn = enc2utf8(dsn) - geom = st_geometry(obj) - obj[[attr(obj, "sf_column")]] = NULL + # handle the case where obj does not have a geometry column: + if (write_geometries <- inherits(obj, "sf")) { + geom = st_geometry(obj) + obj[[attr(obj, "sf_column")]] = NULL + } else { # create fake geometries: + v = vector("list", nrow(obj)) + v[seq_len(nrow(obj))] = list(st_point()) + geom = st_sfc(v) + } if (driver == "ESRI Shapefile") { # remove trailing .shp from layer name layer = sub(".shp$", "", layer) @@ -451,14 +458,16 @@ st_write.sf = function(obj, dsn, layer = NULL, ..., ret = CPL_write_ogr(obj, dsn, layer, driver, as.character(dataset_options), as.character(layer_options), - geom, dim, fids, quiet, append, delete_dsn, delete_layer) + geom, dim, fids, quiet, append, delete_dsn, delete_layer, + write_geometries) if (ret == 1) { # try through temp file: tmp = tempfile(fileext = paste0(".", tools::file_ext(dsn))) # nocov start if (!quiet) message(paste("writing first to temporary file", tmp)) if (CPL_write_ogr(obj, tmp, layer, driver, as.character(dataset_options), as.character(layer_options), - geom, dim, fids, quiet, append, delete_dsn, delete_layer) == 1) + geom, dim, fids, quiet, append, delete_dsn, delete_layer, + write_geometries) == 1) stop(paste("failed writing to temporary file", tmp)) if (!file.copy(tmp, dsn, overwrite = append || delete_dsn || delete_layer)) stop(paste("copying", tmp, "to", dsn, "failed")) @@ -471,7 +480,11 @@ st_write.sf = function(obj, dsn, layer = NULL, ..., #' @name st_write #' @export st_write.data.frame <- function(obj, dsn, layer = NULL, ...) { - st_write.sf(obj = st_as_sf(obj), dsn = dsn, layer = layer, ...) + sf = try(st_as_sf(obj), silent = TRUE) + if (!inherits(sf, "try-error")) + st_write.sf(sf, dsn = dsn, layer = layer, ...) + else + st_write.sf(obj, dsn = dsn, layer = layer, ...) } #' @name st_write diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 198a988ca..5357693ca 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -451,8 +451,8 @@ BEGIN_RCPP END_RCPP } // CPL_write_ogr -int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, Rcpp::CharacterVector dco, Rcpp::CharacterVector lco, Rcpp::List geom, Rcpp::CharacterVector dim, Rcpp::CharacterVector fids, bool quiet, Rcpp::LogicalVector append, bool delete_dsn, bool delete_layer); -RcppExport SEXP _sf_CPL_write_ogr(SEXP objSEXP, SEXP dsnSEXP, SEXP layerSEXP, SEXP driverSEXP, SEXP dcoSEXP, SEXP lcoSEXP, SEXP geomSEXP, SEXP dimSEXP, SEXP fidsSEXP, SEXP quietSEXP, SEXP appendSEXP, SEXP delete_dsnSEXP, SEXP delete_layerSEXP) { +int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, Rcpp::CharacterVector dco, Rcpp::CharacterVector lco, Rcpp::List geom, Rcpp::CharacterVector dim, Rcpp::CharacterVector fids, bool quiet, Rcpp::LogicalVector append, bool delete_dsn, bool delete_layer, bool write_geometries); +RcppExport SEXP _sf_CPL_write_ogr(SEXP objSEXP, SEXP dsnSEXP, SEXP layerSEXP, SEXP driverSEXP, SEXP dcoSEXP, SEXP lcoSEXP, SEXP geomSEXP, SEXP dimSEXP, SEXP fidsSEXP, SEXP quietSEXP, SEXP appendSEXP, SEXP delete_dsnSEXP, SEXP delete_layerSEXP, SEXP write_geometriesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -469,7 +469,8 @@ BEGIN_RCPP Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type append(appendSEXP); Rcpp::traits::input_parameter< bool >::type delete_dsn(delete_dsnSEXP); Rcpp::traits::input_parameter< bool >::type delete_layer(delete_layerSEXP); - rcpp_result_gen = Rcpp::wrap(CPL_write_ogr(obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn, delete_layer)); + Rcpp::traits::input_parameter< bool >::type write_geometries(write_geometriesSEXP); + rcpp_result_gen = Rcpp::wrap(CPL_write_ogr(obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, append, delete_dsn, delete_layer, write_geometries)); return rcpp_result_gen; END_RCPP } @@ -1174,7 +1175,7 @@ static const R_CallMethodDef CallEntries[] = { {"_sf_CPL_gdalnearblack", (DL_FUNC) &_sf_CPL_gdalnearblack, 5}, {"_sf_CPL_gdalgrid", (DL_FUNC) &_sf_CPL_gdalgrid, 4}, {"_sf_CPL_gdal_warper", (DL_FUNC) &_sf_CPL_gdal_warper, 5}, - {"_sf_CPL_write_ogr", (DL_FUNC) &_sf_CPL_write_ogr, 13}, + {"_sf_CPL_write_ogr", (DL_FUNC) &_sf_CPL_write_ogr, 14}, {"_sf_CPL_geos_binop", (DL_FUNC) &_sf_CPL_geos_binop, 6}, {"_sf_CPL_geos_is_valid_reason", (DL_FUNC) &_sf_CPL_geos_is_valid_reason, 1}, {"_sf_CPL_geos_make_valid", (DL_FUNC) &_sf_CPL_geos_make_valid, 1}, diff --git a/src/gdal_write.cpp b/src/gdal_write.cpp index 8a31c4439..cbdaa7f5d 100644 --- a/src/gdal_write.cpp +++ b/src/gdal_write.cpp @@ -152,7 +152,8 @@ void SetFields(OGRFeature *poFeature, std::vector tp, Rcpp::List o int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, Rcpp::CharacterVector dco, Rcpp::CharacterVector lco, Rcpp::List geom, Rcpp::CharacterVector dim, Rcpp::CharacterVector fids, - bool quiet, Rcpp::LogicalVector append, bool delete_dsn = false, bool delete_layer = false) { + bool quiet, Rcpp::LogicalVector append, bool delete_dsn = false, bool delete_layer = false, + bool write_geometries = true) { // init: if (driver.size() != 1 || dsn.size() != 1 || layer.size() != 1) @@ -267,12 +268,20 @@ int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVect } // #nocov end } - Rcpp::CharacterVector clsv = geom.attr("class"); - OGRwkbGeometryType wkbType = (OGRwkbGeometryType) make_type(clsv[0], dim[0], false, NULL, 0); // read geometries: OGRSpatialReference *sref = NULL; - std::vector geomv = ogr_from_sfc(geom, &sref); - sref = handle_axis_order(sref); + std::vector geomv; + OGRwkbGeometryType wkbType; + if (! write_geometries) { + wkbType = wkbNone; + for (int i = 0; i < geom.size(); i++) + geomv.push_back(NULL); + } else { + Rcpp::CharacterVector clsv = geom.attr("class"); + wkbType = (OGRwkbGeometryType) make_type(clsv[0], dim[0], false, NULL, 0); + geomv = ogr_from_sfc(geom, &sref); + sref = handle_axis_order(sref); + } // create layer: options = create_options(lco, quiet); @@ -294,15 +303,21 @@ int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVect // write feature attribute fields & geometries: std::vector fieldTypes = SetupFields(poLayer, obj, update_layer); - if (! quiet) + if (! quiet) { Rcpp::Rcout << "Writing " << geomv.size() << " features with " << - fieldTypes.size() << " fields and geometry type " << - OGRGeometryTypeToName(wkbType) << "." << std::endl; + fieldTypes.size() << " fields"; + if (write_geometries) + Rcpp::Rcout << " and geometry type " << OGRGeometryTypeToName(wkbType); + else + Rcpp::Rcout << " without geometries"; + Rcpp::Rcout << "." << std::endl; + } for (size_t i = 0; i < geomv.size(); i++) { // create all features & add to layer: OGRFeature *poFeature = OGRFeature::CreateFeature(poLayer->GetLayerDefn()); SetFields(poFeature, fieldTypes, obj, i, driver[0] == "ESRI Shapefile"); - poFeature->SetGeometryDirectly(geomv[i]); + if (write_geometries) + poFeature->SetGeometryDirectly(geomv[i]); if (fids.size() > (int) i) poFeature->SetFID(std::stoll(Rcpp::as(fids[i]), NULL, 10)); if (poLayer->CreateFeature(poFeature) != OGRERR_NONE) { From 2efbc6de8c357bb7b93b11901337f38f7a433026 Mon Sep 17 00:00:00 2001 From: Edzer Pebesma Date: Sat, 16 May 2020 17:53:47 +0200 Subject: [PATCH 2/4] bump version; update NEWS --- DESCRIPTION | 2 +- NEWS.md | 6 +++++- README.md | 2 +- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f74847826..cdf17d652 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: sf -Version: 0.9-3 +Version: 0.9-4 Title: Simple Features for R Authors@R: c(person(given = "Edzer", diff --git a/NEWS.md b/NEWS.md index 7faf3abd4..aa923ad7a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,10 @@ +# version 0.9-4 + +* `st_write` writes non-spatial tables when given a plain `data.frame` or `tbl_df`; #1345 + # version 0.9-3 -* `st_is_valid` is now a generic +* `st_is_valid` is a generic * Windows CRAN binaries use GDAL 3.0.4, PROJ 6.3.1 and GEOS 3.8.0, thanks to Jeroen Ooms' rwinlib work; #1275 diff --git a/README.md b/README.md index ca4f22864..1f180360a 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -[![R build status](https://github.com/r-spatial/sf/workflows/R-CMD-check/badge.svg)](https://github.com/r-spatial/sf) +[![R build status](https://github.com/r-spatial/sf/workflows/R-CMD-check/badge.svg)](https://github.com/r-spatial/sf/actions) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/r-spatial/sf?branch=master&svg=true)](https://ci.appveyor.com/project/edzerpebesma/sf) [![Coverage Status](https://img.shields.io/codecov/c/github/r-spatial/sf/master.svg)](https://codecov.io/github/r-spatial/sf?branch=master) [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) From d2734ea554bf4ca8690504453a0774543ab4b57c Mon Sep 17 00:00:00 2001 From: Edzer Pebesma Date: Mon, 18 May 2020 14:48:50 +0200 Subject: [PATCH 3/4] tidy --- src/gdal_write.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/gdal_write.cpp b/src/gdal_write.cpp index cbdaa7f5d..5838cf6e6 100644 --- a/src/gdal_write.cpp +++ b/src/gdal_write.cpp @@ -272,7 +272,7 @@ int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVect OGRSpatialReference *sref = NULL; std::vector geomv; OGRwkbGeometryType wkbType; - if (! write_geometries) { + if (! write_geometries) { // write an aspatial table, see #1345 wkbType = wkbNone; for (int i = 0; i < geom.size(); i++) geomv.push_back(NULL); From 76cf28724439b9ddb59c1d0b903308d7132e7f3d Mon Sep 17 00:00:00 2001 From: Edzer Pebesma Date: Mon, 18 May 2020 15:52:07 +0200 Subject: [PATCH 4/4] add regression tests; stop warning when r/w aspatial tbls --- NEWS.md | 2 ++ R/read.R | 4 ++-- tests/testthat/test_read.R | 10 +++++----- tests/testthat/test_tidy.R | 4 ++-- tests/testthat/test_write.R | 24 ++++++++++++++++++++++++ 5 files changed, 35 insertions(+), 9 deletions(-) diff --git a/NEWS.md b/NEWS.md index aa923ad7a..d7cfc28be 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # version 0.9-4 +* `write_sf` and `read_sf` no longer warn when reading tables without geometries + * `st_write` writes non-spatial tables when given a plain `data.frame` or `tbl_df`; #1345 # version 0.9-3 diff --git a/R/read.R b/R/read.R index 1c03603be..8ed665044 100644 --- a/R/read.R +++ b/R/read.R @@ -143,8 +143,8 @@ process_cpl_read_ogr = function(x, quiet = FALSE, ..., check_ring_dir = FALSE, # in case no geometry is present: if (length(which.geom) == 0) { - warning("no simple feature geometries present: returning a data.frame or tbl_df", - call. = FALSE) + if (! quiet) + warning("no simple feature geometries present: returning a data.frame or tbl_df", call. = FALSE) x = if (!as_tibble) { if (any(sapply(x, is.list))) warning("list-column(s) present: in case of failure, try read_sf or as_tibble=TRUE") # nocov diff --git a/tests/testthat/test_read.R b/tests/testthat/test_read.R index 6106e6504..d99f45e81 100644 --- a/tests/testthat/test_read.R +++ b/tests/testthat/test_read.R @@ -184,11 +184,11 @@ test_that("reading non-spatial table works", { "data.frame"), "no simple feature geometries" ) - expect_warning( - expect_is(read_sf(system.file("gpkg/nospatial.gpkg", package = "sf")), - "tbl_df"), - "no simple feature geometries" - ) +# expect_warning( +# expect_is(read_sf(system.file("gpkg/nospatial.gpkg", package = "sf")), +# "tbl_df"), +# "no simple feature geometries" +# ) }) test_that("Missing data sources have useful error message (#967)", { diff --git a/tests/testthat/test_tidy.R b/tests/testthat/test_tidy.R index e953f679c..660d3f8d7 100644 --- a/tests/testthat/test_tidy.R +++ b/tests/testthat/test_tidy.R @@ -14,9 +14,9 @@ test_that("filter to sfc works", { st_point(), st_linestring())) d = st_sf(tbl) - expect_identical(d %>% filter(!st_is_empty(geometry)), + expect_identical(d %>% filter(!st_is_empty(geometry)) %>% st_cast(), d[1, ]) - expect_identical(d %>% filter(st_is(geometry, "POINT")), + expect_identical(d %>% filter(st_is(geometry, "POINT")) %>% st_cast(), d[1:2, ]) }) diff --git a/tests/testthat/test_write.R b/tests/testthat/test_write.R index 3305c470e..4a091819e 100644 --- a/tests/testthat/test_write.R +++ b/tests/testthat/test_write.R @@ -140,3 +140,27 @@ test_that("append errors work", { system(paste("chmod +w", f)) }) + +test_that("non-spatial tables can be written to GPKG; #1345", { + nc = system.file("gpkg/nc.gpkg", package = "sf") + tf = tempfile(fileext = ".gpkg") + file.copy(nc, tf) + # how does an aspatial layer look like? NA geometry_type + l = st_layers(system.file("gpkg/nospatial.gpkg", package = "sf")) + expect_true(is.na(l$geomtype[[1]])) + # demo: + a = data.frame(a = c(1L,-3L), b = c("foo", "bar")) + expect_silent(write_sf(a, tf, + layer = "nonspatial_table1", + driver = "GPKG", + delete_layer = TRUE, + layer_options = "ASPATIAL_VARIANT=GPKG_ATTRIBUTES")) + l2 = st_layers(tf) + expect_true(is.na(l2$geomtype[[2]])) # hence is aspatial + a2 = as.data.frame(read_sf(tf, "nonspatial_table1")) + expect_identical(a, a2) + expect_output( + expect_warning(st_read(tf, "nonspatial_table1"), + "no simple feature geometries present:"), + "Reading layer `nonspatial_table1' from data source") +})