CODEWITHSUNDEEP
rvectorization
nnoitr
nnoitr

Reputation: 53

R - vectorizing first value of an array that is greater of some threshold

I need to find the first value of an array that is greater of some scalar threshold y. I am using

array[min(which(array > y))]

This gives me a 1x1 element that is the first value of array greater than y. Now, I would like to vectorize this operation somehow. In particular, if y is a m x 1 vector, I would like to compare array to each of the elements of y and return me a m x 1 vector where element in position i is the first value of array greater than y[i]. How can I do that without for loops?

Upvotes: 5

Views: 69

Answers (3)

jblood94
jblood94

Reputation: 16986

A fully vectorized solution:

c(array, NA)[rank(c(y, cummax(array)), "keep", "last")[seq_along(y)] - rank(y) + 1L]

If array can contain NA values:

which.gt <- function(array, y) {
  array[is.na(array)] <- -Inf
  c(array, NA)[rank(c(y, cummax(array)), "keep", "last")[seq_along(y)] - rank(y) + 1L]
}

which.gt(1:10, c(4, 8, 3))
#> [1] 5 9 4
which.gt(c(NA, 1:5, NA, 6:10), c(4L, 8L, 3L, NA, 11:13))
#> [1]  5  9  4 NA NA NA NA

Benchmarking against Vectorize:

which.gt_vec <- Vectorize(function(array, y) array[min(which(array > y))], "y")

array <- sample(1e4)
y <- sample(1e4 - 1, 1e3)

microbenchmark::microbenchmark(which.gt = which.gt(array, y),
                               which.gt_vec = which.gt_vec(array, y),
                               check = "identical")
#> Unit: microseconds
#>          expr     min       lq      mean  median       uq     max neval
#>      which.gt   332.7   355.05   401.834   403.7   428.55   814.6   100
#>  which.gt_vec 35362.5 36997.95 38210.349 37569.3 38367.60 62176.1   100

Upvotes: 2

Donald Seinen
Donald Seinen

Reputation: 4419

One problem exists if no value in the array is greater than y. We can use NA propagation for such cases.

set.seed(5)
a <- array(sample(100, 12), c(2,2,3)) # no value greater than 100

y <- c(80, 100, 2, 90, NA)

m <- !outer(y, c(a), ">")
max.col(m, "first") * NA^!rowSums(m)

#> [1]  6 NA  1  7 NA

Upvotes: 2

Aur&#232;le
Aur&#232;le

Reputation: 12849

f <- function(array, y) array[min(which(array > y))]

f_vectorized <- Vectorize(f, "y")

f(array = 1:10, y = c(4, 8, 3))
#> [1] 5 9 4

Upvotes: 3

Related Questions