作者celestialgod (天)
看板R_Language
标题Re: [问题] merge 3 tables with summing common var
时间Mon Oct 12 17:36:21 2015
※ 引述《cywhale (cywhale)》之铭言：
: [问题类型]:
:
: 效能谘询(我想让R 跑更快)
:
: 好像在哪曾看过较简易的写法或function，但一时想不起，也没找到，写了比较复杂的
: code，想请问是否有更快或更简易的方式做到
: [软体熟悉度]:
: 请把以下不需要的部份删除
: 入门(写过其他程式，只是对语法不熟悉)
: [问题叙述]:
: 请简略描述你所要做的事情，或是这个程式的目的
: Merge some data tables by the same key, 但若有相同的variables则合并时要相加，
: 不管NA，data tables彼此间的行、列数均不同
: [程式范例]:
:
:
: library(data.table)
: library(dplyr)
: # testing data, assuming merge by key = "SP"
: set.seed(NULL)
: x <- matrix(sample(1e6), 1e5) %>% data.table() %>%
: setnames(1:10,sample(LETTERS,10)) %>% .[,SP:=seq_len(nrow(.))]
: y <- matrix(sample(1e5), 1e4) %>% data.table() %>%
: setnames(1:10,sample(LETTERS,10)) %>% .[,SP:=seq_len(nrow(.))]
: z <- matrix(sample(4e5), 2e4) %>% data.table() %>%
: setnames(1:20,sample(LETTERS,20)) %>% .[,SP:=seq_len(nrow(.))]
: # function.. try to write Rcpp function..
: require(Rcpp)
: cppFunction('NumericVector addv(NumericVector x, NumericVector y) {
: NumericVector out(x.size());
: NumericVector::iterator x_it,y_it,out_it;
: for (x_it = x.begin(), y_it=y.begin(), out_it = out.begin();
: x_it != x.end(); ++x_it, ++y_it, ++out_it) {
: if (ISNA(*x_it)) {
: *out_it = *y_it;
: } else if (ISNA(*y_it)) {
: *out_it = *x_it;
: } else {
: *out_it = *x_it + *y_it;
: }
: }
: return out;}')
: ### merge two data.table with different columns/rows,
: ### and summing identical column names
: outer_join2 <- function (df1,df2,byNames) {
: tt=intersect(colnames(df1)[-match(byNames,colnames(df1))],
: colnames(df2)[-match(byNames,colnames(df2))])
: df <- merge(df2,df1[,-tt,with=F],by=byNames,all=T)
: dt <- merge(df2[,-tt,with=F],df1[,c(byNames,tt),with=F],by=byNames,all=T) %>%
: .[,tt,with=F]
: for (j in colnames(dt)) {set(df,j=j,value=addv(df[[j]],dt[[j]]))}
: return (df)
: }
: # get results, 参考c大 #1LaHm_aH (R_Language)
: system.time(Reduce(function(x, y) outer_join2(x, y, byNames="SP"), list(x,y,z)))
: 用了较多行code来完成这件事，速度上似乎还可以，但不确定是否有更好的写法？谢谢！
: [关键字]:
:
: 选择性，也许未来有用
:
简短但是慢很多，提供参考XD
你的方法在我i5第一代电脑上测试，大概是0.36秒，下面最快方法大概是2.9秒
我测了一下，主要是在group_by做和的时候比较慢
library(plyr)
library(dplyr)
library(tidyr)
library(data.table)
# rbind.fill是参考参考网址的
t = proc.time()
wide_table = rbind.fill(list(x, y, z)) %>% tbl_dt(FALSE)
# 这行是错的，会出现NA+NA+NA = 0的情况
# sum_without_na = function(x) sum(x, na.rm = TRUE)
sum_without_na = function(x) ifelse(all(is.na(x)), NA_integer_,
sum(x, na.rm = TRUE))
out = wide_table %>% group_by(SP) %>% summarise_each(funs(sum_without_na))
proc.time() - t # 2.9 seconds
# 参考下面网址的
t = proc.time()
wide_table = rbind.fill(list(x, y, z)) %>% tbl_dt(FALSE)
out2 = ddply(wide_table, .(SP), function(x) colSums(x, na.rm = TRUE))
proc.time() - t # 50 seconds
# 利用tidyr做的，感觉很费工~"~
t = proc.time()
out3 = list(x, y, z) %>% llply(function(x){
gather(x, variable, values, -SP) %>%
mutate(variable = as.character(variable))
}) %>% bind_rows %>% group_by(SP, variable) %>%
summarise(values = sum(values)) %>%
spread(variable, values)
proc.time() - t # 3.9 seconds
参考网址：
http://tinyurl.com/o7gbeej
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 140.109.73.190
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1444642584.A.E62.html
1F：推 cywhale: 太强大了，好多function可以这样用简直活字典~测了一下 10/12 21:24
2F：→ cywhale: all.equal() 我的和out3相同，out,out2则有NA不同还没找 10/12 21:26
3F：→ celestialgod: 感觉会是顺序问题 10/12 21:27
4F：→ cywhale: 总之谢谢，我再仔细看一下..另Rcpp对速度真的加持不少 10/12 21:28
5F：→ celestialgod: 我觉得我的方法如果两两做不会太慢 10/12 21:29
我後来测试一下没有比较快(摊手
6F：→ celestialgod: 不过rcpp真的不好写QQ 10/12 21:30
8F：→ celestialgod: 之前看过，可是我的C++还停留在用armadillo，哈哈 10/12 23:14
9F：→ cywhale: 接下来有时间就来看armadillo 之前看你用很威~ 10/12 23:19
10F：→ celestialgod: 就不用自己拉BLAS来算QQ ARMADILLO有现成的MATRIX 10/12 23:26
11F：推 Wush978: Rcpp的版本是不是有漏column呢？ 10/13 00:44
12F：→ Wush978: 我自己玩了一下，改dplyr版本的，如果用上data.table的 10/13 00:45
13F：→ Wush978: key 功能，效能可以再好约5% 10/13 00:45
14F：推 cywhale: Wu大谢谢~应该没有漏，我用all.equal()和其他版本比过 10/13 09:11
15F：→ cywhale: 不过我後来加上 if(length(tt)>0) {..}else{merge()} 10/13 09:12
16F：→ cywhale: 预防random产生的dataset之间栏位名没有交集错误... 10/13 09:13
※ 编辑: celestialgod (140.109.73.190), 10/13/2015 12:31:51