R：更快地合并数据帧
我刚刚开始使用R并编写了以下代码，但这需要大约40分钟来处理，所以我确信这可以以更快的速度编码。
基本上，我有一个大约7GB大小的数据集（crsp_td_net）和第二个较小的数据集（ff_35f）。两者都包含交易日期。我想要做的是在第一个数据集中填写每个公司的交易日期。
从我的第一个数据集开始，我根据公司索引创建数据子集，然后根据交易日期将每个子集与第二个数据集合并。这个合并的数据集被附加到其他公司数据集等等，直到最后，我留下了一个包含所有初始公司的大数据集，但是包含了缺少的交易日。
此时我不确定数据帧final继续扩展的事实是导致我的循环运行缓慢还是循环本身编码效率低下。我知道数据的矢量化可以帮助加快速度，但我不知道如何在这里做到这一点（每个公司的数据子集的矩阵大小不断变化）。我也不确定使用apply，sapply或lapply（如果可以在此使用其中任何一项）的最佳方法。我在R上浏览了一些问题，但我还没有找到解决这个问题的方法。我非常感谢另一段代码，可以使下面的代码运行得更快。
todo<-matrix(numeric(0), 0,4)
for (i in 1:7396) {
final<- crsp_td_net %>%
filter(compid==i) %>%
merge(ff_35f,by="date_crsp",all=TRUE)
final<-final%>% filter(between(date_crsp,
as.Date(min(date_crsp_orig,na.rm="TRUE")),
as.Date(max(date_crsp_orig, na.rm="TRUE")))) %>%
arrange(date_crsp) %>%
mutate(cusip8dg_compustat =
ifelse(is.na(cusip8dg_compustat),
max(cusip8dg_compustat, na.rm="TRUE"),
cusip8dg_compustat)) %>%
mutate(compid = ifelse(is.na(compid), i, compid))%>%
select(compid, cusip8dg_compustat, date_crsp,
date_crsp_orig)%>%
distinct()
todo<-bind_rows(todo,final)
}
提前致谢，
开发
谢谢大家的回复。由于响应限制，我无法在评论框中回复，因此我将添加到原始帖子中。 @P Lapointe，请找到一个可重复的数据集（我使用的是整数值而不是实际日期）@ eipi10 - 我认为你已经理解了我所追求的并感谢代码，但我不确定它是否遗漏了一些东西，因为它正在提示输入（我有所有相关的库）。 @Alistaire - 当我执行更多计算以添加到原始数据集时，我确实会遇到内存问题。感谢您关于如何使循环更快/替代它的建议，这将有助于理解它们将如何在下面的示例中实现。
非常感谢zz <- "compid date_crsp
1 1 2
2 1 3
3 1 5
4 2 3
5 2 7
6 2 9
7 3 3
8 3 5
9 3 7
10 3 8"
crsp_td_net <- read.table(text=zz, header = TRUE)
xx <- "date_crsp
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
10 10
11 11"
ff_35f <- read.table(text=xx, header = TRUE)
# I expect my final output to look like this:
yy<-"compid date_crsp
1 1 2
2 1 3
3 1 4
4 1 5
5 2 3
6 2 4
7 2 5
8 2 6
9 2 7
10 2 8
11 2 9
12 3 3
13 3 4
14 3 5
15 3 6
16 3 7
17 3 8"
output_wanted<-read.table(text=yy, header = TRUE)
df <- full_join(crsp_td_net, expand.grid(compid = unique(crsp_td_net$compid), date_crsp=unique(ff_35f$date_crsp)))
todo<-array(numeric(),c(1,4,0))
todo<-matrix(numeric(0), 0,0)
for (i in 1:3) {
final<- filter(crsp_td_net,compid==i)
final<- mutate(final,date_crsp_orig=date_crsp)
final<- merge(final,ff_35f, by="date_crsp",all=TRUE)
final<- filter(final,between(date_crsp, min(date_crsp_orig, na.rm=TRUE), max(date_crsp_orig, na.rm=TRUE)))
final<- arrange(final,date_crsp)
final<- mutate(final,compid = ifelse(is.na(compid), i, compid))
final<- select(final,compid, date_crsp)
final<- distinct(final)
todo<-bind_rows(todo,final)
}
我已经修改了full_join示例，它现在运行但是没有按照我想要的方式重新合并每个compid和唯一交易日以填补第一个数据集中缺少的交易日。我非常感谢有关这方面的任何建议。
我上面写的循环可以准确地给出我想要的东西，但我想知道是否有更快的方法来执行此操作，因为我必须循环超过7000左右，以创建大型数据集待办事项。这需要大约40分钟才能运行，所以我想知道是否有更快的方法来编写这个循环或替代它。
非常感谢提前
crsp_td_net$date_crsp_orig <-crsp_td_net$date_crsp
df <- full_join(crsp_td_net, by="date_crsp", expand.grid(compid = unique(crsp_td_net$compid), date_crsp=unique(ff_35f$date_crsp)) )
df<- df%>% filter(between(date_crsp, min(date_crsp_orig, na.rm=TRUE), max(date_crsp_orig, na.rm=TRUE)))
df<- df%>%filter(!compid.x=="NA")%>% select(-compid.y)%>% distinct()%>%arrange(compid.x,date_crsp)
3 个答案:
答案 0 :(得分：4)
虽然OP要求dplyr解决方案，但我只能建议使用foverlaps()包中的data.table函数的解决方案。
OP要求通过crsp_td_net中给出的交易日期完成ff_35f中每家公司的交易日期。完成意味着在给定日期填写从开始日期到结束日期的日期范围。 （注意，OP使用整数值代替日期）。给定日期可以被认为是日期范围，其中每个范围仅包括一天。
现在，问题已被解释为找到两个（日期）范围序列（重叠连接）的重叠。为此，可以使用foverlaps()函数，该函数受findOverlaps() library(data.table)
# coerce to data.table
setDT(crsp_td_net)
setDT(ff_35f)
# find start and end date for each company
comp_date_range <- crsp_td_net[, .(start = min(date_crsp), end = max(date_crsp)),
by = compid]
# turn given dates into date ranges of one day lengths
# by adding an end column equal to the start dates
ff_35f[, end := date_crsp]
# set keys
setkey(comp_date_range, start, end)
setkey(ff_35f, date_crsp, end)
# find all overlapping ranges
temp <- foverlaps(comp_date_range, ff_35f)
# reorder result for convenience and pick desired columns
result <- temp[order(compid, date_crsp), .(compid, date_crsp)]
函数的启发，但也适用于非基因组（即非整数）范围。
result
# compid date_crsp
# 1: 1 2
# 2: 1 3
# 3: 1 4
# 4: 1 5
# 5: 2 3
# 6: 2 4
# 7: 2 5
# 8: 2 6
# 9: 2 7
#10: 2 8
#11: 2 9
#12: 3 3
#13: 3 4
#14: 3 5
#15: 3 6
#16: 3 7
#17: 3 8
结果符合预期的输出：
foverlaps(
setkey(setDT(crsp_td_net)[, .(start = min(date_crsp), end = max(date_crsp)),
by = compid], start, end),
setkey(setDT(ff_35f)[, .(date_crsp, end = date_crsp)], date_crsp, end)
)[order(compid, start), .(compid, date_crsp)]
这可以在一行代码中更简洁地编写：
data.table 注意 OP已在其Q中用整数替换日期。?as.IDate包提供带整数存储的日期和时间类，以便快速排序和分组（见 Var mySignPad = new SignaturePadView()
{
StrokeWidth = 3,
StrokeColor = Color.Black,
BackgroundColor = Color.White,
HeightRequest = 300,
WidthRequest = 300
};
var getSignedImage = mySignPad.GetImageStreamAsync(SignatureImageFormat.Jpg);
）。
答案 1 :(得分：3)
再次考虑这个问题，我相信可以使用data.tables＆＃39;以合理的速度解决它。 非equi join 。 （我发布了一个单独的答案，因为该方法与foverlaps()完全不同。）
library(data.table)
# coerce to data.table
setDT(crsp_td_net)
setDT(ff_35f)
# find start and end date for each company
comp_date_range <- crsp_td_net[, .(start = min(date_crsp), end = max(date_crsp)),
by = compid]
# non equi join: the result contains only rows which fulfill the condition in on = ...
# by = .EACHI executes .SD for each group, returning matching rows for each date
# nomatch = 0 (inner join) skips dates without matching company
temp <- comp_date_range[ff_35f, on = c("start<=date_crsp", "end>=date_crsp"),
.SD, by = .EACHI, nomatch = 0, allow.cartesian = TRUE]
# reorder result for convenience and pick desired columns
result <- temp[order(compid, start), .(compid, date_crsp = start)]
结果符合预期输出
result
# compid date_crsp
# 1: 1 2
# 2: 1 3
# 3: 1 4
# 4: 1 5
# 5: 2 3
# 6: 2 4
# 7: 2 5
# 8: 2 6
# 9: 2 7
#10: 2 8
#11: 2 9
#12: 3 3
#13: 3 4
#14: 3 5
#15: 3 6
#16: 3 7
#17: 3 8
请注意，隐含的假设是ff_35f给出的日期范围涵盖了crsp_td_net中使用的整个日期范围。否则，公司交易会使结果下降。
基准测试结果
在撰写本文时，发布了三种不同的解决方案。 OP用他的7 Gb数据集测量了所有三种解决方案的经过时间，并报告了测量的经过时间：
-
foverlaps()solution 的1.12秒
- non-equi join solution 的1.41秒
-
tidyr/dplyrsolution 的11.92秒
我很惊讶地发现foverlaps()解决方案比非equi连接更快，所以我使用microbenchmark包运行了一些具有不同问题大小的基准测试
问题的大小由公司数量决定。对于每个公司，交易日是从260＆＃34;日期＆＃34;的选择中随机抽样的。模拟一年没有周末（详见下面的代码）。该数据集平均每个公司包含约130行。
从我自己的基准图表中可以看出（注意两个轴都是对数刻度）
foverlaps()比非equi连接快一些，而非equi连接是较小问题规模的最快方法。 tidyr / dplyr几乎总是最慢的方法，而且在大问题上的速度要慢一些。
为问题大小n_comp
的基准运行定义函数
bm_run <- function(n_comp) {
# define 1 year of trading dates, simulating weekends
ff_35f <- sort(outer(1:5, 7*(0:51), `+`))
# create tradings dates for each company
crsp_td_net <- rbindlist(lapply(seq_len(n_comp), function(i) {
# how many trading dates to sample for actual company?
n_days <- sample(length(ff_35f), 1)
# sample trading dates
data.frame(compid = i,
date_crsp = sort(sample(ff_35f, n_days)))
}))
# coerce to data.frame
setDF(crsp_td_net)
# turn vector of trading dates into data.frame
ff_35f <- data.frame(date_crsp = ff_35f)
# scale down number of repetitions with problem size
n_times <- as.integer(scales::squish(1000*1000 / nrow(crsp_td_net), c(3, 1000)))
print(sprintf("%i companies with a total of %i trading dates, %i runs",
n_comp, nrow(crsp_td_net), n_times))
# do the benchmark runs for this problem size
mb <- microbenchmark::microbenchmark(
foverlaps = {
foverlaps(
setkey(setDT(crsp_td_net)[, .(start = min(date_crsp), end = max(date_crsp)),
by = compid], start, end),
setkey(setDT(ff_35f)[, .(date_crsp, end = date_crsp)], date_crsp, end)
)[order(compid, start), .(compid, date_crsp)]
},
non_equi_join = {
setDT(crsp_td_net)[, .(start = min(date_crsp), end = max(date_crsp)), by = compid
][setDT(ff_35f), on = c("start<=date_crsp", "end>=date_crsp"),
.SD, by = .EACHI, nomatch = 0, allow.cartesian = TRUE
][order(compid, start), .(compid, date_crsp = start)]
},
dplyr = {
setDF(crsp_td_net)
setDF(ff_35f)
crsp_td_net %>%
dplyr::group_by(compid) %>%
dplyr::summarize(date_crsp = list(seq(from=min(date_crsp), to=max(date_crsp), by=1))) %>%
tidyr::unnest() %>%
dplyr::semi_join(ff_35f, by="date_crsp") %>%
dplyr::arrange(compid, date_crsp)
},
times = n_times
)
# return problem size and timings as list
return(list(n_comp, nrow(crsp_td_net), mb))
}
针对不同的问题规模运行基准
library(data.table)
library(magrittr)
# number of companies
n_comp <- outer(c(1,2), 10^(1:4), `*`)
# set seed of RNG for creation of reproducible data
set.seed(1234)
# do benchmark runs with different problem size derived from number of companies
bm <- lapply(n_comp, bm_run)
准备绘图数据
# create data.table with benchmark timinings from chunks in returned list
mbl <- rbindlist(lapply(bm, `[[`, i = 3), id = "n_row")
# aggregate results
mba <- mbl[, .(median_time = median(time), N = .N), by = .(n_row, expr)]
# reorder factor levels
mba[, expr := forcats::fct_reorder(expr, -median_time)]
# replace chunk number by number of rows
mba[, n_row := unlist(lapply(bm, `[[`, i = 2))[n_row]]
创建图表
library(ggplot2)
ggplot(mba, aes(n_row, median_time*1e-6, group = expr, colour = expr)) +
geom_point() + geom_smooth(se = FALSE) +
scale_x_log10(breaks = unique(mba$n_row), labels = scales::comma) +
scale_y_log10() +
xlab("number of rows") + ylab("median of execution time [ms]") +
ggtitle("microbenchmark results") + theme_bw()
答案 2 :(得分：0)
根据实际日期调整您的数据。在数据2017-01-04和-06不在日期表中。这种方法从公司的第一个和最后一个日期生成一个序列。在compid 2，可以看到填写缺失日期。 `seq.Date（from =，to =，by = 1）使得缺少日期。
不需要的可能会创建一个大型数据框，因此内存存在一些风险，但如果您将这些表上的操作保持为compid和date_crsp，那么它可能会适合。
semi_join和inner_join都应该有效 - 您想测试速度。
zz <- "compid date_crsp
1 1 2017-01-02
2 1 2017-01-03
3 1 2017-01-05
4 2 2017-01-03
5 2 2017-01-07
6 2 2017-01-09
7 3 2017-01-03
8 3 2017-01-05
9 3 2017-01-07
10 3 2017-01-08"
crsp_td_net <- read.table(text=zz, header = TRUE)
library(lubridate)
crsp_td_net$date_crsp <- ymd(crsp_td_net$date_crsp)
xx <- "date_crsp
1 2017-01-02
2 2017-01-03
3 2017-01-05
4 2017-01-07
5 2017-01-08
6 2017-01-09
7 2017-01-10"
ff_35f <- read.table(text=xx, header = TRUE)
ff_35f$date_crsp <- ymd(ff_35f$date_crsp)
library(dplyr)
library(tidyr)
crsp_td_net_summary <- crsp_td_net %>%
group_by(compid) %>%
summarize(date_crsp = list(seq.Date(from=min(date_crsp), to=max(date_crsp), by=1))) %>%
unnest() %>%
semi_join(ff_35f, by="date_crsp") %>%
arrange(compid, date_crsp)
crsp_td_net_summary
# # A tibble: 12 × 2
# compid date_crsp
# <int> <date>
# 1 1 2017-01-02
# 2 1 2017-01-03
# 3 1 2017-01-05
# 4 2 2017-01-03
# 5 2 2017-01-05
# 6 2 2017-01-07
# 7 2 2017-01-08
# 8 2 2017-01-09
# 9 3 2017-01-03
# 10 3 2017-01-05
# 11 3 2017-01-07
# 12 3 2017-01-08
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？