Make duplicated and unique work (fixes #2138)

Author: bart

NAMESPACE

@@ -29,6 +29,7 @@ S3method(c,sfc)
 S3method(c,sfg)
 S3method(cbind,sf)
 S3method(dim,sgbp)
+S3method(duplicated,sf)
 S3method(format,bbox)
 S3method(format,crs)
 S3method(format,sfc)

R/sf.R

@@ -450,6 +450,23 @@ as.data.frame.sf = function(x, ...) {
 	NextMethod()
 }
 
+#' @export
+duplicated.sf <- function(x, incomparables = FALSE, fromLast = FALSE, ...) {
+  if (length(x) != 1L) {
+    if (any(i <- vapply(x, is.factor, NA))) {
+      for (j in names(i[i])) {
+        x[[j]] <- lapply(x[[j]], as.numeric)
+      }
+    }
+    if (any(i <- (lengths(lapply(x, dim)) == 2L))) {
+      for (j in names(i[i])) {
+        x[[j]] <- lapply(x[[j]], split.data.frame, seq_len(nrow(x)))
+      }
+    }
+  }
+  NextMethod()
+}
+
 #' @export
 #' @name st_geometry
 #' @details if \code{x} is of class \code{sf}, \code{st_drop_geometry} drops the geometry of its argument, and reclasses it accordingly; otherwise it returns \code{x} unmodified. 

tests/testthat/test_sf.R

@@ -99,3 +99,8 @@ test_that("empty agr attribute is named after subset", {
 	agr = attr(out, "agr")
 	expect_identical(names(agr), character())
 })
+test_that("duplicated work",{
+	sf = st_sf(data.frame(x = st_sfc(st_point(1:2))[rep(1,4)], a=gl(2,2), b=as.numeric(gl(2,2))))
+	expect_identical(duplicated(sf), c(FALSE,TRUE,FALSE,TRUE))
+	expect_s3_class(unique(sf),'sf')
+})