【问题标题】:adding missing dates into a data table based on some conditions in R根据 R 中的某些条件将缺失的日期添加到数据表中
【发布时间】:2020-05-20 07:46:24
【问题描述】:

我有一个这样的数据表:

timestamp    Status
05-01-2020    0
06-01-2020    0
07-01-2020    1
08-01-2020    1
09-01-2020    1
11-01-2020    0
13-01-2020    1

如果状态为1 并且状态0 出现在两个不同的日期,那么我需要填写缺失的日期。在第 9 日,状态的最后一个值为1,仅在第 11 日变为0。所以在这之间我有10个。我需要将这些日期添加到现有数据表中或创建一个新数据表并将状态设置为1

我知道这一点:

library(tidyverse)

complete(dt, status, timestamp)

预期输出:

 timestamp    Status
    05-01-2020    0
    06-01-2020    0
    07-01-2020    1
    08-01-2020    1
    09-01-2020    1
    10-01-2020    1
    11-01-2020    0
    13-01-2020    1

这应该在其间的任意天数内重复。但仅适用于1 and 0 之间而不是0 and 1 之间的条件

【问题讨论】:

    标签: r data.table


    【解决方案1】:

    使用滚动连接查找结束零之前的日期,然后为每个连续的一组日期填充缺失的日期:

    DT[Status==1L, nextzero := 
        DT[Status==0L][.SD, on=.(timestamp), roll=-Inf, x.timestamp - 1L]
    ]
    
    ans <- rbindlist(list(
            DT[Status==1L & !is.na(nextzero), 
                .(timestamp=seq(min(timestamp), nextzero, by="1 day"), Status=1L),
                nextzero],
            DT[Status==0L | is.na(nextzero)]
        ), use.names=TRUE)[, nextzero := NULL]
    
    setorder(ans, timestamp)[]
    

    数据:

    library(data.table)
    DT <- fread("timestamp    Status
    05-01-2020    0
    06-01-20200    
    07-01-2020    1
    08-01-2020    1
    09-01-2020    1
    11-01-2020    0
    13-01-2020    1")
    DT[, timestamp := as.IDate(timestamp, "%d-%m-%Y")]
    

    【讨论】:

      【解决方案2】:

      这是一个有趣的问题。如果我理解正确,如果前一个组有Status == 1 并且当前组有Status == 0,则OP 会要求在Status 的每组连续值之间插入额外的行。此外,我了解 Status == 1 连续填充缺失的日期是要求的。

      所以这里有两种不同的data.table 方法:

      1。对每个 Status == 0 组进行分组和附加行

      此解决方案从Matt Dowle's answer 借用到Get the last row of a previous group in data.table(参见here 了解另一个用例)。

      它在Status(使用rleid())中创建0/1值的连续条纹组。对于每个组,检查是否需要插入行。如果是这样,则将附加行添加到当前组的行之前(使用rbind())。

      library(data.table)
      options(datatable.print.class = TRUE)
      dt[, timestamp := as.IDate(timestamp, "%d-%m-%Y")]   # coerce character date to numeric 
      dt[, grp := rleid(Status)]   # create groups of consecutive values of Status
      dt[, new := ""]   # just for test & demonstration
      pg <- first(dt)  # initialise storage of last row of previous group
      dt[, {
        if (first(timestamp) - pg$timestamp > 1L & pg$Status == 1L) {
          # if there is a gap and Status switches from 1 to 0 the fill the gap
          add <- .(timestamp = seq(pg$timestamp + 1L, first(timestamp) - 1L, by = 1L), Status = 1L, new = "*")
        } else {
          # no gap to fill
          add <- .SD[0L]
        }
        pg <- last(.SD)   # remember last row
        rbind(add, .SD)   # prepend additional rows
      }, by = grp][, grp := NULL][]   # remove grouping variable
      
           timestamp Status    new
              <IDat>  <int> <char>
       1: 2020-01-05      0       
       2: 2020-01-06      0       
       3: 2020-01-07      1       
       4: 2020-01-08      1       
       5: 2020-01-09      1       
       6: 2020-01-10      1      *
       7: 2020-01-11      0       
       8: 2020-01-13      1       
       9: 2020-01-14      0       
      10: 2020-01-16      1       
      11: 2020-01-17      1       
      12: 2020-01-18      1      *
      13: 2020-01-19      1      *
      14: 2020-01-20      0
      

      请注意,已使用增强数据集(见下文)以进行更彻底的测试。此外,添加列new 只是为了演示插入行的位置。

      2。识别间隙、创建缺失的行、追加和重新排序

      这种方法是不同的。它识别要填补的空白,创建缺失的行,将它们附加到原始数据集,并按时间戳对行重新排序:

      library(data.table)
      options(datatable.print.class = TRUE)
      library(magrittr)   # piping used to improve readability
      dt[, timestamp := as.IDate(timestamp, "%d-%m-%Y")] # coerce character date to numeric
      lapply(
        dt[, .I[timestamp - shift(timestamp, fill = first(timestamp)) > 1L & shift(Status) == 1 & Status == 0]], 
        function(i) dt[, .(timestamp = seq(timestamp[i - 1L] + 1L, timestamp[i] - 1L, by = 1L), Status = 1L)]
      ) %>% 
        c(list(dt)) %>% 
        rbindlist() %>% 
        .[order(timestamp)]
      
           timestamp Status
              <IDat>  <int>
       1: 2020-01-05      0
       2: 2020-01-06      0
       3: 2020-01-07      1
       4: 2020-01-08      1
       5: 2020-01-09      1
       6: 2020-01-10      1
       7: 2020-01-11      0
       8: 2020-01-13      1
       9: 2020-01-14      0
      10: 2020-01-16      1
      11: 2020-01-17      1
      12: 2020-01-18      1
      13: 2020-01-19      1
      14: 2020-01-20      0
      

      表达式

      dt[, .I[timestamp - shift(timestamp, fill = first(timestamp)) > 1L & shift(Status) == 1 & Status == 0]]
      

      通过返回原始数据集dt 中的索引来标识要填补的空白,在这些空白处需要在之前插入其他行。

      [1]  6 11
      

      因此,需要分别在第 5 行到第 6 行和第 10 行到第 11 行之间插入额外的行。

      3。数据

      已扩展数据集以进行更彻底的测试。

      dt <- fread(
        "timestamp    Status
      05-01-2020    0
      06-01-2020    0
      07-01-2020    1
      08-01-2020    1
      09-01-2020    1
      11-01-2020    0
      13-01-2020    1
      14-01-2020    0
      16-01-2020    1
      17-01-2020    1
      20-01-2020    0")
      

      请注意,到目前为止发布的所有解决方案都假定dt 是通过增加timestamp 来排序的。如果没有,可以通过

      setorder(dt, timestamp)
      

      【讨论】:

        【解决方案3】:

        我们可以过滤我们想要扩展的行。选择行的条件是当前行Status为1,下一行Status为0或当前行Status为1,上一行Status为0。

        library(dplyr)
        df$timestamp <- as.Date(df$timestamp, '%d-%m-%Y')
        
        temp <- df %>% 
                filter(Status == 1 & lead(Status) == 0 | lag(Status) == 1 & Status == 0)
        

        然后在该数据框中创建两行的组并扩展它们以填充它们之间的日期并将Status更新为1。一旦我们扩展了数据集,我们就可以将它与原始数据集绑定以获得完整的数据集。

        temp %>%  
           group_by(grp = rep(1:n(), each = 2, length.out = n())) %>%
           tidyr::complete(timestamp = seq(min(timestamp), max(timestamp), by = 'day'), 
                           fill = list(Status = 1)) %>%
           ungroup %>%
           select(-grp) %>%
           bind_rows(anti_join(df, temp)) %>%
           arrange(timestamp)
        
        
        # A tibble: 8 x 2
        #  timestamp  Status
        #  <date>      <dbl>
        #1 2020-01-05      0
        #2 2020-01-06      0
        #3 2020-01-07      1
        #4 2020-01-08      1
        #5 2020-01-09      1
        #6 2020-01-10      1
        #7 2020-01-11      0
        #8 2020-01-13      1
        

        【讨论】:

          【解决方案4】:

          您可以创建一个在日期方面完整且Status 列是1 的临时数据框。

          dat$timestamp <- as.Date(dat$timestamp, format="%d-%m-%Y")  ## date format is needed
          tmp <- data.frame(timestamp=seq(dat$timestamp[1], by="day", length.out=nrow(dat)),
                     Status=1)
          

          然后使用matchrbind 滞后diff-1 的那一行。

          dat <-
            rbind(dat, 
                  tmp[match(dat$timestamp[match(-1, c(diff(dat$Status), NA))] + 1, tmp$timestamp), ])
          dat[order(dat$timestamp), ]  
          #     timestamp Status
          # 1  2020-01-05      0
          # 2  2020-01-06      0
          # 3  2020-01-07      1
          # 4  2020-01-08      1
          # 5  2020-01-09      1
          # 61 2020-01-10      1
          # 6  2020-01-11      0
          # 7  2020-01-13      1
          

          数据

          dat <- read.table(text="timestamp    Status
          05-01-2020    0
          06-01-2020    0
          07-01-2020    1
          08-01-2020    1
          09-01-2020    1
          11-01-2020    0
          13-01-2020    1", header=T)
          

          【讨论】:

            【解决方案5】:

            在您的数据中添加了更多行,以包含超过一天的缺失情况。

            
            library(tidyr)
            library(dplyr)
            library(lubridate)
            
              df %>%
                mutate(timestamp = as.Date(timestamp, format = "%d-%m-%Y"),
                     to_fill = case_when(Status == 1L & lead(Status) == 0L & difftime(lead(timestamp), timestamp, "days") > 1 ~ 1,
                                        TRUE ~ 0)) %>%
                complete(timestamp = seq.Date(min(timestamp), max(timestamp), by = "day")) %>%
                fill(to_fill) %>%
                mutate(Status = case_when(is.na(Status) & to_fill == 1 ~ 1L,
                                        TRUE ~ Status)) %>%
                na.omit() %>% 
                select(-to_fill)
            
            #> # A tibble: 14 x 2
            #>    timestamp  Status
            #>    <date>      <int>
            #>  1 2020-01-05      0
            #>  2 2020-01-06      0
            #>  3 2020-01-07      1
            #>  4 2020-01-08      1
            #>  5 2020-01-09      1
            #>  6 2020-01-10      1
            #>  7 2020-01-11      0
            #>  8 2020-01-13      1
            #>  9 2020-01-15      1
            #> 10 2020-01-16      1
            #> 11 2020-01-17      1
            #> 12 2020-01-18      0
            #> 13 2020-01-19      0
            #> 14 2020-01-22      1
            

            数据

            df <- data.frame(timestamp = c("05-01-2020", "06-01-2020", "07-01-2020", "08-01-2020", "09-01-2020", "11-01-2020", "13-01-2020", "15-01-2020", "18-01-2020", "19-01-2020", "22-01-2020"),
                             Status = c(0L, 0L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 0L, 1L ))
            

            reprex package (v0.3.0) 于 2020-05-20 创建

            【讨论】:

              猜你喜欢
              • 1970-01-01
              • 2021-08-18
              • 1970-01-01
              • 2013-10-19
              • 2021-05-06
              • 2021-07-16
              • 1970-01-01
              • 2021-10-26
              • 2017-12-02
              相关资源
              最近更新 更多