对于我正在进行的项目，我需要一个数据框来指示一个人在某一天是否缺席（0）或不缺席（1）。
问题是：我的数据的格式是，它给出了absenteïsm的开始日期，然后是该人员缺席的天数。
我的数据帧示例：
df1 <- data.frame(Person = c(1,1,1,1,1),
StartDate = c("01-01","02-01","03-01","04-01","05-01"),
DAYS = c(3,NA,NA,NA,1))
不是每个人的“开始日期”和“缺席天数”，而是应该看起来像这样：
df2 <- data.frame(Person = c(1,1,1,1,1),
Date = c("01-01","02-01","03-01","04-01","05-01"),
Absent = c(1,1,1,0,1))
现在我用这个带有两个if条件的for循环解决了它：
for(i in 1:nrow(df1)){
if(!is.na(df1$DAYS[i])){
var <- df1$DAYS[i]
}
if(var > 0){
var <- var-1
df1$DAYS[i] <- 1
}
}
这是有效的，但是我有成千上万的人，每个人都有一整年的日期，这意味着我的数据框中有超过500万行。你可以想象循环有多慢。
有谁知道更快捷的方法来解决我的问题？我试着查看rubridate包来处理句点和日期，但我没有看到解决方案。
这是一种基于生成应设置为1的观察指数，然后填充值的方法。
# The data
df1 <- data.frame(Person = c(1,1,1,1,1),
StartDate = c("01-01","02-01","03-01","04-01","05-01"),
DAYS = c(3,NA,NA,NA,1))
# Initialize the vector we want with zeros
df1$Absent <- 0
# we get the indices of all the non-zero day entries
inds <- which(!is.na(df1$DAYS))
# Now we are going to build a list of all the indices that should be
# set to one. These are the intervals from when absence starts to
# the number of days absent - 1
inds_to_change <- mapply(function(i,d){i:(i+d-1)}, inds, na.omit(df1$DAYS))
df1$Absent[unlist(inds_to_change)] <- 1
df1
#> Person StartDate DAYS Absent
#> 1 1 01-01 3 1
#> 2 1 02-01 NA 1
#> 3 1 03-01 NA 1
#> 4 1 04-01 NA 0
#> 5 1 05-01 1 1
由reprex package创建于2019-02-20（v0.2.1）
通过使用集成的R函数可以找到更快的解决方案。
a，位置为p。p:(p + a - 1)定义的每个位置插入值1。这可以全部实现到一个函数中，然后应用于所有子组。为了更快
对于使用mapply的特定情况（如前面的答案所示），但是对于较大的数据集，使用data.table通常会更快。这在下面使用。
RelocateAbsentees <- function(x){
#Find the position in x for which the value is greater than 1
pos <- which(x > 1)
#Fill in the vector with the absent days
for(i in pos){
val <- x[i]
x[i:(i + val - 1)] <- 1
}
#return the vector
pos
}
df1 <- data.frame(Person = c(1,1,1,1,1),
StartDate = c("01-01","02-01","03-01","04-01","05-01"),
DAYS = c(3,NA,NA,NA,1))
library(data.table)
setDT(df1)
df2 <- copy(df1)[,Person := 2]
df3 <- rbind(df1,df2)
#Using data.table package (faster)
df1[, newDays := RelocateAbsentees(DAYS), by = Person]
df3[, newDays := RelocateAbsentees(DAYS), by = Person]
我发现使用tidyverse非常简洁的解决方案：
library(tidyverse)
df1 %>%
group_by(Person) %>%
mutate(Abs = map_dbl(DAYS, ~ {
if (!is.na(.x)) {
d <<- .x
+(d > 0)
} else {
d <<- d - 1
+(d > 0)
}
}))
首先，你原来的做法并不是那么糟糕。一些小的改进可以使它比gfgm更快（从我的测试，我不知道你的确切数据结构）：
improvedOP <- function(d) {
days <- d$DAYS # so we do not repeatedly change data.frames column
ii <- !is.na(days) # this can be calculated outside the loop
for (i in 1:nrow(d)) {
if (ii[i]) var <- days[i]
if (var > 0) {
var <- var - 1
days[i] <- 1
}
}
return(days)
}
我提出了这种方法：
minem <- function(d) {
require(zoo)
rn <- 1:nrow(d) # row numbers
ii <- rn + d$DAYS - 1L # get row numbers which set to 1
ii <- na.locf(ii, na.rm = F) # fill NA forward
ii <- rn <= ii # if row number less or equal than interested row is 1
ii[ii == 0] <- NA # set 0 to NA to match original results
as.integer(ii)
}
all.equal(minem(d), improvedOP(d))
# TRUE
我们的想法是计算需要为1的行数（当前行+ DAYS - 1）。然后用这个值填充NA，如果row匹配我们的条件设置为1.这应该比任何其他方法更快，这涉及创建序列。
更大（7.3密耳行）模拟数据的基准：
gfgm <- function(d) {
days <- rep(0, nrow(d))
inds <- which(!is.na(d$DAYS))
inds_to_change <- mapply(function(i, d) {i:(i + d - 1)}, inds, na.omit(d$DAYS))
days[unlist(inds_to_change)] <- 1
days
}
nrow(d)/1e6 # 7.3 mil
require(bench)
require(data.table)
bm <- bench::mark(minem(d), improvedOP(d), gfgm(d), iterations = 2, check = F)
as.data.table(bm[, 1:7])
# expression min mean median max itr/sec mem_alloc
# 1: minem(d) 281.34ms 302.85ms 302.85ms 324.35ms 3.3019990 408MB
# 2: improvedOP(d) 747.45ms 754.55ms 754.55ms 761.65ms 1.3252907 139MB
# 3: gfgm(d) 3.23s 3.27s 3.27s 3.31s 0.3056558 410MB
附：但实际结果可能取决于DAYS值的分布。