Merge pull request #91 from t-kalinowski/fix-clamp

Fix nested scalar min/max reductions

Author: t-kalinowski

NEWS.md

@@ -88,6 +88,9 @@
   to Fortran scalars so subsetted scalars in reductions (e.g., `min(m[1, 1], m[2, 1])`)
   no longer emit `minval` on scalars (#64).
 
+- Fixed nested scalar `min()`/`max()` in reductions, so clamp-style expressions
+  like `min(max(x[i], lo), hi)` work reliably.
+
 - Fixed an issue where subsetting logical arrays could fail when compiling quick
   functions, e.g. `(x > 0)[2, 3]` (#68).
 

R/r2f-reductions.R

@@ -20,7 +20,17 @@ register_r2f_handler(
 
     reduce_arg <- function(arg) {
       mask_hoist <- create_mask_hoist()
-      x <- r2f(arg, scope, ..., hoist_mask = mask_hoist$try_set)
+      # Nested reductions (e.g., min(max(...), ...)) can thread an existing
+      # hoist_mask through `...`. We always want a single mask hoister per
+      # reduction context, so we ignore any inherited one and install ours.
+      dots <- list(...)
+      x <- r2f(
+        arg,
+        scope,
+        calls = dots$calls,
+        hoist = dots$hoist,
+        hoist_mask = mask_hoist$try_set
+      )
       if (mask_hoist$has_conflict()) {
         stop(
           "reduction expressions only support a single logical mask",

tests/testthat/test-reduction-scalars.R

@@ -55,3 +55,38 @@ test_that("reductions over vectors still use intrinsics", {
   expect_identical(fn(x2), 1L)
   expect_quick_identical(fn, x1, x2)
 })
+
+
+test_that("nested scalar min/max compiles and runs", {
+  fn <- function(m) {
+    declare(type(m = integer(2, 2)))
+    lo <- 1L
+    hi <- 2L
+    min(max(m[1, 1], lo), hi)
+  }
+
+  m1 <- matrix(c(0L, 3L, 1L, 2L), nrow = 2L, byrow = TRUE)
+  m2 <- matrix(c(10L, 3L, 1L, 2L), nrow = 2L, byrow = TRUE)
+  expect_identical(fn(m1), 1L)
+  expect_identical(fn(m2), 2L)
+  expect_quick_identical(fn, m1, m2)
+})
+
+
+test_that("clamp on a 1d array works with nested scalar min/max", {
+  clamp <- function(x, lo, hi) {
+    declare(type(x = double(n)), type(lo = double(1)), type(hi = double(1)))
+    out <- double(length(x))
+    for (i in seq_along(x)) {
+      out[i] <- min(max(x[i], lo), hi)
+    }
+    out
+  }
+
+  x <- c(-2.0, -0.5, 0.25, 1.25, 10.0)
+  lo <- -0.25
+  hi <- 1.0
+
+  expect_identical(clamp(x, lo, hi), pmin(pmax(x, lo), hi))
+  expect_quick_identical(clamp, list(x, lo, hi))
+})