How to get group id of sliding windows but only after completion of earliest started window

user_2884859 0
Viewed 94

Let me be straightforward in telling that it may be a bit complicated for me to explain.

Let's assume that I have a vector with run-lengths of (forward) sliding window sizes.

xx <- c(3L, 2L, 1L, 4L, 4L, 3L, 3L, 1L, 2L, 1L, 2L, 3L, 4L, 3L, 2L, 1L)
xx
[1] 3 2 1 4 4 3 3 1 2 1 2 3 4 3 2 1
  • First element is 3, which means window size (forward) for it, is of length 3. And so on.
  • I want to assign first three (because 1st element is 3) elements a same group no. say 1
  • Now I want to leave 2nd and 3rd elements - because they subsumed in first window and therefore these elements be allocated same group no. i.e. 1
  • Pick 4th element then, it s window size is 4. Then allocate next four elements (including this one) another group no. say 2.
  • Now pick 8th element (3+4 have been completed). and allocate unique group no say 3 to element count of its size which is 1 only.
  • Next pick 9th element and so on.
  • It is assured that last group will automatically be exhausted or it'll be 1.

My desired output is as below:

c(1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6)
rolling-computation r
5 Answers

You can use Reduce and return the accumulated index from which to which you jump. as.factor and as.integer is used to get numbers 1, 2, 3, ...

as.integer(as.factor(Reduce(function(i, j) if(i > j) i else i + xx[i+1],
 seq_len(length(xx)-1), xx[1], accumulate = TRUE)))
# [1] 1 1 1 2 2 2 2 3 4 4 5 5 6 6 6 6

Another option is to use a recursive function.

f <- function(i) {
  if(i >= length(xx)) length(xx)
  else c(i, f(i + xx[i + 1]))
}

x <- diff(f(0))
rep(seq(x), x)
# [1] 1 1 1 2 2 2 2 3 4 4 5 5 6 6 6 6
user_104885040

An option with ugly while loop :

xx <- c(3L, 2L, 1L, 4L, 4L, 3L, 3L, 1L, 2L, 1L, 2L, 3L, 4L, 3L, 2L, 1L)
#Initialise output vector
yy <- integer(length(xx))
#Assign the 1st group
yy[1:xx[1]] <- 1
#Set the current position
i <- xx[1] + 1
#Initialise the group number
group <- 2

#While all the groups have been assigned
while(any(yy == 0)) {
  #Assign the next group number
  yy[i:(i+xx[i] - 1)] <- group
  #Increment the group number
  group <- group + 1
  #Increment the current position.
  i <- i+xx[i]
}
yy

#[1] 1 1 1 2 2 2 2 3 4 4 5 5 6 6 6 6
user_39629140

Here is a possible way using Rcpp:

Rcpp::cppFunction("
IntegerVector decode_rle(IntegerVector x) {
    const int n = x.size();
    IntegerVector res(n);
    int cnt = 0;
    int rle = x[0];
    int gcnt = 1;
    for(int i = 0; i < n; i ++){
        cnt++;
        if(cnt <= rle){
            res[i] = gcnt;
        }else{
            rle = x[i];
            cnt = 1;
            res[i] = ++gcnt;
        }
    }
    return res;
}")

xx <- c(3, 2, 1, 4, 4, 3, 3, 1, 2, 1, 2, 3, 4, 3, 2, 1)
decode_rle(xx)
# [1] 1 1 1 2 2 2 2 3 4 4 5 5 6 6 6 6
user_39265430

Taking clues from @GKi's fabulous answer, I have translated it to purrr::accumulate

accumulate(seq_len(length(xx)-1), .init = xx[1], ~ifelse(.x > .y, .x, .x + xx[.x +1]))

[1]  3  3  3  7  7  7  7  8 10 10 12 12 16 16 16 16
user_28848590

Although not what you were looking for in the first place, I finally found a way to get to the desired output through recursion which is one of my favorite programming techniques. I also tried to be as concise as possible in my approach. Hope you like it:

xx <- c(3L, 2L, 1L, 4L, 4L, 3L, 3L, 1L, 2L, 1L, 2L, 3L, 4L, 3L, 2L, 1L)

i <- 1
out <- c()
fn <- function(x) {
  out <<- c(out, rep(i, x[1]))
  x <- x[-(1:x[1])]
  if(length(x) != 0) {
    i <<- i + 1
  } else {
    return(out)
  }
  fn(x)
}

fn(xx)
[1] 1 1 1 2 2 2 2 3 4 4 5 5 6 6 6 6
user_143145200
Related