具有动态列范围的行和

Question

我正在处理一个大型健康保险数据集，并且我对具有某些索赔代码的参与者感兴趣。我的入选标准之一是参与者必须在索赔日期之前一年和之后一年投保。例如，如果他们在 2017 年 9 月 27 日受伤，他们需要从 2016 年 9 月 27 日到 2018 年 9 月 27 日的保险。

我尝试做一个简单的 rowsum，并使用 apply，但两者都有相同的问题：in from:to : numerical expression has # elements: only the first used。现在，我将范围保存为数据框中的变量。它认为我理解我为什么会遇到这个问题——它期待一个数字并接收一个向量。我怎样才能让它有条件地选择要求和的列。我将在下面包含我的代码。

在我的示例中，我只是想计算参与者在事故前后 6 个月内投保的月数。 ins_#_# 变量是一个简单的“是/否”，表示参与者当月是否有保险。任何指导表示赞赏！

library(tidyverse)
set.seed(1)
df <- data.frame(id= seq(1,100),
                 injury_date = sample(seq(as.Date('2017/01/01'), as.Date('2017/12/31'), by="day"), 100),
                 ins_07_16 = sample(c(0,1), replace = TRUE),
                 ins_08_16 = sample(c(0,1), replace = TRUE),
                 ins_09_16 = sample(c(0,1), replace = TRUE),
                 ins_10_16 = sample(c(0,1), replace = TRUE),
                 ins_11_16 = sample(c(0,1), replace = TRUE),
                 ins_12_16 = sample(c(0,1), replace = TRUE),
                 ins_01_17 = sample(c(0,1), replace = TRUE),
                 ins_02_17 = sample(c(0,1), replace = TRUE),
                 ins_03_17 = sample(c(0,1), replace = TRUE),
                 ins_04_17 = sample(c(0,1), replace = TRUE),
                 ins_05_17 = sample(c(0,1), replace = TRUE),
                 ins_06_17 = sample(c(0,1), replace = TRUE),
                 ins_07_17 = sample(c(0,1), replace = TRUE),
                 ins_08_17 = sample(c(0,1), replace = TRUE),
                 ins_09_17 = sample(c(0,1), replace = TRUE),
                 ins_10_17 = sample(c(0,1), replace = TRUE),
                 ins_11_17 = sample(c(0,1), replace = TRUE),
                 ins_12_17 = sample(c(0,1), replace = TRUE),
                 ins_01_18 = sample(c(0,1), replace = TRUE),
                 ins_02_18 = sample(c(0,1), replace = TRUE),
                 ins_03_18 = sample(c(0,1), replace = TRUE),
                 ins_04_18 = sample(c(0,1), replace = TRUE),
                 ins_05_18 = sample(c(0,1), replace = TRUE),
                 ins_06_18 = sample(c(0,1), replace = TRUE))

df <- df %>% 
  mutate(month = as.numeric(format(as.Date(injury_date), "%m")), #pulling month of injury
         low_mo = month + 2,
         high_mo = month + 14)


df$insured <- rowSums(df[df$low_mo:df$high_mo]) #only uses first element

df$insured <- apply(df[df$low_mo:df$high_mo], 1, sum) #only uses first element

---

编辑： 虽然我没有具体说明我想要一个快速的解决方案，但我正在处理大量数据，因此我测试了 @akrun 的哪个解决方案最快。我更改了数据框，所以它是 1e5 (100,000) 行。如果有人好奇，结果如下。

microbenchmark(o1 <- sapply(seq_len(nrow(df)), function(i) sum(df[i, df$low_mo[i]:df$high_mo[i]])),
               o2 <- {colInd <- Map(`:`, df$low_mo, df$high_mo);
               rowInd <- rep(seq_len(nrow(df)), lengths(colInd));
               as.vector(tapply(df[-(1:2)][cbind(rowInd, unlist(colInd)-2)], 
                                rowInd, FUN = sum))},
               o3 <- {colInd1 <- Map(function(x, y) which(!seq_along(df) %in% x:y), df$low_mo, df$high_mo);
               rowInd1 <- rep(seq_len(nrow(df)), lengths(colInd1));
               rowSums(replace(df, cbind(rowInd1, unlist(colInd1)), NA)[-(1:2)], na.rm = TRUE)},
               times = 5)


     Unit: milliseconds



   expr         min         lq       mean     median         uq        max neval
     o1  20408.5072 20757.0285 20903.9386 20986.2275 21069.3163 21298.6137     5
     o2    433.5463   436.3066   448.6448   455.6551   456.8836   460.8325     5
     o3    470.6834   482.4449   492.9594   485.6210   504.1353   521.9122     5

> identical(o1, o2)
[1] TRUE
> identical(o2, o3)
[1] TRUE

Answer 1

有几种方法可以做到这一点。循环遍历行序列，通过行索引对数据集进行子集化，并通过对每一行取'low_mo'和'high_mo'的序列生成的列，得到sum

o1 <- sapply(seq_len(nrow(df)), function(i) sum(df[i, df$low_mo[i]:df$high_mo[i]]))

---

或者另一种选择是根据row/column 索引提取元素，然后按sum 进行分组

colInd <- Map(`:`, df$low_mo, df$high_mo)
rowInd <- rep(seq_len(nrow(df)), lengths(colInd))
o2 <- as.vector(tapply(df[-(1:2)][cbind(rowInd, unlist(colInd)-2)], 
        rowInd, FUN = sum))
identical(o1, o2)
#[1] TRUE

---

或者另一种方法是将不在序列中的列值更改为NA并使用rowSums

colInd1 <- Map(function(x, y) which(!seq_along(df) %in% x:y), df$low_mo, df$high_mo)
rowInd1 <- rep(seq_len(nrow(df)), lengths(colInd1))
o3 <- rowSums(replace(df, cbind(rowInd1, unlist(colInd1)), 
               NA)[-(1:2)], na.rm = TRUE)
identical(o1, o3)
#[1] TRUE