fixes #2377

R/arith.R

@@ -137,7 +137,7 @@ Ops.sfc <- function(e1, e2) {
 		if (.Generic == "-")
 			e2 <- -e2
 		return(opp_sfc(e1, as.numeric(e2), 0L, NA_crs_))
-	} else if (.Generic %in% c("*", "/") && is.numeric(e2) && (length(e2) == 1 || is_only_diag(e2))) {
+	} else if (.Generic %in% c("*", "/") && is.numeric(e2) && (length(e2) == 1 || (is_only_pos_diag(e2)))) {
 		if (is.matrix(e2)) e2 <- diag(e2)
 		if (.Generic == "/")
 			e2 <- 1 / e2
@@ -168,10 +168,11 @@ Ops.sfc <- function(e1, e2) {
 			st_crs(e1)
 		else # geometry got displaced:
 			NA_crs_
-		st_sfc(ret, crs = crs, precision = attr(e1, "precision"))
+		st_sfc(ret, crs = crs, precision = attr(e1, "precision"), recompute_bbox = TRUE) # also check_ring_dir, if polygons? #2377
 	} else
 		ret
 }
-is_only_diag <- function(x) {
-	is.matrix(x) && all(`diag<-`(x, 0) == 0) # nocov
+
+is_only_pos_diag <- function(x) {
+	is.matrix(x) && all(`diag<-`(x, 0) == 0) && all(diag(x) >= 0) # nocov
 }

tests/testthat/test-sfc.R

@@ -119,3 +119,11 @@ test_that("c.sfc n_empty returns sum of st_is_empty(sfg)", {
 test_that("st_is_longlat warns on invalid bounding box", {
 	expect_warning(st_is_longlat(st_sfc(st_point(c(0,-95)), crs = 4326)))
 })
+
+test_that("bounding box is flipped when geometry is flipped", {
+	foo <- st_bbox(c(xmin = 0, xmax = 100, ymin = 0, ymax = 200)) |> st_as_sfc()
+	bar <- foo * matrix(c(1,0,0,-1), nrow = 2)
+	expect_equal(st_bbox(bar), st_bbox(c(xmin=0, ymin=-200, xmax=100, ymax=0)))
+})
+
+