Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,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).

Expand Down
12 changes: 11 additions & 1 deletion R/r2f-reductions.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
35 changes: 35 additions & 0 deletions tests/testthat/test-reduction-scalars.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
})