r - 如何按组填写范围内缺失的日期

Question

我有一个包含组和日期的data.frame。如何填写每组最小-最大日期范围内所有缺失的日期？

理想情况下，我会在 dplyr 中执行此操作。但最终，我只想用尽可能少的(可读)代码行来有效地完成此操作。下面是一个最小的例子。我实际上有很多约会和团体。我的两种方法看起来都有点丑陋。一定有更好的方法，对吗？

#### setup ####

library(sqldf)
library(dplyr)
df <- data.frame(the_group = rep(LETTERS[1:2], each=3), date = Sys.Date() + c(0:2, 1:3), stringsAsFactors = F) %>%
  tbl_df() %>%
  slice(-2) # represents that I may be missing data in a range!

#### dplyr approach with cross join dummy ####
full_seq <- data.frame(cross_join_dummy = 1, date = seq.Date(from=min(df$date), to=max(df$date), by = "day"))

range_by_group <- df %>%
  group_by(the_group) %>%
  summarise(min_date = min(date), max_date = max(date)) %>%
  ungroup() %>%
  mutate(cross_join_dummy = 1)

desired <- range_by_group %>%
  inner_join(full_seq, by="cross_join_dummy") %>%
  filter(date >= min_date, date <= max_date) %>%
  select(the_group, date)

#### sqldf approach ####
full_seq <- data.frame(date = as.character(seq.Date(from=min(df$date), to=max(df$date), by="day")))

df <- df %>%
  mutate(date = as.character(date))

range_by_group <- sqldf("
                  SELECT the_group, MIN(date) AS min_date, MAX(date) AS max_date
                  FROM df
                  GROUP BY the_group
                  ")

desired <- sqldf("
            SELECT rbg.the_group, fs.date
            FROM range_by_group rbg
            JOIN full_seq fs
              ON fs.date BETWEEN rbg.min_date AND rbg.max_date
            ")

Answer 1

1) 没有软件包 - by

这不使用任何包。 by 将 df 拆分为 df$the_group，然后对每一个执行指定的操作。 do.call("rbind", ...) 将组重新组合在一起。

seq_date <- function(x) seq(min(x), max(x), by = "day")
do.call("rbind", by(df, df$the_group, with, 
  data.frame(the_group = the_group[1], date = seq_date(date))))

2) data.table 这是使用 data.table 的解决方案。 seq_date 来自 (1)

library(data.table)

dt <- as.data.table(df)
dt[, list(date = seq_date(date)), by = the_group]

3) tidyverse 这使用 purrr 中的 map_df 将公式符号中给出的函数应用于组，并将结果放在一起到数据框中。 data_frame 来自 tibble 包。 seq_date 来自 (1)。

library(tidyverse)

df %>% 
   split(.$the_group) %>% 
   map_df(~ data_frame(the_group = .$the_group[1], date = seq_date(.$date)))

4) 点击

4a) tapply - tidyr/reshape2 seq_date 来自 (1)。

library(tidyr)
library(reshape2)

df %>%
   { tapply(.$date, .$the_group, seq_date, simplify = FALSE) } %>%
   melt %>%
   unnest

4b) tapply - 无软件包 最后一行将 tapply 的输出拼凑在一起，避免了对任何软件包的需要。 seq_date 来自 (1)。

ta <- tapply(df$date, df$the_group, seq_date, simplify = FALSE)
data.frame(the_group = rep(names(ta), lengths(ta)), date = do.call("c", ta))

4c) tapply -lattice 我们可以在 (4b) 的 ta 上使用lattice包的make.groups。 lattice 是预装 R 的，因此不需要安装任何额外的软件包。不幸的是，make.groups 删除了 Date class 属性，因此我们必须将其放回去。此外，make.groups 使用 which 和 data 列名称，以便我们修复列名称。

library(lattice)
with(do.call("make.groups", ta), 
  data.frame(the_group = which, date = structure(data, class = "Date")))

4d) tapply - 无包 - stack 我们可以使用 stack 将 ta 从 (4b) 转换为所需的形式，只要我们删除首先是 "Date" 类。然后在应用stack之后，我们可以恢复“Date”类。 stack 使用硬编码的列名称，我们使用 setNames 替换它。

stack_dates <- function(x) 
  transform(stack(lapply(x, as.vector)), values = structure(values, class = "Date"))
setNames(stack_dates(ta)[2:1], c("the_group", "date"))