这个缓慢的 for 循环有什么替代方法来填充日期之间的一天？

Question

对于我正在从事的项目，我需要一个数据框来指示某个人在特定的一天是缺席 (0) 还是缺席 (1)。

问题是：我的数据格式为缺勤的开始日期，然后是此人缺勤的天数。

我的数据框示例：

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

而不是每人 "Start date" 和 "number of days absent"，它应该是这样的：

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 万行。你可以想象循环有多慢。

有谁知道解决我的问题的更快方法吗？我试着查看 lubridate 包以处理句点和日期，但我没有在那里看到解决方案。

Answer 1

这是一种基于生成所有应设置为 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 (v0.2.1)}

于 2019-02-20 创建

Answer 2

使用集成的 R 函数可以找到更快的解决方案。

大意：

对每个人，求出缺勤天数大于1的位置，设缺勤天数为a，位置为p.
在序列 p:(p + a - 1) 定义的每个位置插入值 1。
Return 重新定义的矢量，代替旧矢量。

这都可以实现成一个函数，然后应用于所有子组。为了更快

函数

对于特定情况，使用 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]

Answer 3

我使用 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)
    }
  }))

Answer 4

首先，你原来的做法还不错。一些小的改进可以使它比 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，如果行匹配我们的条件设置为 1。这应该比任何其他涉及创建序列的方法都要快。

更大（730 万行）模拟数据的基准：

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

P.S。但实际结果可能取决于 DAYS 值的分布。

这个缓慢的 for 循环有什么替代方法来填充日期之间的一天？

What is an alternative for this slow for-loop to fill in single days between dates?

performance

conditional

for-loop

r

date

大意：

函数