Merge pull request #2465 from agila5/spatstat

as.ppp.sf accepts ncol(X) > 1

Author: edzer

NEWS.md

@@ -4,6 +4,8 @@
 
 * `gdal_utils()` `ogrinfo` has an argument `read_only` which, when `TRUE` (or `options` includes `"-ro"`), opens a datasource in read-only mode (#2460; `sf` did this before 1.0-17); by default a datasource is opened in update (read-write) mode (since sf 1.0-17; #2420)
 
+* the `sf` -> `ppp` conversion accepts a data.frame of marks instead of just 1 column #2450, by @agila5
+
 # version 1.0-18
 
 * support  `POLYGON FULL` simple feature geometry, representing the entire Earth surface, as used by `s2geometry`; #2441

R/spatstat.R

@@ -144,13 +144,12 @@ as.ppp.sf = function(X, ...) {
 	if (st_dimension(X[1,]) == 2)
 		X = X[-1,]
 	st_geometry(X) = NULL # remove geometry column
-	if (ncol(X) > 1)
-		warning("only first attribute column is used for marks")
 
-	if (ncol(X) == 0)
+	if (ncol(X) == 0) {
 		pp
-	else 
-		spatstat.geom::setmarks(pp, X[1])
+	} else {
+		spatstat.geom::setmarks(pp, X)
+	}
 }
 
 as.owin.POLYGON = function(W, ..., fatal, check_polygons = TRUE) {

tests/spatstat.R

@@ -108,5 +108,28 @@ as.psp(sf, marks = 5:1)
 (x = st_as_sf(as.psp(sf)))
 (y = st_as_sfc(as.psp(sf)))
 all.equal(st_geometry(x), y)
+
+# Test sf -> ppp conversion when the conversion involves more than 1 column of mark(s)
+# (https://github.com/r-spatial/sf/issues/2450)
+reference_ppp <- ppp(
+	x = c(0.25, 0.75),
+	y = c(0.25, 0.75), 
+	# We consider a data.frame of marks which includes several types of columns
+	# (and also a list column)
+	marks = data.frame(
+		a = TRUE, b = 1L, c = pi, d = I(list(list(1, 2), list("A", "B", "C"))), 
+		#NB: row.names should always defined as a vector with character character
+		#since they are converted as characters when applying st_as_sf (see line
+		#below) which mixes NA and not-NA row.names
+		row.names = c("point1", "point2")
+	)
+)
+# The st_as_sf conversion returns an sf object where the first row is the Window
+# and the other rows are the points
+tmp <- st_as_sf(reference_ppp)
+pts <- tmp[tmp$label == "point", 1:4]
+target_ppp <- as.ppp(pts)
+Window(target_ppp) <- owin()
+all.equal(reference_ppp, target_ppp)
 }
 ## IGNORE_RDIFF_END