Самый быстрый способ заполнения пропущенных дат для data.table (продолжение)

Question

Я ищу эффективный и быстрый подход для заполнения отсутствующих данных в таблице с отсутствующими датами.

library(data.table)
dt <- as.data.table(read.csv(textConnection('"date","gr1","gr2","x"
                                            "2017-01-01","A","a",1
                                            "2017-02-01","A","b",2
                                            "2017-02-01","B","a",4
                                            "2017-04-01","B","a",5
                                            "2017-05-01","A","b",3')))
dt[,date := as.Date(date)] 

Предположим, что эта таблица содержит всю информацию для x от date и групп gr1 и gr2. Я хочу заполнить пропущенные даты и расширить эту таблицу, повторяя последние известные значения x на gr1 и gr2. Мой подход заключается в следующем:

# define the period to expand
date_min <- as.Date('2017-01-01')
date_max <- as.Date('2017-06-01')
dates <- setDT(list(ddate = seq.Date(date_min, date_max,by = 'month')))

# cast the data
dt.c <- dcast(dt, date~gr1+gr2, value.var = "x")
# fill missing dates
dt.c <- dt.c[dates, roll=Inf]

# melt the data to return to original table format
dt.m <- melt(dt.c, id.vars = "date", value.name = "x")

# split column - the slowest part of my code
dt.m[,c("gr1","gr2") := tstrsplit(variable,'_')][,variable:=NULL]

# remove unnecessary NAs
dt.m <- dt.m[complete.cases(dt.m[,x])][,.(date,gr1,gr2,x)]
setkey(dt.m)

Это вывод, который я ожидаю увидеть:

> dt.m
         date gr1 gr2 x
1: 2017-01-01   A   a 1
2: 2017-02-01   A   b 2
3: 2017-02-01   B   a 4
4: 2017-03-01   A   b 2
5: 2017-03-01   B   a 4
6: 2017-04-01   B   a 5
7: 2017-05-01   A   b 3
8: 2017-06-01   A   b 3

Теперь проблема в том, что tstrsplit очень медленно работает с большими наборами данных с большим количеством групп.

Этот подход очень близок к тому, что мне нужно, но если я буду им следовать, я не смогу получить желаемый результат, так как он заполняет не только пропущенные даты, но и NA. Это моя модификация примера:

# the desired dates by group
date_min <- as.Date('2017-01-01')
date_max <- as.Date('2017-06-01')
indx <- dt[,.(date=seq(date_min,date_max,"months")),.(gr1,gr2)]

# key the tables and join them using a rolling join
setkey(dt,gr1,gr2,date)
setkey(indx,gr1,gr2,date)
dt0 <- dt[indx,roll=TRUE][,.(date,gr1,gr2,x)]
setkey(dt0,date)

И это не тот вывод, который я ожидаю увидеть:

> dt0
          date gr1 gr2  x
 1: 2017-01-01   A   a  1
 2: 2017-01-01   A   b NA
 3: 2017-01-01   B   a NA
 4: 2017-02-01   A   a  1
 5: 2017-02-01   A   b  2
 6: 2017-02-01   B   a  4
 7: 2017-03-01   A   a  1
 8: 2017-03-01   A   b  2
 9: 2017-03-01   B   a  4
10: 2017-04-01   A   a  1
11: 2017-04-01   A   b  2
12: 2017-04-01   B   a  5
13: 2017-05-01   A   a  1
14: 2017-05-01   A   b  3
15: 2017-05-01   B   a  5
16: 2017-06-01   A   a  1
17: 2017-06-01   A   b  3
18: 2017-06-01   B   a  5

Какой самый лучший (самый быстрый) способ воспроизвести мой вывод выше (dt.m)?

Answer 1

Я бы использовал IDate и целочисленный счетчик для последовательности дат:

dt[, date := as.IDate(date)]
dates = seq(as.IDate("2017-01-01"), as.IDate("2017-06-01"), by="month")
dDT = data.table(date = dates)[, dseq := .I][]

dt[dDT, on=.(date), dseq := i.dseq]

Затем перечислил бы все желаемые комбинации (gr1, gr2, dseq) и сделал бы пару обновлений объединений:

cDT = CJ(dseq = dDT$dseq, gr1 = unique(dt$gr1), gr2 = unique(dt$gr2))

cDT[, x := dt[cDT, on=.(gr1, gr2, dseq), x.x]]
cDT[is.na(x), x := dt[copy(.SD), on=.(gr1, gr2, dseq), roll=1L, x.x]]

res = cDT[!is.na(x)]
res[dDT, on=.(dseq), date := i.date]

    dseq gr1 gr2 x       date
 1:    1   A   a 1 2017-01-01
 2:    2   A   a 1 2017-02-01
 3:    2   A   b 2 2017-02-01
 4:    2   B   a 4 2017-02-01
 5:    3   A   b 2 2017-03-01
 6:    3   B   a 4 2017-03-01
 7:    4   B   a 5 2017-04-01
 8:    5   A   b 3 2017-05-01
 9:    5   B   a 5 2017-05-01
10:    6   A   b 3 2017-06-01

Здесь есть две дополнительные строки по сравнению с ожидаемым ОП

res[!dt.m, on=.(date, gr1, gr2)]

   dseq gr1 gr2 x       date
1:    2   A   a 1 2017-02-01
2:    5   B   a 5 2017-05-01

, поскольку я обрабатываю каждое пропущенное значение gr1 x gr2 независимо, а не заполняю его, если дата не в dt вообще (как в ОП).Чтобы применить это правило ...

drop_rows = res[!dt, on=.(gr1,gr2,date)][date %in% dt$date, .(gr1,gr2,date)]
res[!drop_rows, on=names(drop_rows)]

(copy(.SD) необходим из-за вероятной ошибки .)

Answer 2

При скользящем соединении, одно «нормальное» соединение и некоторое переключение столбцов, ааа, и все готово:)

temp <- dates[, near.date := dt[dates, x.date, on = .(date=ddate), roll = TRUE, mult = "first"]][]
dt[temp, on = .(date = near.date)][, date := ddate][,ddate := NULL][]

#          date gr1 gr2 x
# 1: 2017-01-01   A   a 1
# 2: 2017-02-01   A   b 2
# 3: 2017-02-01   B   a 4
# 4: 2017-03-01   A   b 2
# 5: 2017-03-01   B   a 4
# 6: 2017-04-01   B   a 5
# 7: 2017-05-01   A   b 3
# 8: 2017-06-01   A   b 3

Вы можете (конечно) сделать его однострочным, интегрировав первый ряд в последний.

Answer 3

dt должен иметь NA для всех уникальных date для каждой комбинации gr*, но не отображается. Следовательно, мы используем CJ и объединение, чтобы заполнить эти пропущенные даты символом NA для x.

После этого разверните набор данных для всех необходимых ddates.

Наконец, отфильтруйте строки, где x равен NA, и упорядочите по дате, чтобы выходные данные имели те же характеристики, что и исходные dt.

dt[, g := .GRP, .(gr1, gr2)][
    CJ(date=date, g=g, unique=T), on=.(date, g)][, 
        .SD[.(date=ddate), on=.(date), roll=Inf], .(g)][
            !is.na(x)][order(date)]

выход:

   g       date gr1 gr2 x
1: 1 2017-01-01   A   a 1
2: 2 2017-02-01   A   b 2
3: 3 2017-02-01   B   a 4
4: 2 2017-03-01   A   b 2
5: 3 2017-03-01   B   a 4
6: 3 2017-04-01   B   a 5
7: 2 2017-05-01   A   b 3
8: 2 2017-06-01   A   b 3

данные:

library(data.table)
dt <- fread('date,gr1,gr2,x
    2017-01-01,A,a,1
    2017-02-01,A,b,2
    2017-02-01,B,a,4
    2017-04-01,B,a,5
    2017-05-01,A,b,3')
dt[,date := as.Date(date)] 

date_min <- as.Date('2017-01-01')
date_max <- as.Date('2017-06-01')
ddate = seq.Date(date_min, date_max,by = 'month')

Пожалуйста, попробуйте ваш фактический набор данных.

Answer 4

Это немного похоже на другой вопрос, хотя обратите внимание именно на дубликат. Подход аналогичен, но с data.tables и с несколькими столбцами. См. Также: Заполните отсутствующую дату и заполните данными выше

Здесь неясно, хотите ли вы заполнить столбцы gr2 и x или что делает gr2. Я предполагаю, что вы пытаетесь заполнить пробелы с датами с шагом в 1 месяц. Кроме того, поскольку максимальный месяц для входных данных равен 5 (май), требуемый выходной результат имеет значение до 6 (июнь), поэтому неясно, как достигается июнь, если целью является заполнение между датами ввода - но если есть внешний максимум, это может быть установлен вместо максимального количества вводимых дат

library(data.table)
library(tidyr)
dt <- as.data.table(read.csv(textConnection('"date","gr1","gr2","x"
                                            "2017-01-01","A","a",1
                                            "2017-02-01","A","b",2
                                            "2017-02-01","B","a",4
                                            "2017-04-01","B","a",5
                                            "2017-05-01","A","b",3')))
dt[,date := as.Date(date)] 
setkeyv(dt,"date")

all_date_groups <- dt[,list(date=seq.Date(from=min(.SD$date),to=max(.SD$date),by="1 month")),by="gr1"]
setkeyv(all_date_groups,"date")

all_dates_dt <- dt[all_date_groups,on=c("date","gr1")]
setorderv(all_dates_dt,c("gr1","date"))

all_dates_dt <- fill(all_dates_dt,c("gr2","x"))
setorderv(all_dates_dt,c("date","gr1"))
all_dates_dt

Результаты:

> all_dates_dt
         date gr1 gr2 x
1: 2017-01-01   A   a 1
2: 2017-02-01   A   b 2
3: 2017-02-01   B   a 4
4: 2017-03-01   A   b 2
5: 2017-03-01   B   a 4
6: 2017-04-01   A   b 2
7: 2017-04-01   B   a 5
8: 2017-05-01   A   b 3