如何按组填写范围内缺失的日期
How to fill in missing dates in range by group
我有 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
")
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))))
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 - no packages 最后一行将 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"
class 第一。然后在应用 stack
之后,我们可以恢复 "Date"
class。 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"))
我有 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
")
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))))
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 - no packages 最后一行将 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"
class 第一。然后在应用 stack
之后,我们可以恢复 "Date"
class。 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"))