adjust examples and tests for stream reading

Author: edzer

R/cast_sfg.R

@@ -43,7 +43,7 @@ ClosePol <- function(mtrx) {
 #' @examples 
 #' # example(st_read)
 #' nc = st_read(system.file("shape/nc.shp", package="sf"))
-#' mpl <- nc$geometry[[4]]
+#' mpl <- st_geometry(nc)[[4]]
 #' #st_cast(x) ## error 'argument "to" is missing, with no default'
 #' cast_all <- function(xg) {
 #'   lapply(c("MULTIPOLYGON", "MULTILINESTRING", "MULTIPOINT", "POLYGON", "LINESTRING", "POINT"), 
@@ -81,7 +81,7 @@ st_cast.MULTIPOLYGON <- function(x, to, ...) {
 #' @name st_cast
 #' @export
 #' @examples 
-#' mls <- st_cast(nc$geometry[[4]], "MULTILINESTRING")
+#' mls <- st_cast(st_geometry(nc)[[4]], "MULTILINESTRING")
 #' st_sfc(cast_all(mls))
 st_cast.MULTILINESTRING <- function(x, to, ...) {
 	switch(to, 
@@ -108,7 +108,7 @@ st_cast.MULTILINESTRING <- function(x, to, ...) {
 #' @name st_cast
 #' @export
 #' @examples
-#' mpt <- st_cast(nc$geometry[[4]], "MULTIPOINT")
+#' mpt <- st_cast(st_geometry(nc)[[4]], "MULTIPOINT")
 #' st_sfc(cast_all(mpt))
 st_cast.MULTIPOINT <- function(x, to, ...) {
   switch(to, 
@@ -135,7 +135,7 @@ st_cast.MULTIPOINT <- function(x, to, ...) {
 #' @name st_cast
 #' @export
 #' @examples
-#' pl <- st_cast(nc$geometry[[4]], "POLYGON")
+#' pl <- st_cast(st_geometry(nc)[[4]], "POLYGON")
 #' st_sfc(cast_all(pl))
 st_cast.POLYGON <- function(x, to, ...) {
   switch(to, 
@@ -156,7 +156,7 @@ st_cast.POLYGON <- function(x, to, ...) {
 #' @name st_cast
 #' @export
 #' @examples
-#' ls <- st_cast(nc$geometry[[4]], "LINESTRING")
+#' ls <- st_cast(st_geometry(nc)[[4]], "LINESTRING")
 #' st_sfc(cast_all(ls))
 st_cast.LINESTRING <- function(x, to, ...) {
   switch(to, 
@@ -173,7 +173,7 @@ st_cast.LINESTRING <- function(x, to, ...) {
 #' @name st_cast
 #' @export
 #' @examples
-#' pt <- st_cast(nc$geometry[[4]], "POINT")
+#' pt <- st_cast(st_geometry(nc)[[4]], "POINT")
 #' ## st_sfc(cast_all(pt))  ## Error: cannot create MULTIPOLYGON from POINT 
 #' st_sfc(lapply(c("POINT", "MULTIPOINT"), function(x) st_cast(pt, x)))
 st_cast.POINT <- function(x, to, ...) {

R/read.R

@@ -238,10 +238,10 @@ process_cpl_read_ogr_stream = function(x, default_crs, num_features, fid_column_
 		st_set_crs(x, crs)	
 	})
 
-	# Prefer "geometry" as the geometry column name
-	if (any(is_geometry_column) && !("geometry" %in% names(df))) {
-		names(df)[which(is_geometry_column)[1]] = "geometry"
-	}
+#	# Prefer "geometry" as the geometry column name
+#	if (any(is_geometry_column) && !("geometry" %in% names(df))) {
+#		names(df)[which(is_geometry_column)[1]] = "geometry"
+#	}
 
 	# Rename OGC_FID to fid_column_name and move to end
 	if (length(fid_column_name) == 1 && "OGC_FID" %in% names(df)) {
@@ -250,9 +250,11 @@ process_cpl_read_ogr_stream = function(x, default_crs, num_features, fid_column_
 	}
 
 	# Move geometry to the end
-	if ("geometry" %in% names(df)) {
-		df <- df[c(setdiff(names(df), "geometry"), "geometry")]
-	}
+#	if ("geometry" %in% names(df)) {
+#		df <- df[c(setdiff(names(df), "geometry"), "geometry")]
+#	}
+	gc1 = which(is_geometry_column)[1]
+	df = df[c(setdiff(seq_along(df), gc1), gc1)]
 
 	process_cpl_read_ogr(df, ...)
 }

R/tidyverse.R

@@ -129,7 +129,6 @@ mutate.sf <- function(.data, ..., .dots) {
 #' @name tidyverse
 #' @examples
 #' if (require(dplyr, quietly = TRUE)) {
-#'  nc %>% transmute(AREA = AREA/10, geometry = geometry) %>% class()
 #'  nc %>% transmute(AREA = AREA/10) %>% class()
 #' }
 transmute.sf <- function(.data, ..., .dots) {
@@ -144,9 +143,7 @@ transmute.sf <- function(.data, ..., .dots) {
 #' @examples
 #' if (require(dplyr, quietly = TRUE)) {
 #'  nc %>% select(SID74, SID79) %>% names()
-#'  nc %>% select(SID74, SID79, geometry) %>% names()
 #'  nc %>% select(SID74, SID79) %>% class()
-#'  nc %>% select(SID74, SID79, geometry) %>% class()
 #' }
 #' @details \code{select} keeps the geometry regardless whether it is selected or not; to deselect it, first pipe through \code{as.data.frame} to let dplyr's own \code{select} drop it.
 select.sf <- function(.data, ...) {
@@ -391,7 +388,7 @@ distinct.sf <- function(.data, ..., .keep_all = FALSE) {
 #' @param na.rm see original function docs
 #' @param factor_key see original function docs
 #' @examples
-#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE)) {
+#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) {
 #'  nc %>% select(SID74, SID79) %>% gather("VAR", "SID", -geometry) %>% summary()
 #' }
 gather.sf <- function(data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE) {
@@ -527,7 +524,7 @@ pivot_wider.sf = function(data,
 #' @param fill see original function docs
 #' @param drop see original function docs
 #' @examples
-#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE)) {
+#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) {
 #'  nc$row = 1:100 # needed for spread to work
 #'  nc %>% select(SID74, SID79, geometry, row) %>%
 #'		gather("VAR", "SID", -geometry, -row) %>%

R/transform.R

@@ -25,6 +25,7 @@ chk_mpol = function(x) {
 sanity_check = function(x) {
 	d = st_dimension(x) # flags empty geoms as NA
 	if (any(d == 2, na.rm = TRUE)) { # the polygon stuff
+		x = st_cast(x[d == 2]) # convert GEOMETRY to POLYGON or MULTIPOLYGON, if possible
 		if (inherits(x, "sfc_POLYGON"))
 			st_sfc(lapply(x, chk_pol), crs = st_crs(x))
 		else if (inherits(x, "sfc_MULTIPOLYGON"))

man/st_cast.Rd

@@ -4,6 +4,13 @@ if (require(dplyr, quietly = TRUE)) {
  options(dplyr.summarise.inform=FALSE)
  read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE) %>%
 	st_transform(3857) -> nc
+ if ((gc <- attr(nc, "sf_column")) != "geometry") {
+   nc$geometry = st_geometry(nc)
+   nc = as.data.frame(nc)
+   nc[gc] = NULL
+   nc = st_as_sf(nc)
+ }
+ nc = st_as_sf(nc, sf_column_name = "geometry")
  nc %>% filter(AREA > .1) %>% plot()
 
 # plot 10 smallest counties in grey:

man/tidyverse.Rd

@@ -71,9 +71,11 @@ plot(nc)
 plot(nc, axes = TRUE)
 plot(nc, col="lightgrey") 
 plot(st_centroid(nc), add = TRUE, col = 1)
-nc %>% 
+if ("geometry" %in% names(nc)) {
+ nc %>% 
   select(geometry) %>% 
   plot()
+}
 
 nc$f = cut(nc[[1]], 5)
 plot(nc["f"], key.pos = 1)