Re: [問題] merge 3 tables with summing common var

看板R_Language作者 (讓你喜歡這世界~)時間10年前 (2015/10/13 15:40), 編輯推噓5(5021)
留言26則, 3人參與, 最新討論串4/5 (看更多)
速度看起來還好? 還是我搞錯cywhale想要做的是什麼? 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(.))] ###### mycode t = proc.time() xyz <- x %>% full_join(y, by='SP') %>% full_join(z, by='SP') %>% as.data.table() mut_list <- unique(substr(names(xyz)[grep('.', names(xyz), fix=T)],1,1)) for(i in 1:length(mut_list)){ mycols <- grep(mut_list[i], names(xyz), fix=T) xyz[,mySum := rowSums(.SD), .SDcols=mycols] xyz[,(mycols):= NULL] names(xyz)[names(xyz)=="mySum"] <- mut_list[i] cat(paste0(mut_list[i]),"\n") } proc.time() - t ※ 引述《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來完成這件事,速度上似乎還可以,但不確定是否有更好的寫法?謝謝! : [關鍵字]: : : 選擇性,也許未來有用 : -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 140.109.73.102 ※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1444722039.A.6EB.html

10/13 16:37, , 1F
m大的SP會被抓進去總和喔XDD
10/13 16:37, 1F

10/13 16:37, , 2F
不過m大的方法也滿快的
10/13 16:37, 2F

10/13 16:37, , 3F
回圈內的名字要排除掉SP就好
10/13 16:37, 3F

10/13 16:45, , 4F
可是我的迴圈裡沒有SP阿? join的by 不是一直都只有一個?
10/13 16:45, 4F

10/13 16:45, , 5F
如果沒有做錯的話, 剩下的問題應該是警告訊息, 跟na.rm
10/13 16:45, 5F

10/13 16:50, , 6F
你出來的結果沒有SP這個column
10/13 16:50, 6F

10/13 16:50, , 7F
你可以print你總和的column看看
10/13 16:50, 7F

10/13 17:29, , 8F
這個是隨機產生colomn,所以你可能生成出沒有S的x,
10/13 17:29, 8F

10/13 17:29, , 9F
y, z
10/13 17:29, 9F

10/13 17:30, , 10F
你才會看到SP被總和掉
10/13 17:30, 10F

10/13 17:39, , 11F
(羞) 那關於重複名稱的選取, 不要做得太偷懶有bug就好了
10/13 17:39, 11F

10/13 17:43, , 12F
grep(paste0(mut_list[i], "\\..+"), names(xyz))
10/13 17:43, 12F

10/13 17:43, , 13F
改這樣應該就沒問題了
10/13 17:43, 13F

10/13 17:51, , 14F
認真試了一下 NA + NA = 0的問題還是存在QQ
10/13 17:51, 14F

10/13 17:51, , 15F
有時候 NA + 值 會變回NA (把rowSums加上na.rm=T後
10/13 17:51, 15F

10/13 17:52, , 16F
感覺這個code很有趣,但是要改到可以用還有一段路
10/13 17:52, 16F

10/13 17:52, , 17F
(眼神死
10/13 17:52, 17F

10/13 19:13, , 18F
多謝m大提供簡易快速的解法,說也好笑,我當初找dplyr中
10/13 19:13, 18F

10/13 19:14, , 19F
outer_join一直找不到,原來是full_join.. ><
10/13 19:14, 19F

10/13 19:15, , 20F
NA+NA這問題,的確,後來自己就在rcpp中的小程式解決...
10/13 19:15, 20F

10/13 19:16, , 21F
可是cy大 full_join的data.table method也是用merge
10/13 19:16, 21F

10/13 19:16, , 22F
.data.table
10/13 19:16, 22F

10/13 19:40, , 23F
也是,但我沒想到用grep+rowSum去處理重複變數.x,.y...
10/13 19:40, 23F

10/13 19:41, , 24F
後來才會衍生出自己版本那樣的寫法...
10/13 19:41, 24F

10/13 19:42, , 25F
我有想過抓. x,. y來做可是要寫迴圈就不爽寫了,哈
10/13 19:42, 25F

10/13 19:42, , 26F
哈哈哈
10/13 19:42, 26F
文章代碼(AID): #1M7BLtRh (R_Language)
文章代碼(AID): #1M7BLtRh (R_Language)