作者memphis (让你喜欢这世界~)
看板R_Language
标题Re: [问题] merge 3 tables with summing common var
时间Tue Oct 13 15:40:37 2015
速度看起来还好? 还是我搞错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://webptt.com/cn.aspx?n=bbs/R_Language/M.1444722039.A.6EB.html
1F：→ celestialgod: m大的SP会被抓进去总和喔XDD 10/13 16:37
2F：→ celestialgod: 不过m大的方法也满快的 10/13 16:37
3F：→ celestialgod: 回圈内的名字要排除掉SP就好 10/13 16:37
4F：→ memphis: 可是我的回圈里没有SP阿? join的by 不是一直都只有一个? 10/13 16:45
5F：→ memphis: 如果没有做错的话, 剩下的问题应该是警告讯息, 跟na.rm 10/13 16:45
6F：→ celestialgod: 你出来的结果没有SP这个column 10/13 16:50
7F：→ celestialgod: 你可以print你总和的column看看 10/13 16:50
8F：推 celestialgod: 这个是随机产生colomn，所以你可能生成出没有S的x, 10/13 17:29
9F：推 celestialgod: y, z 10/13 17:29
10F：→ celestialgod: 你才会看到SP被总和掉 10/13 17:30
11F：→ memphis: (羞) 那关於重复名称的选取, 不要做得太偷懒有bug就好了 10/13 17:39
12F：→ celestialgod: grep(paste0(mut_list[i], "\\..+"), names(xyz)) 10/13 17:43
13F：→ celestialgod: 改这样应该就没问题了 10/13 17:43
14F：→ celestialgod: 认真试了一下 NA + NA = 0的问题还是存在QQ 10/13 17:51
15F：→ celestialgod: 有时候 NA + 值 会变回NA (把rowSums加上na.rm=T後 10/13 17:51
16F：→ celestialgod: 感觉这个code很有趣，但是要改到可以用还有一段路 10/13 17:52
17F：→ celestialgod: (眼神死 10/13 17:52
18F：推 cywhale: 多谢m大提供简易快速的解法，说也好笑，我当初找dplyr中 10/13 19:13
19F：→ cywhale: outer_join一直找不到，原来是full_join.. >< 10/13 19:14
20F：→ cywhale: NA+NA这问题，的确，後来自己就在rcpp中的小程式解决... 10/13 19:15
21F：→ celestialgod: 可是cy大 full_join的data.table method也是用merge 10/13 19:16
22F：→ celestialgod: .data.table 10/13 19:16
23F：→ cywhale: 也是，但我没想到用grep+rowSum去处理重复变数.x,.y... 10/13 19:40
24F：→ cywhale: 後来才会衍生出自己版本那样的写法... 10/13 19:41
25F：推 celestialgod: 我有想过抓. x,. y来做可是要写回圈就不爽写了，哈 10/13 19:42
26F：推 celestialgod: 哈哈哈 10/13 19:42