diff --git a/DESCRIPTION b/DESCRIPTION index e1a269c..1243d05 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: inlmisc Title: Miscellaneous Functions for the USGS INL Project Office -Version: 0.4.6 +Version: 0.4.7 Authors@R: person(given=c("Jason", "C."), family="Fisher", role=c("aut", "cre"), email="jfisher@usgs.gov", comment=c(ORCID="0000-0001-9032-8912")) Description: A collection of functions for creating high-level graphics, performing raster-based analysis, processing MODFLOW-based models, diff --git a/NEWS.md b/NEWS.md index 636a44e..8c24490 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# inlmisc 0.4.7 + +- In `SetPolygons`, set `checkValidity` argument to 2 and suppress warnings. + # inlmisc 0.4.6 - Add `"usgs_article"` template for R Markdown documents. diff --git a/R/SetPolygons.R b/R/SetPolygons.R index 55a62c6..032062a 100644 --- a/R/SetPolygons.R +++ b/R/SetPolygons.R @@ -74,44 +74,41 @@ SetPolygons <- function(x, y, cmd=c("gIntersection", "gDifference"), buffer.widt y <- methods::as(y, "SpatialPolygons") y <- y[which(apply(rgeos::gIntersects(y, x, byid=TRUE), 2, any)), ] - are.intersecting <- rgeos::gIntersects(x, y, byid=TRUE) + is_intersecting <- rgeos::gIntersects(x, y, byid=TRUE) - z <- lapply(seq_along(x), function (i) { - if (any(are.intersecting[, i])) { - y.intersect <- y[are.intersecting[, i]] + z <- suppressMessages(suppressWarnings(lapply(seq_along(x), function (i) { + + if (any(is_intersecting[, i])) { + y_intersect <- y[is_intersecting[, i]] if (is.numeric(buffer.width)) - y.intersect <- rgeos::gBuffer(y.intersect, width=buffer.width) + y_intersect <- rgeos::gBuffer(y_intersect, width=buffer.width) + + spgeom2 <- rgeos::gUnaryUnion(y_intersect, checkValidity=2L) - spgeom2 <- rgeos::gUnaryUnion(y.intersect) if (cmd == "gIntersection") - x.geo <- rgeos::gIntersection(x[i], spgeom2, byid=TRUE) + x_geo <- rgeos::gIntersection(x[i], spgeom2, byid=TRUE, checkValidity=2L) else - x.geo <- rgeos::gDifference(x[i], spgeom2, byid=TRUE) - - if (inherits(x.geo, "SpatialCollections")) - x.geo <- rgeos::gUnaryUnion(x.geo@polyobj) + x_geo <- rgeos::gDifference(x[i], spgeom2, byid=TRUE, checkValidity=2L) - is.valid <- suppressWarnings(rgeos::gIsValid(x.geo, byid=TRUE)) - if (length(is.valid) == 0) return(NULL) - if (!is.valid) { - x.geo <- rgeos::gBuffer(x.geo, width=0) - ans <- rgeos::gIsValid(x.geo, byid=TRUE, reason=TRUE) - if (ans != "Valid Geometry") stop(paste("non-valid polygons:", ans)) - } + if (inherits(x_geo, "SpatialCollections")) + x_geo <- rgeos::gUnaryUnion(x_geo@polyobj, checkValidity=2L) - p <- x.geo@polygons[[1]] + p <- x_geo@polygons[[1]] methods::slot(p, "ID") <- methods::slot(x[i]@polygons[[1]], "ID") + } else { p <- if (cmd == "gIntersection") NULL else x[i]@polygons[[1]] } + p - }) + }))) - is.retained <- !vapply(z, is.null, TRUE) - z <- sp::SpatialPolygons(z[is.retained], proj4string=raster::crs(x)) + is_retained <- !vapply(z, is.null, TRUE) + z <- sp::SpatialPolygons(z[is_retained], proj4string=raster::crs(x)) if (inherits(d, "data.frame")) { - d <- d[is.retained, , drop=FALSE] + d <- d[is_retained, , drop=FALSE] z <- sp::SpatialPolygonsDataFrame(z, d, match.ID=TRUE) } + z }