Question

我认为例子更容易理解。所以这里是如何生成一个小的假数据集作为例子：

library(tidyr)
day_event<- as.Date("2017-03-01") + 0:6
a<-rep(1,7)
b<-as.numeric(c("", rep(1,6)))
c<-as.numeric(c("","",rep(1,5)))
df_1<-data.frame(day_event,a,b,c)
names(df_1)[2]<-"2017-03-08"
names(df_1)[3]<-"2017-03-09"
names(df_1)[4]<-"2017-03-10"

> df_1
  day_event 2017-03-08 2017-03-09 2017-03-10
1  2017-03-01          1         NA         NA
2  2017-03-02          1          1         NA
3  2017-03-03          1          1          1
4  2017-03-04          1          1          1
5  2017-03-05          1          1          1
6  2017-03-06          1          1          1
7  2017-03-07          1          1          1

我以df2格式获取数据集但是使用tidyr我可以从一种格式转到另一种格式：

df_2<-gather(df_1, day_measure, measure, -day_event)
> df_2
 day_event  day_measure measure
1   2017-03-01 2017-03-08       1
2   2017-03-02 2017-03-08       1
3   2017-03-03 2017-03-08       1
4   2017-03-04 2017-03-08       1
5   2017-03-05 2017-03-08       1
6   2017-03-06 2017-03-08       1
7   2017-03-07 2017-03-08       1
8   2017-03-01 2017-03-09      NA
9   2017-03-02 2017-03-09       1
10  2017-03-03 2017-03-09       1
11  2017-03-04 2017-03-09       1
12  2017-03-05 2017-03-09       1
13  2017-03-06 2017-03-09       1
14  2017-03-07 2017-03-09       1
15  2017-03-01 2017-03-10      NA
16  2017-03-02 2017-03-10      NA
17  2017-03-03 2017-03-10       1
18  2017-03-04 2017-03-10       1
19  2017-03-05 2017-03-10       1
20  2017-03-06 2017-03-10       1
21  2017-03-07 2017-03-10       1

对于上下文，它表示在day_event上发生的事件的度量。但是，根据执行度量的日期，event_day上事件的度量可能会有所不同！

我的问题是我只测量七天前的事件：这就是为什么day_mesure ='2017-03-09'的测量值为day_event ='2017-03-01'为NA

我想用最后一次测量的表演（day_event后7天）替换这个NA：在这种情况下，用'2017-03-08'上的措施代替

我试过

for (i in 1:length(df_2$measure)){
    row<- df_2[i,]
    if (row$day_event +7 < row$day_measure & length(df_2[df_2$day_event == row$day_event & df_2$day_measure == row$day_event + 7,]$measure)>0){
      row$measure<-df_2[df_2$day_event == row$day_event & df_2$day_measure == row$day_event + 7,]$measure
      df_2[i,]<-row
    }
}

有效:) 但是在我真实的数据集中，它需要永远：（

我认为R不喜欢这样的循环！你能想到另一种方法吗？

感谢您的帮助！

Answer 1

我正在分享我组织中的某些人回答的问题：是的解决方案是使用apply 方法如下：

df_temp <- df_2 %>% 
  dplyr::filter(day_event < day_measure - 7)

df_temp$measure <- apply(X = df_temp
                         , MARGIN = 1
                         , FUN = function(x) {
                            (df_2 %>% dplyr::filter(
                              day_event == x[[1]] & day_measure == (as.Date(x[[1]], format = "%Y-%m-%d") + 7)
                              ))$measure

                    })

df_2 <- rbind(df_2 %>% dplyr::filter(day_event >= day_measure - 7)
              , df_temp
)

我的样本只有42k行，但for循环需要几个小时该解决方案需要大约30秒

Answer 2

有为此特定目的而构建的功能，称为最后一次观察结转。其中一项功能是来自na.locf()包的zoo：

有了这个，完整的问题变成了一个单行（我在这里使用data.table，因为我更流利，而且通常使用更大的data.tables更快）：

library(data.table)
setDT(df_2)[order(day_event, day_measure), measure := zoo::na.locf(measure), by = day_event]

此处，行按事件日期排序，随后是测量日期。然后，缺少的元素由最后一次观察结束填充。此外，整个操作按事件日期分组，以确保如果每个组中的第一个测量值已经为NA，则不会结转错误值。

这比OP自己的答案更快，可以通过基准测试来证明（使用microbenchmark包）

基准测试结果

#Unit: milliseconds
#    expr       min        lq      mean    median        uq       max neval cld
#    loop 20.867890 22.037188 23.052667 22.665122 23.510681 27.535109   100   c
#   apply  9.011630  9.498314  9.834324  9.752323  9.994688 12.862594   100  b 
# na.locf  1.971389  2.132780  2.211467  2.226080  2.290762  2.656973   100 a

基准代码

由于所有3种方法都会更改数据，我们需要保留原始数据的副本。

library(data.table)
df_0 <- copy(df_2)
library(tidyr)

microbenchmark::microbenchmark(
  loop = {
    df_2 <- copy(df_0)
    for (i in 1:length(df_2$measure)){
      row <- df_2[i,]
      if (row$day_event +7 < row$day_measure & length(df_2[df_2$day_event == row$day_event & df_2$day_measure == row$day_event + 7,]$measure)>0){
        row$measure<-df_2[df_2$day_event == row$day_event & df_2$day_measure == row$day_event + 7,]$measure
        df_2[i,]<-row
      }
    }
  },
  apply = {
    df_2 <- copy(df_0)
    df_temp <- df_2 %>% 
      dplyr::filter(day_event < day_measure - 7)

    df_temp$measure <- apply(X = df_temp
                             , MARGIN = 1
                             , FUN = function(x) {
                               (df_2 %>% dplyr::filter(
                                 day_event == x[[1]] & day_measure == (as.Date(x[[1]], format = "%Y-%m-%d") + 7)
                               ))$measure

                             })

    df_2 <- rbind(df_2 %>% dplyr::filter(day_event >= day_measure - 7)
                  , df_temp
    )

  },
  na.locf = {
    df_2 <- copy(df_0)
    df_2[order(day_event, day_measure), measure := zoo::na.locf(measure), by = day_event]
  })

Answer 3

我添加了我组织中其他人提出的其他解决方案：此解决方案基于dplyr，似乎比我上周提出的apply解决方案更快

library(tidyr)
day_event<- as.Date("2017-03-01") + 0:6
a<-rep(1,7)
b<-as.numeric(c("", rep(1,6)))
c<-as.numeric(c("","",rep(1,5)))
df_1<-data.frame(day_event,a,b,c)
names(df_1)[2]<-"2017-03-08"
names(df_1)[3]<-"2017-03-09"
names(df_1)[4]<-"2017-03-10"

df_1

df_2<-gather(df_1, day_measure, measure, -day_event)



fill_measure <- function(day_event, day_measure, measure){
  # return a modified measure vector
  # day_event should have only a single value here

  # test if correct day_measure exist
  if (any(day_measure == day_event + 7)){
    rst <- measure
    rst[day_measure > day_event + 7] <- measure[day_measure == day_event + 7]
  }else{
    rst <- measure
  }

  return(rst)
}

test <- df_2 %>% 
  dplyr::group_by(day_event) %>% 
  dplyr::mutate(measure_new = fill_measure(day_event, day_measure, measure)) %>% 
  dplyr::ungroup()

R - 数据帧上的循环非常慢以替换值

3 个答案:

基准测试结果

基准代码