Identify Multipolygons in sp and sf class objects

Identify_multipolygons.R

### sp Polygon objects ###
# x = spatialPolygons or spatialPolygonsDataFrame object only
# by_id = where true, adds a column to @data with a part count for each polygon. Promotes sPolys to sPolydf.
find_mp <- function(x = NULL, id_rows = FALSE) {

  nparts <- vector("list", length(x@polygons)) 
  
  for (i in seq_along(1:length(x@polygons))) {    
      n <- vector("list", length(x@polygons[[i]]@Polygons))
      for (j in seq_along(1:length(x@polygons[[i]]@Polygons))) {
        n[[j]] <- x@polygons[[i]]@Polygons[[j]]@hole
      }
      nparts[[i]] <- sum(unlist(n) == FALSE)
  }
 
  PARTS <- unlist(nparts)
  
  if (id_rows == FALSE){
    if(sum(PARTS) / nrow(x@data) == 1) {
      return(FALSE)
      } else {
        return(TRUE)
      }
    } else if(class(x)[[1]] == 'SpatialPolygons') {
      x            <- as(x, 'SpatialPolygonsDataFrame')
      x@data       <- cbind(x@data, PARTS)
      x@data$dummy <- NULL
    } else {
      x@data <- cbind(x@data, PARTS)
    }
  return(x)
}

### sp objects ###
# with thanks to @mdsumner for the fortify-based approach, this should work on point and line objects as well as polys
# x = sp object
# by_id = where true, adds a column to @data with a part count for each polygon. Promotes s* to s*df
find_mp_fort <- function(x = NULL, id_rows = FALSE) {
  
  suppressMessages(xf <- fortify(x))
  
  nparts <- if (is.null(xf$holes)) {
    
    xf %>% distinct(id, group) %>%
      group_by(id) %>%
      summarize(nparts = n())
    
  } else {
   
    xf %>% distinct(id, group, hole) %>%
      filter(hole == FALSE) %>% 
      group_by(id) %>%
      summarise(nparts = n())
  }
  
  
  if (id_rows == FALSE){
    if(sum(nparts$nparts) / nrow(nparts) == 1) {
      return(FALSE)
      } else {
        return(TRUE)
        }
    } else if (class(x)[[1]] == 'SpatialPolygons') {
    x            <- as(x, 'SpatialPolygonsDataFrame')
    x@data       <- merge(x@data, nparts, by.x = 0, by.y = 'id', 
                          all.x = TRUE, all.y = FALSE)
    x@data$dummy <- NULL
  } else if (class(x)[[1]] == 'SpatialLines') {
    x            <- as(x, 'SpatialLinesDataFrame')
    x@data       <- merge(x@data, nparts, by.x = 0, by.y = 'id', 
                          all.x = TRUE, all.y = FALSE)
    x@data$dummy <- NULL
  } else if (class(x)[[1]] == 'SpatialPoints') {
    x            <- as(x, 'SpatialPointsDataFrame')
    x@data       <- merge(x@data, nparts, by.x = 0, by.y = 'id', 
                          all.x = TRUE, all.y = FALSE)
    x@data$dummy <- NULL
  } else {
    x@data <- merge(x@data, nparts, by.x = 0, by.y = 'id', 
                    all.x = TRUE, all.y = FALSE)
  }
  x@data$Row.names <- NULL
  return(x)
}  
   
### sf objects ###
# x = sf object
# by_id = where true, adds a column reporting the geometry type for each row
# note that you must use st_read() with option promote_to_multi = FALSE if you want a sensible output where by_id = TRUE
st_findmp <- function(x = NULL, id_rows = FALSE) {
  
  nparts_vec <- st_geometry_type(x$geometry)
  
  if (id_rows == FALSE){
    return(as.character(unique(st_geometry_type(x))))
  } else {
    x$nparts <- nparts_vec
    return(x)
  }
}

Awesome, thanks! My dplyr-fu is weak as yet. Fortify is a bit slower but does allow a function that'll work on point and line sp objects, see edits above

for sf, holes are matrices in the geometry list, and parts are sub-lists holding a matrix e.g.

x <- as.list(sf[i, 'geometry]) # what's that warning about anyway...
y <- sapply(x$geometry[[1]], function(x) class(x))

should make it easy to distinguish the two?