我正在寻找一种高效,快速的方法来将丢失的数据填充到缺少日期的表中。
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
在具有许多组的大型数据集上非常慢。
This方法与我需要的方法非常接近,但是如果我遵循该方法,我将无法获得所需的输出,因为它不仅可以填充缺少的日期,而且还可以填充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
)上方重现输出的最佳(最快)方法是什么?
答案 0 :(得分:3)
我将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
与OP预期的相比,这里还有两行
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
中(如在OP中)。要应用该规则...
drop_rows = res[!dt, on=.(gr1,gr2,date)][date %in% dt$date, .(gr1,gr2,date)]
res[!drop_rows, on=names(drop_rows)]
(由于likely bug,需要copy(.SD)
。)
答案 1 :(得分:2)
在滚动连接,一个“普通”连接和一些列切换上,aaa完成:)
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
您当然可以通过将第一行集成到最后一行来使其成为一个单行。
答案 2 :(得分:0)
这与另一个问题有点类似,尽管要注意一个重复项。该方法类似,但是具有data.tables和多个列。另请参阅:Fill in missing date and fill with the data above
在这里,尚不清楚您是否要填写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
答案 3 :(得分:0)
dt
对于date
的每个组合,所有唯一gr*
都应具有NA,但不会显示。因此,我们使用CJ
和一个联接用x的NA填充那些缺少的日期。
然后,为所有必需的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')
请尝试您的实际数据集。