Как заполнить отсутствующие даты в диапазоне по группе

Question

У меня есть data.frame групп и дат. Как заполнить все отсутствующие даты в диапазоне дат max-max для каждой группы?

В идеале я бы сделал это в 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)))) 

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 Это использует map_df от purrr применить функцию, заданную в формуле обозначений над группами, и поместить результат вместе в кадре данных. data_frame - это из пакета. seq_date - из (1).

library(tidyverse) 

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

4) tapply

4а) tapply - tidyr/reshape2seq_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)) 

4с) tapply - решетка Мы можем использовать решетку пакета 'make.groups на ta из (4б). решетка предварительно установлена ​​с 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 для преобразования 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"))