lapply 및 do.call이 매우 느리게 실행 중입니까?

Question

데이터 프레임이 약 35,000 행, 7 열입니다. 그것은 다음과 같습니다

머리 (NUC)

chr feature start  end gene_id pctAT pctGC length 
1 1  CDS 67000042 67000051 NM_032291 0.600000 0.400000  10 
2 1  CDS 67091530 67091593 NM_032291 0.609375 0.390625  64 
3 1  CDS 67098753 67098777 NM_032291 0.600000 0.400000  25 
4 1  CDS 67101627 67101698 NM_032291 0.472222 0.527778  72 
5 1  CDS 67105460 67105516 NM_032291 0.631579 0.368421  57 
6 1  CDS 67108493 67108547 NM_032291 0.436364 0.563636  55 

gene_id 약 3,500 고유의 수준이 요인이다. 각 수준의 gene_id에 대해 min(start), max(end), mean(pctAT), mean(pctGC) 및 sum(length)을 얻으 려합니다.

나는 이것을 위해 lapply와 do.call을 사용해 보았지만, 실행하는데 영원히 +30 분이 걸렸다. 내가 사용하는 코드는 다음과 같습니다

nuc_prof = lapply(levels(nuc$gene_id), function(gene){ 
    t = nuc[nuc$gene_id==gene, ] 
    return(list(gene_id=gene, start=min(t$start), end=max(t$end), pctGC = 
       mean(t$pctGC), pct = mean(t$pctAT), cdslength = sum(t$length))) 
}) 
nuc_prof = do.call(rbind, nuc_prof) 

내가이 둔화 뭔가를 잘못하고 있어요 확신합니다. 나는 그것이 빨리 될 수 있다고 확신하기 때문에 그것이 끝날 때까지 기다리지 않았다. 어떤 아이디어?

Answer 1

는 ... 여기에 빠른 data.table 솔루션의 모습 내용은 다음과 같습니다

다른 사람이 언급 한 것처럼

library(data.table) 
dt <- data.table(nuc, key="gene_id") 

dt[,list(A=min(start), 
     B=max(end), 
     C=mean(pctAT), 
     D=mean(pctGC), 
     E=sum(length)), by=key(dt)] 
#  gene_id  A  B   C   D E 
# 1: NM_032291 67000042 67108547 0.5582567 0.4417433 283 
# 2:  ZZZ 67000042 67108547 0.5582567 0.4417433 283 

Answer 2

do.call은 대형 물체에서 매우 느릴 수 있습니다. 이것은 이것이 호출을 만드는 방법 때문이라고 생각하지만 확실하지 않습니다. 더 빠른 대안은 data.table 패키지입니다. 또는 @Andrie가 의견에서 제안한대로 각 계산에 tapply을 사용하고 결과로 cbind을 사용합니다.

현재 구현에 대한 참고 사항 : 함수에서 부분 집합을 수행하는 대신 split 함수를 사용하여 data.frame을 반복 할 수있는 data.frames의 목록으로 분해 할 수 있습니다. 내가 복음 전도의 기분이야 때문에

g <- function(tnuc) { 
    list(gene_id=tnuc$gene_id[1], start=min(tnuc$start), end=max(tnuc$end), 
     pctGC=mean(tnuc$pctGC), pct=mean(tnuc$pctAT), cdslength=sum(tnuc$length)) 
} 
nuc_prof <- lapply(split(nuc, nuc$gene_id), g) 

Answer 3

-do.call가 큰 개체에 문제가, 그리고 최근에 큰 데이터 세트에서 얼마나 느린지를 정확히 발견했습니다. 문제를 설명하기 위해 여기에 큰 회귀 객체와 간단한 요약 호출 (실효 패키지를 사용하여 콕스 회귀)를 사용하여 benchamark입니다 :

> model <- cph(Surv(Time, Status == "Cardiovascular") ~ 
+    Group + rcs(Age, 3) + cluster(match_group), 
+    data=full_df, 
+    x=TRUE, y=TRUE) 

> system.time(s_reg <- summary(object = model)) 
    user system elapsed 
    0.00 0.02 0.03 
> system.time(s_dc <- do.call(summary, list(object = model))) 
    user system elapsed 
282.27 0.08 282.43 
> nrow(full_df) 
[1] 436305 

data.table 솔루션이 포함되지 않은 위의 훌륭한 방법이지만 do.call의 모든 기능과 따라서 나는 fastDoCall 기능을 공유 할 것이라고 생각했습니다. 즉, R 메일 링리스트의 Hadley Wickhams suggested hack을 수정 한 것입니다. 그것은 Gmisc-package 1.0 버전에서 사용할 수 있습니다 (아직 CRAN에서는 출시되지 않았지만 here을 찾을 수 있습니다). 벤치 마크는 다음과 같습니다

> system.time(s_fc <- fastDoCall(summary, list(object = model))) 
    user system elapsed 
    0.03 0.00 0.06 

기능에 대한 전체 코드는 다음과 같습니다 :

fastDoCall <- function(what, args, quote = FALSE, envir = parent.frame()){ 
    if (quote) 
    args <- lapply(args, enquote) 

    if (is.null(names(args))){ 
    argn <- args 
    args <- list() 
    }else{ 
    # Add all the named arguments 
    argn <- lapply(names(args)[names(args) != ""], as.name) 
    names(argn) <- names(args)[names(args) != ""] 
    # Add the unnamed arguments 
    argn <- c(argn, args[names(args) == ""]) 
    args <- args[names(args) != ""] 
    } 

    if (class(what) == "character"){ 
    if(is.character(what)){ 
     fn <- strsplit(what, "[:]{2,3}")[[1]] 
     what <- if(length(fn)==1) { 
     get(fn[[1]], envir=envir, mode="function") 
     } else { 
     get(fn[[2]], envir=asNamespace(fn[[1]]), mode="function") 
     } 
    } 
    call <- as.call(c(list(what), argn)) 
    }else if (class(what) == "function"){ 
    f_name <- deparse(substitute(what)) 
    call <- as.call(c(list(as.name(f_name)), argn)) 
    args[[f_name]] <- what 
    }else if (class(what) == "name"){ 
    call <- as.call(c(list(what, argn))) 
    } 

    eval(call, 
     envir = args, 
     enclos = envir) 
}