作者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://www.ptt.cc/bbs/R_Language/M.1444642584.A.E62.html
推 cywhale: 太強大了，好多function可以這樣用簡直活字典~測了一下 10/12 21:24
→ cywhale: all.equal() 我的和out3相同，out,out2則有NA不同還沒找 10/12 21:26
→ celestialgod: 感覺會是順序問題 10/12 21:27
→ cywhale: 總之謝謝，我再仔細看一下..另Rcpp對速度真的加持不少 10/12 21:28
→ celestialgod: 我覺得我的方法如果兩兩做不會太慢 10/12 21:29
我後來測試一下沒有比較快(攤手
→ celestialgod: 不過rcpp真的不好寫QQ 10/12 21:30
→ celestialgod: 之前看過，可是我的C++還停留在用armadillo，哈哈 10/12 23:14
→ cywhale: 接下來有時間就來看armadillo 之前看你用很威~ 10/12 23:19
→ celestialgod: 就不用自己拉BLAS來算QQ ARMADILLO有現成的MATRIX 10/12 23:26
推 Wush978: Rcpp的版本是不是有漏column呢？ 10/13 00:44
→ Wush978: 我自己玩了一下，改dplyr版本的，如果用上data.table的 10/13 00:45
→ Wush978: key 功能，效能可以再好約5% 10/13 00:45
推 cywhale: Wu大謝謝~應該沒有漏，我用all.equal()和其他版本比過 10/13 09:11
→ cywhale: 不過我後來加上 if(length(tt)>0) {..}else{merge()} 10/13 09:12
→ cywhale: 預防random產生的dataset之間欄位名沒有交集錯誤... 10/13 09:13
※ 編輯: celestialgod (140.109.73.190), 10/13/2015 12:31:51