Aggregate monthly status data to sequence data

Question

I wonder if there is a simple solution for the following problem: Imagine working with monthly status information about whether somebody works (work=1) or not (work=0). this illustrates the original data:

    orig <- data.frame(id=c(rep(1:2, each=10)), 
               month.nr=c(rep(1:10,2)), 
               work.yn=c(0,1,1,0,0,0,1,1,1,0,
                         1,1,1,1,0,1,1,0,0,1))
id month.nr work.yn
1        1       0
1        2       1
1        3       1
1        4       0
1        5       0
1        6       0
1        7       1
1        8       1
1        9       1
1       10       0
2        1       1
2        2       1
2        3       1
2        4       1
2        5       0
2        6       1
2        7       1
2        8       0
2        9       0
2       10       1

I'm looking for a simple function or algorithm which transforms the data keeping only start and end months of working periods and which numbers the resulting sequences by person (id). The resulting data for the sample above would look like this:

    id month.start.work month.end.work sequence.nr
1                2              3           1
1                7              9           2
2                1              4           1
2                6              7           2
2               10             10           3

As my data volume is not so small a resource efficient solution is very much appreciated.

Edit: to do the task with a loop (and maybe a lag function) would work, but I´m looking for a more vectorized solution.

Answer 1

Here's somewhat similar solution using the rleid function in data.table v >= 1.9.6 (the newest stable version)

library(data.table) # v.1.9.6+
setDT(orig)[, indx := rleid(work.yn)
            ][work.yn != 0, .(start = month.nr[1L], 
                              end = month.nr[.N]), 
              by = .(id, indx)
              ][, seq := 1:.N,
                by = id][]
#    id indx start end seq
# 1:  1    2     2   3   1
# 2:  1    4     7   9   2
# 3:  2    6     1   4   1
# 4:  2    8     6   7   2
# 5:  2   10    10  10   3

---

Slight variant of the above without having to create index first, thereby avoiding one grouping operation:

setDT(orig)[, if (work.yn[1L]) 
                 .(start=month.nr[1L], end=month.nr[.N]), 
           by=.(id, rleid(work.yn))
          ][, seq := seq_len(.N), by=id][]

---

Or we could just use range for shorter code

setDT(orig)[, if (work.yn[1L]) as.list(range(month.nr)), 
             by = .(id, rleid(work.yn))
            ][, seq := seq_len(.N), by = id][]

Answer 2

You can use the data.table package, with this small utility function:

library(data.table)

f = function(x, y)
{
    r = rle(x)

    end = y[cumsum(r$lengths)[!!r$values]]
    start = end - r$lengths[!!r$values] + 1

    list(month.start=start, month.end=end)
}

setDT(orig)[, f(work.yn,month.nr),id][, sequence.nr:=seq(.N),id][]

#   id month.start month.end sequence.nr
#1:  1           2         3           1
#2:  1           7         9           2
#3:  2           1         4           1
#4:  2           6         7           2
#5:  2          10        10           3