R：遍历数据集的递归函数答案

【问题标题】：R: Recursive Function to Move Through DatasetR：遍历数据集的递归函数
【发布时间】：2016-01-23 09:21:45
【问题描述】：

以下大部分问题都源于数据框的绝对大小（198240 个观察值）。我会尽量分解它。

目标

我想创建一个变量 DURATION，即房子生病的时间。

已知的

House ID 和 Week（有 1120 个房屋和 177 个周）
HDINC（当前病态变量）
HDINC_1（病假周前变量）

问题我不明白如何让函数/循环同时在家庭和时间中遍历数据帧。

我知道它将是一个函数或循环，如下所示（不是在 R 代码中，而是在逻辑中）

   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

我遇到以下问题：

开始基于家庭/日期的特定观察
在维护家庭的同时向后或向前移动功能
最终让功能使用不同的家庭重新启动

我知道这真的很复杂，但我什至无法让循环开始提供你们所有的示例代码。

样本数据：

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))

样本输出：

【问题讨论】：

如果没有示例代码，也许可以提供一些示例数据？
另外，一些示例输出会很好。我不是 100% 确定你需要什么。例如，如果房子每隔一周生病一次，您希望输出为“1”（最长生病时间）还是“88”（生病的总周数）还是“1,1,1,1,1,1, 1,1,..."（疾病持续时间列表）还是其他？开始日期？
你能至少描述一下你的数据结构吗？例如，您提到有 198240 个观察值。你的意思是观察还是你的矩阵中的元素？因为 198240 恰好也等于 1120 座房屋 * 177 周。你实际上有 198240 行吗？根据您是否可以重新构造数据，您实际上可能不需要循环来解决此问题。
好的，我尝试上传一张图片，说明导出到 Excel 后的外观。这有帮助吗？
结构(列表(id_casa = c(802L, 802L, 802L, 802L, 802L, 802L, 802L, 955L, 955L, 955L, 955L), survdate = 结构(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= "因子"), 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= "数据.frame", row.names = c(NA, -11L))

标签： r loops recursion dataframe

【解决方案1】：

我们可以使用函数rle结合dplyr来查找runs，然后删除那些runs是健康的：

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

它是如何工作的：首先我们使用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

然后，我们使用 lapply 从 0 到 rle 的每个长度创建一个 seq：

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

然后我们通过是疾病还是健康来过滤它：

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

使用dplyr group_by，我们确保我们在每个id_casa 上单独运行它。

编辑：在基地：

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)

【讨论】：

【解决方案2】：

仅使用基础 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

【讨论】：