如何使用 R 及时创建快照

Question

library(tidyverse)
df <- tibble(`Action Item ID` = c("ABC", "EFG", "HIJ", "KLM", "NOP", "QRS"),
`Date Created` = as.Date(c("2019-01-01", "2019-01-01", 
"2019-06-01", "2019-06-01",
"2019-08-01", "2019-08-01")),
`Date Closed` = as.Date(c("2019-01-15", "2019-05-31", 
"2019-06-15", "2019-07-05",
"2019-08-15", NA)),
`Current Status` = c(rep("Closed", 5), "Open"))
#> # A tibble: 6 x 4
#>   `Action Item ID` `Date Created` `Date Closed` `Current Status`
#>   <chr>            <date>         <date>        <chr>           
#> 1 ABC              2019-01-01     2019-01-15    Closed          
#> 2 EFG              2019-01-01     2019-05-20    Closed          
#> 3 HIJ              2019-06-01     2019-06-15    Closed          
#> 4 KLM              2019-06-01     2019-07-05    Closed          
#> 5 NOP              2019-08-01     2019-08-15    Closed          
#> 6 QRS              2019-08-01     NA            Open  

我正在尝试利用上面显示的数据框(tibble(逐月构建开放操作项目的线图。每个月都将是该月最后一天的时间快照(不再存在(。让我们看两个行动项目来说明我的问题。

在一月的最后一天午夜(我的第一个快照(：

• 第ABC项为"已关闭"，这与截至今天的当前状态相匹配。
• 第EFG项操作项是"打开"，但截至今天，它现在已以正确的Current Status == "Closed"关闭。但我想知道它是在 1 月 31 日开放的，并且能够计算所有这些事件。
• 我还希望看到在接下来的几个月中，该行动项目保持打开状态，需要持续计数，直到关闭

这似乎说起来容易做起来难。也许我只是没有经验。我可以在下面写的"魔术代码"是什么：

1. 从我的数据框中剥离所有月份，以如下所示的方式进行计数。
2. 用适当的值(甚至在需要时0(填充缺失的月份，即使它们不在我的数据框中，即tidyr::complete(。
3. 每月持续计算未结操作项，直到它们关闭

这是"魔术代码"的结果，由我手动执行。请注意，一切都必须自动化，我不能逐月手动更改月份名称。谢谢。

df.months <- "Magic Code"
#> # A tibble: 6 x 4
#> `Month`       `Action Item Qty Open at End of Month` 
#> <date>         <integer>    
#> 2019-01-01     1
#> 2019-02-01     1
#> 2019-03-01     1
#> 2019-04-01     1
#> 2019-05-01     0
#> 2019-06-01     1
#> 2019-07-01     0
#> 2019-08-01     1

Answer 1

这里有一种方法。首先将形状调整为较长的形式，然后将"创建"计为添加 1，将"封闭"计为递减。然后计算这些增量的每月总计，并填写缺失的月份。

df %>%
# convert to longer form, with one row for each Created or Closed
pivot_longer(-c(`Action Item ID`, `Current Status`), "type", "date") %>%
mutate(change = if_else(type == "Date Created", 1, -1)) %>%
mutate(month = lubridate::floor_date(value, "month")) %>%
arrange(value) %>%
# get the sum of "change" for each month. Equivalent to:
#    group_by(month) %>% summarize(n = sum(change) %>%
count(month, wt = change) %>%
# Add rows for any missing months in the series and replace NAs with 0's
padr::pad() %>%
replace_na(list(n=0)) %>%
# Track cumulative change across all months to date
mutate("Open at end of month" = cumsum(n))

## A tibble: 9 x 3
#  month          n `Open at end of month`
#  <date>     <dbl>                  <dbl>
#1 2019-01-01     1                      1
#2 2019-02-01     0                      1
#3 2019-03-01     0                      1
#4 2019-04-01     0                      1
#5 2019-05-01    -1                      0
#6 2019-06-01     1                      1
#7 2019-07-01    -1                      0
#8 2019-08-01     1                      1
#9 NA            -1                      0