How can I vectorize access to neighbour vector elements in R?

Question

I have the following vector

 v = c(F, F, F, T, F, F, F, F, F, T, F, F, F)

How can I change v so that the previous 2 elements and the following 2 elements of each v TRUE element are also set to TRUE, using a vectorized operations? That is, the result should be:

 F, T, T, T, T, T, F, T, T, T, T, T, F

Of course, this could be done with a loop on each v element, but I want to understand if it is possible to vectorize this kind of operations. Also different than this question , the elements in v are independent and I don't need to perform computation on each one. It's a pure indexing problem.

Answer 1

This sort of thing is probably as vectorized as you're going to get:

v[unlist(sapply(which(v),function(x) {x + c(-2,-1,1,2)},simplify = FALSE))] <- TRUE
> v
 [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE

But note that you haven't specified what should happen in the TRUE elements are near the ends of your vector. That would require more work. Nor do you specify what happens if there are two TRUE elements that are closer than two positions from each other.

Alternatively:

v[outer(which(v),c(-2,-1,1,2),"+")] <- TRUE
> v
 [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE

At a basic level, we're doing the same thing here, but the second option is certainly more compact, although possibly harder to understand.

Answer 2

Late to the party... You should apply a convolution filter . It will be faster than anything. The only difficulty is that at both extremities you should prepend/append a couple FALSE so the filter won't initialize with NA s. Here is a function that will do it for you:

within.distance <- function(x, d = 2) {
    xxx  <- c(rep(FALSE, d), x, rep(FALSE, d))
    yyy  <- as.logical(filter(xxx, rep(1, 2*d+1)))
    head(tail(yyy, -d), -d)
}

within.distance(v)
#  [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE TRUE FALSE

Answer 3

Here's another attempt. It seems to work on your data and also when the first element is TRUE.

as.logical(rowSums(embed(c(FALSE, FALSE, v, FALSE, FALSE), 5)))
#  [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE

# another attempt with beginning and end TRUE
v = c(T, F, F, F, F, F, T, F, F, F, F, F, T)
#  [1]  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE

---

Similar to @flodel's idea, one could create a function here as:

rollOR <- function(vec, dir="both", dist=2) {
    stopifnot(dir %in% c("left", "right", "both"))
    stopifnot(dist >= 0)
    stopifnot(is.logical(vec))

    cvec <- rep(FALSE, dist)
    switch(dir, 
        both = {
            vec <- c(cvec, vec, cvec)
            dist <- dist * 2 + 1
        }, 
        left = {
            vec <- c(vec, cvec)
            dist <- dist + 1
        },
        right = {
            vec <- c(cvec, vec)
            dist <- dist + 1
        })

    as.logical(rowSums(embed(vec, dist)))
}   
# direction both sides
rollOR(v, "both", 2)
# [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE

# left alone
rollOR(v, "left", 2)
# [1] FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE

# right alone
rollOR(v, "right", 2)
# [1] FALSE FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE  TRUE FALSE

Answer 4

Yet another approach. Create a set of lagged vectors, and or them together:

library(Hmisc)
library(functional)
within.distance <- function(x, d=2) {
  FLag <- function(x, shift) {
    x <- Lag(x, shift)
    x[is.na(x)] <- FALSE
    return(x)
  }

  l <- lapply((-d):d, Curry(FLag, x=x))
  return(Reduce(`|`, l))
}