Merge pull request #1396 from r-spatial/gpkg

support writing aspatial tables with st_write()

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",

NEWS.md

@@ -1,10 +1,14 @@
 # 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
+
 * the default for `stringsAsFactors` in `st_read` and `st_sf` is FALSE for R version > 4.1.0
 
 # 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
 

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) {

R/read.R

@@ -151,8 +151,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
@@ -432,8 +432,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)
@@ -459,14 +466,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"))
@@ -479,7 +488,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

README.md

@@ -1,5 +1,5 @@
 <!-- badges: start -->
-[![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)

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},

src/gdal_write.cpp

@@ -152,7 +152,8 @@ void SetFields(OGRFeature *poFeature, std::vector<OGRFieldType> 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<OGRGeometry *> geomv = ogr_from_sfc(geom, &sref);
-	sref = handle_axis_order(sref);
+	std::vector<OGRGeometry *> geomv; 
+	OGRwkbGeometryType wkbType;
+	if (! write_geometries) { // write an aspatial table, see #1345
+		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<OGRFieldType> 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<std::string>(fids[i]), NULL, 10));
 		if (poLayer->CreateFeature(poFeature) != OGRERR_NONE) {

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)", {

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")
+})