add %% to Ops.sfg, which allows dateline wrap #280

R/arith.R

@@ -15,14 +15,21 @@
 #' diag(m) = c(1, 3)
 #' # affine:
 #' st_point(c(1,2)) * m + c(2,5)
+#' # world in 0-360 range:
+#' library(maps)
+#' w = st_as_sf(map('world', plot = FALSE, fill = TRUE))
+#' w2 = (st_geometry(w) + c(360,90)) %% c(360) - c(0,90)
+#' plot(w2, axes = TRUE)
 Ops.sfg <- function(e1, e2) {
 	if (nargs() == 1)
 		stop(paste("unary", .Generic, "not defined for \"sfg\" objects"))
 
 	prd <- switch(.Generic, "*" = TRUE, FALSE)
 	pm  <- switch(.Generic, "+" = , "-" = TRUE, FALSE)
-	if (!(prd || pm))
-		stop("operation not supported for sfg objects")
+	mod <- switch(.Generic, "%%" = TRUE, FALSE)
+
+	if (!(prd || pm || mod))
+		stop(paste("operation", .Generic, "not supported for sfg objects"))
 
 	if (is.na(st_dimension(e1))) # empty:
 		return(e1)
@@ -34,7 +41,7 @@ Ops.sfg <- function(e1, e2) {
 	Vec = rep(0, dims)
 	Mat = matrix(0, dims, dims)
 	diag(Mat) = 1
-	if (pm) {
+	if (pm || mod) {
 		if (length(e2) == 1)
 			Vec = rep(e2, length.out = dims)
 		else
@@ -51,8 +58,10 @@ Ops.sfg <- function(e1, e2) {
 	if_pt = function(x, y) { if(inherits(x, "POINT")) as.vector(y) else y }
 	fn = if (prd)
 			function(x, Mat, Vec) structure(if_pt(x, x %*% Mat), class = class(x))
-		else
+		else if (pm)
 			function(x, Mat, Vec) structure(if_pt(x, unclass(x) + conform(Vec, x)), class = class(x))
+		else # mod:
+			function(x, Mat, Vec) structure(if_pt(x, unclass(x) %% conform(Vec, x)), class = class(x))
 
 	if (is.list(e1))
 		rapply(e1, fn, how = "replace", Mat = Mat, Vec = Vec)
@@ -77,6 +86,7 @@ Ops.sfc <- function(e1, e2) {
 		"*" = mapply(function(x, y) { x * unclass(y) }, e1, e2, SIMPLIFY = FALSE),
 		"+" = mapply(function(x, y) { x + unclass(y) }, e1, e2, SIMPLIFY = FALSE),
 		"-" = mapply(function(x, y) { x - unclass(y) }, e1, e2, SIMPLIFY = FALSE),
+		"%%" = mapply(function(x, y) { x %% unclass(y) }, e1, e2, SIMPLIFY = FALSE),
 		stop(paste("operation", .Generic, "not supported")))
 	st_sfc(ret, crs = NA_integer_, precision = attr(e1, "precision"))
 }

tests/sfc.R

@@ -95,6 +95,7 @@ sf_extSoftVersion()[1:3]
 ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))))
 ls * 2
 ls - 2
+(ls + 2) %% 3
 
 str(x)
 nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE)

tests/sfc.Rout.save

@@ -399,6 +399,14 @@ bbox:           xmin: -2 ymin: -2 xmax: -2 ymax: -1
 epsg (SRID):    NA
 proj4string:    NA
 LINESTRING(-2 -2, -2 -1)
+> (ls + 2) %% 3
+Geometry set for 1 feature 
+geometry type:  LINESTRING
+dimension:      XY
+bbox:           xmin: 2 ymin: 0 xmax: 2 ymax: 2
+epsg (SRID):    NA
+proj4string:    NA
+LINESTRING(2 2, 2 0)
 > 
 > str(x)
 sfc_POINT of length 2; first list element: Classes 'XY', 'POINT', 'sfg'  num [1:2] -90 35
@@ -731,4 +739,4 @@ POINT(-81.6410816551367 36.3952045484235)
 > 
 > proc.time()
    user  system elapsed 
-  1.556   0.300   1.546 
+  1.516   0.296   1.503