我正在使用大型健康保险数据集,并且对具有某些理赔代码的参与者感兴趣。我的入选标准之一是,参与者必须在索赔日期之前和之后一年被保险。例如,如果他们在2017年9月27日受伤,则需要从9/27 / 2016-9 / 27/2018开始保险。
我尝试做一个简单的rowum,并使用apply,但是两者都有相同的问题:in from:to : numerical expression has # elements: only the first used
。现在,我将范围另存为数据帧中的变量。它认为我理解我为什么会遇到问题-它正在期待一个数字并收到一个向量。我如何才能有条件地选择要累加的列。我将在下面包含我的代码。
在我的示例中,我只是试图计算参与者在事故发生前后六个月的保险月数。对于参与者是否为当月投保,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
答案 0 :(得分:2)
有两种方法可以做到这一点。遍历行序列,按行索引对数据集进行子集,并通过对每行取'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