add [<-.sf that fixes agr attribute;

addresses #2211 and tidyverse/tibble#1552
r-spatial · Aug 16, 2023 · b301342 · b301342
1 parent e6de6c2
commit b301342
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 1 deletion.
diff --git a/NAMESPACE b/NAMESPACE
@@ -7,6 +7,7 @@ S3method("$",z_range)
 S3method("$<-",sf)
 S3method("[",sf)
 S3method("[",sfc)
+S3method("[<-",sf)
 S3method("[<-",sfc)
 S3method("[[<-",sf)
 S3method("st_agr<-",sf)

diff --git a/R/agr.R b/R/agr.R
@@ -80,7 +80,15 @@ st_agr.default = function(x = NA_character_, ...) {
 #' @name st_agr
 #' @export
 st_set_agr = function(x, value) { 
-	st_agr(x) = value
+	if (!missing(value))
+		st_agr(x) = value
+	else { # needs repair?
+		value = st_agr(x)
+		if (any(is.na(names(value))) && length(value) == length(x) - 1) {
+			names(value) = setdiff(names(x), attr(x, "sf_column"))
+			st_agr(x) = value
+		}
+	}
 	x
 }
 

diff --git a/R/sf.R b/R/sf.R
@@ -373,6 +373,11 @@ st_sf = function(..., agr = NA_agr_, row.names,
 	}
 }
 
+#' @export
+"[<-.sf" = function(x, i, j, value) {
+	st_set_agr(NextMethod())
+}
+
 #' @export
 "[[<-.sf" = function(x, i, value) {
 	agr = st_agr(x)