R: Recursive Function to Move Through Dataset

Question

Much of the following problem arises from the sheer size of the dataframe (198240 observations). I'll try to break it down as best as I can.

The Goal

I want to create a variable DURATION which is how long a house was sick.

The Known

• Household ID and Week (There are 1120 houses and 177 weeks)
• HDINC (Currently Sick variable )
• HDINC_1 (Sick Week Prior variable )

The Problem I don't understand how to get the function/loop to be traversing the dataframe in both household and time concurrently.

I know it will be a function or loop that goes something like the following (Not in R-code, but in logic)

   IF (hdinc > 0)       #a house on a certain date is sick 
       { Duration = 1 AND  look at hdinc_1 
           IF (hdinc_1 = 0 )
                { Duration = Duration + 0  
                  AND Go onto the next date for that house. 
           IF hdinc_1 >0 then       #if the house was sick last week
                 { Duration = Duration + 1   
                   Go to SameHouse, Week-1 and look at hdinc_1 to see if it was sick the week prior 

I am having trouble with the following:

• Getting it to start on a particular observation based on household/date
• Moving the function backwards or forwards while maintaining the household
• Eventually getting the function to restart using a different household

I know this is really convoluted but I can't even get the loop to start to provide y'all sample code.

Sample Data:

dat <- structure(list(id_casa = c(802L, 802L, 802L, 802L, 802L, 802L, 802L, 955L, 955L, 955L, 955L), survdate = structure(c(3L, 10L, 5L, 1L, 2L, 4L, 11L, 6L, 7L, 8L, 9L), .Label = c("1/11/2006", "1/18/2006", "1/19/2005", "1/25/2006", "1/4/2006", "10/13/2004", "10/20/2004", "10/27/2004", "11/3/2004", "12/28/2005", "2/1/2006" ), class = "factor"), hdinc = c(125, 142.85715, 0, 0, 0, 142.85715, 0, 50, 32, 159, 2.5), hdinc_1 = c(0, 125, 142.85715, 0, 0, 0, 142.85715, 0, 50, 32, 159)), .Names = c("id_casa", "survdate", "hdinc", "hdinc_1"), class = "data.frame", row.names = c(NA, -11L)) 

Sample Output:

Answer 1

We can use the function rle in combination with dplyr to find runs, and then remove those where the run is of wellness:

library(dplyr)
dat %>% group_by(id_casa) %>%
        mutate(duration = unlist(lapply(rle(hdinc > 0)[["lengths"]], seq, from = 1))) %>%
        mutate(duration = ifelse(hdinc > 0, as.numeric(duration), 0))

Source: local data frame [11 x 5]
Groups: id_casa [2]

   id_casa   survdate    hdinc  hdinc_1 duration
     (int)     (fctr)    (dbl)    (dbl)    (dbl)
1      802  1/19/2005 125.0000   0.0000        1
2      802 12/28/2005 142.8571 125.0000        2
3      802   1/4/2006   0.0000 142.8571        0
4      802  1/11/2006   0.0000   0.0000        0
5      802  1/18/2006   0.0000   0.0000        0
6      802  1/25/2006 142.8571   0.0000        1
7      802   2/1/2006   0.0000 142.8571        0
8      955 10/13/2004  50.0000   0.0000        1
9      955 10/20/2004  32.0000  50.0000        2
10     955 10/27/2004 159.0000  32.0000        3
11     955  11/3/2004   2.5000 159.0000        4

How it works: first we find all the runs using rle:

rle(dat$hdinc>0)
Run Length Encoding
  lengths: int [1:5] 2 3 1 1 4
  values : logi [1:5] TRUE FALSE TRUE FALSE TRUE

We then make a seq from 0 to each of the lengths from the rle using lapply:

z <- unlist(lapply(rle(dat$hdinc > 0)[["lengths"]], seq, from = 1))
z
 [1] 1 2 1 2 3 1 1 1 2 3 4

Then we filter that by whether it was sickness or wellness:

ifelse(dat$hdinc > 0, z, 0)
 [1] 1 2 0 0 0 1 0 1 2 3 4

Using dplyr group_by we make sure we are running it on each id_casa by itself.

EDIT: In base:

dat$duration2 <- ifelse(dat$hdinc > 0,
                   unlist(by(dat, dat$id_casa, FUN = function(x) unlist(lapply(rle(x$hdinc > 0)[["lengths"]], seq, from = 1)))),
                   0)

Answer 2

Using only base R :

# create sample data
sampleData <-
  structure(list(id_casa = c(802L, 802L, 802L, 802L, 802L, 802L, 802L, 955L, 955L, 955L, 955L), 
                 survdate = structure(c(3L, 10L, 5L, 1L, 2L, 4L, 11L, 6L, 7L, 8L, 9L), 
                                      .Label = c("1/11/2006", "1/18/2006", "1/19/2005", "1/25/2006", "1/4/2006", "10/13/2004", "10/20/2004", "10/27/2004", "11/3/2004", "12/28/2005", "2/1/2006" ), class = "factor"), 
                 hdinc = c(125, 142.85715, 0, 0, 0, 142.85715, 0, 50, 32, 159, 2.5), hdinc_1 = c(0, 125, 142.85715, 0, 0, 0, 142.85715, 0, 50, 32, 159)), 
            .Names = c("id_casa", "survdate", "hdinc", "hdinc_1"), class = "data.frame", row.names = c(NA, -11L))

# you must be sure the rows are already ordered, otherwise you can use something like:
#sampleData <- sampleData[order(sampleData$id_casa,sampleData$survdate),]

sampleData$Duration <- 
unlist(
   by(sampleData,
   INDICES=sampleData$id_casa,
   FUN=function(house){
     tail(Reduce(f=function(prv,nxt){if(nxt == 0) 0 else (prv+nxt)},
                 x=as.integer(house$hdinc > 0),init=0,accumulate=TRUE),-1)
     }))

> sampleData
   id_casa   survdate    hdinc  hdinc_1 Duration
1      802  1/19/2005 125.0000   0.0000        1
2      802 12/28/2005 142.8571 125.0000        2
3      802   1/4/2006   0.0000 142.8571        0
4      802  1/11/2006   0.0000   0.0000        0
5      802  1/18/2006   0.0000   0.0000        0
6      802  1/25/2006 142.8571   0.0000        1
7      802   2/1/2006   0.0000 142.8571        0
8      955 10/13/2004  50.0000   0.0000        1
9      955 10/20/2004  32.0000  50.0000        2
10     955 10/27/2004 159.0000  32.0000        3
11     955  11/3/2004   2.5000 159.0000        4