closes #1961

Author: edzer

NEWS.md

@@ -1,5 +1,7 @@
 # version 1.0-13
 
+* `st_cast()` handles empty geometries; #1961
+
 * don't repeat longlat messages in `summarise.sf()`; #1519
 
 * fix random sampling on the sphere; #2133

R/cast_sfc.R

@@ -135,6 +135,18 @@ copy_sfc_attributes_from = function(x, ret) {
 		bbox = attr(x, "bbox"), crs = attr(x, "crs"), n_empty = attr(x, "n_empty"))
 }
 
+empty_sfg <- function(to) {
+	switch(to,
+		   GEOMETRYCOLLECTION = st_geometrycollection(),
+		   MULTIPOLYGON = st_multipolygon(),
+		   POLYGON = st_polygon(),
+		   MULTILINESTRING = st_multilinestring(),
+		   LINESTRING = st_linestring(),
+		   MULTIPOINT = st_multipoint(),
+		   POINT = st_point()
+	   )
+}
+
 
 #' @name st_cast
 #' @param ids integer vector, denoting how geometries should be grouped (default: no grouping)
@@ -148,10 +160,20 @@ st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) {
 	if (missing(to))
 		return(st_cast_sfc_default(x))
 
+	e = rep(FALSE, length(x))
+	if (!inherits(x, c("sfc_MULTICURVE", "sfc_COMPOUNDCURVE"))) {
+		e = st_is_empty(x)
+		if (all(e)) {
+			x[e] = empty_sfg(to)
+			return(x) # RETURNS
+		}
+	}
+	if (any(e))
+		x = x[!e]
 	from_cls = substr(class(x)[1], 5, 100)
 	from_col = which_sfc_col(from_cls)
 	to_col = which_sfc_col(to)
-	if (from_cls == to)
+	ret = if (from_cls == to)
 		x # returns x: do nothing
 	else if (to == "GEOMETRY") # we can always do that:
 		structure(x, class = c("sfc_GEOMETRY", "sfc"))
@@ -201,6 +223,14 @@ st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) {
 		# EJP: FIXME:
 		structure(reclass(ret, to, need_close(to)), ids = get_lengths(x))
 	}
+	if (any(e)) {
+		crs = st_crs(x)
+		x = vector("list", length = length(e))
+		x[e] = list(empty_sfg(to))
+		x[!e] = ret
+		st_set_crs(do.call(st_sfc, x), crs)
+	} else
+		ret
 }
 
 #' @name st_cast

tests/cast.R

@@ -18,9 +18,9 @@ st_cast(pol, "MULTILINESTRING")
 (pt = st_cast(mp, "POINT"))
 (i = attr(pt, "ids"))
 (xx = st_cast(pt, "MULTIPOINT", rep(seq_along(i), i)))
-(yy = st_cast(pt, "LINESTRING", rep(seq_along(i), i)))
+try(yy <- st_cast(pt, "LINESTRING", rep(seq_along(i), i)))
 
-(zz = st_cast(yy, "MULTILINESTRING"))
+#(zz = st_cast(yy, "MULTILINESTRING"))
 #(zz = st_cast(yy, "POLYGON"))
 
 st_cast(mls, "LINESTRING")
@@ -83,3 +83,6 @@ g <- st_as_sfc(wkt)
 g <- st_sf(demo = "test", geom = g, crs = 4326)
 m = st_cast(g, "MULTILINESTRING")
 identical(m$geom[[1]], st_cast(g$geom[[1]], "MULTILINESTRING"))
+
+st_cast(st_sfc(st_geometrycollection(), st_multipolygon()), 'MULTIPOLYGON') #1961
+st_cast(st_sfc(st_geometrycollection(), st_multipolygon(), st_point(0:1)), 'POINT') #1961

tests/cast.Rout.save

@@ -1,6 +1,6 @@
 
-R version 4.0.4 (2021-02-15) -- "Lost Library Book"
-Copyright (C) 2021 The R Foundation for Statistical Computing
+R version 4.2.3 (2023-03-15) -- "Shortstop Beagle"
+Copyright (C) 2023 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu (64-bit)
 
 R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -84,29 +84,9 @@ MULTIPOINT ((1 3))
 MULTIPOINT ((10 13))
 MULTIPOINT ((11 14))
 MULTIPOINT ((12 15))
-> (yy = st_cast(pt, "LINESTRING", rep(seq_along(i), i)))
-Geometry set for 5 features 
-Geometry type: LINESTRING
-Dimension:     XY
-Bounding box:  xmin: 0 ymin: 2 xmax: 12 ymax: 15
-CRS:           NA
-LINESTRING (0 2)
-LINESTRING (1 3)
-LINESTRING (10 13)
-LINESTRING (11 14)
-LINESTRING (12 15)
+> try(yy <- st_cast(pt, "LINESTRING", rep(seq_along(i), i)))
 > 
-> (zz = st_cast(yy, "MULTILINESTRING"))
-Geometry set for 5 features 
-Geometry type: MULTILINESTRING
-Dimension:     XY
-Bounding box:  xmin: 0 ymin: 2 xmax: 12 ymax: 15
-CRS:           NA
-MULTILINESTRING ((0 2))
-MULTILINESTRING ((1 3))
-MULTILINESTRING ((10 13))
-MULTILINESTRING ((11 14))
-MULTILINESTRING ((12 15))
+> #(zz = st_cast(yy, "MULTILINESTRING"))
 > #(zz = st_cast(yy, "POLYGON"))
 > 
 > st_cast(mls, "LINESTRING")
@@ -235,6 +215,24 @@ POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (5 5, 5 6, 6 6, 6 5, 5 5))
 > identical(m$geom[[1]], st_cast(g$geom[[1]], "MULTILINESTRING"))
 [1] TRUE
 > 
+> st_cast(st_sfc(st_geometrycollection(), st_multipolygon()), 'MULTIPOLYGON') #1961
+Geometry set for 2 features  (with 2 geometries empty)
+Geometry type: MULTIPOLYGON
+Dimension:     XY
+Bounding box:  xmin: NA ymin: NA xmax: NA ymax: NA
+CRS:           NA
+MULTIPOLYGON EMPTY
+MULTIPOLYGON EMPTY
+> st_cast(st_sfc(st_geometrycollection(), st_multipolygon(), st_point(0:1)), 'POINT') #1961
+Geometry set for 3 features  (with 2 geometries empty)
+Geometry type: POINT
+Dimension:     XY
+Bounding box:  xmin: 0 ymin: 1 xmax: 0 ymax: 1
+CRS:           NA
+POINT EMPTY
+POINT EMPTY
+POINT (0 1)
+> 
 > proc.time()
    user  system elapsed 
-  0.937   0.044   0.974 
+  1.501   0.751   1.420