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将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))))将各组重新组合在一起。

seq_date

2）data.table 以下是使用data.table的解决方案。 library(data.table) dt <- as.data.table(df) dt[, list(date = seq_date(date)), by = the_group]来自（1）

map_df

3）tidyverse 这使用purrr中的data_frame将公式表示法中给出的函数应用于组，并将结果放在一起作为数据框。 library(tidyverse) df %>% split(.$the_group) %>% map_df(~ data_frame(the_group = .$the_group[1], date = seq_date(.$date)))来自tibble包。 seq_date来自（1）。

seq_date

4）tapply

4a）tapply - tidyr / reshape2 library(tidyr) library(reshape2) df %>% { tapply(.$date, .$the_group, seq_date, simplify = FALSE) } %>% melt %>% unnest来自（1）。

tapply

4b）tapply - 没有软件包最后一行将seq_date的输出组合在一起，无需任何软件包。 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))来自（1）。

make.groups

4c）tapply - lattice 我们可以使用来自（4b）的ta上的网格包make.groups。网格预先安装了R，因此不需要安装任何其他软件包。遗憾的是class删除了日期make.groups属性，因此我们必须将其归还。此外，which使用data和library(lattice) with(do.call("make.groups", ta), data.frame(the_group = which, date = structure(data, class = "Date")))列名称，因此我们会修改列名称。

stack

4d）tapply - 没有包 - 堆栈我们可以使用ta将"Date"从（4b）转换为所需的表单，前提是我们删除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"))替换的硬编码列名称。

{{1}}

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

1 个答案: