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

前端 未结 4 389
终归单人心
终归单人心 2021-02-04 14:08

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

相关标签:
4条回答
  • 2021-02-04 14:14

    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 NAs. 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
    
    0 讨论(0)
  • 2021-02-04 14:18

    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
    
    0 讨论(0)
  • 2021-02-04 14:24

    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))
    }
    
    0 讨论(0)
  • 2021-02-04 14:34

    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.

    0 讨论(0)
提交回复
热议问题