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

看板R_Language作者celestialgod (天)時間10年前 (2015/10/12 17:36)推噓4(4推 0噓 12→)

留言16則, 3人參與討論串2/5 (看更多)

※ 引述《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