중첩 된 foreach 문 및 dopar - 데이터 프레임의 각 행을 부트 스트랩

Question

나는이에 유사 데이터 프레임이 있습니다

maindata <- data.frame(cbind(num=c(79,61,62,57), 
         denom=c(162356,170189,164634,162006), 
         group=c(1,2,3,4))) 

내 의도는, 각 행을 선택 부트 스트랩 리샘플링을 수행, 95 % 신뢰 구간에 대한 분위수를 발견하는 것입니다 원래의 데이터 프레임과 동일한 수의 행과 2 개의 열을 갖는 데이터 프레임에 CI를 출력한다. 중첩 된 foreach는 그리고 %로이 기능은 꽤 잘 % 일을 할 수 있지만, 더 많은 행에 더 반복 (예 : 1000) 및 데이터 프레임과 느린 : 나는 %로 할 수있는 방법을 알아 내기 위해 노력 해왔다

boots = function(data, boots, seed=1234){ 
    if (!missing(seed)) 
    set.seed(seed) 
    pct <- NULL 
    ci.pct <- list() 
    foreach(j=1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j,]$num), 
        rep(0, data[j,]$denom)) 
     foreach(i=1:boots, .combine='c') %do% { 
      index  <- sample(1:length(datast1), size=length(datast1), replace=TRUE) 
      sampledata <- datast1[index] 
      pct[i]  <- mean(sampledata) 
     } 
     ci.pct[[j]] <- cbind(quantile(pct, prob=c(0.025))*100000, 
           quantile(pct, prob=c(0.975))*100000) 
     } 
     ci.pcts <- do.call("rbind", ci.pct) 
     return(ci.pcts) 
    } 
    boots(data=maindata, boots=5, seed=1234) 

병렬 처리 %를 dopar하지만 꽤 그것을 이해 할 수 없습니다

bootsd = function(data, boots, seed=1234){ 
    if (!missing(seed)) 
    set.seed(seed) 
    pct <- NULL 
    ci.pct <- list() 
    foreach(j=1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j,]$num), 
        rep(0, data[j,]$denom)) 
     foreach(i=1:boots, .combine='c') %dopar% { 
      index  <- sample(1:length(datast1), size=length(datast1), replace=TRUE) 
      sampledata <- datast1[index] 
      pct[i]  <- mean(sampledata) 
     } 
     ci.pct[[j]] <- cbind(quantile(pct, prob=c(0.025))*100000, 
           quantile(pct, prob=c(0.975))*100000) 
     } 
     ci.pcts <- do.call("rbind", ci.pct) 
     return(ci.pcts) 
    } 
bootsd(data=maindata, boots=5, seed=1234) 

사람은 올바르게 %의 dopar %의 또는 다른 깔끔한 트릭을 구현하여 빠른 실행 얻을 수있는 코드를 수정하는 방법에 대한 조언이 있습니까?

Answer 1

귀하의 기능을 약간 재 작성했습니다. 함수로 foreach 볼 및 루프에서 결과를 반환합니다. 이제 %dopar%과 호환됩니다. 유일한 문제는 씨앗에 순종하지 않는다는 것입니다. 각 실행마다 다른 결과가 반환됩니다. 아마도 이것이 필요하다면 doRNG 패키지를 살펴 봐야 할 것입니다.

bootsd = function(data, boots, seed = 1234){ 
    if (!missing(seed)) set.seed(seed) 
    ci.pct <- foreach(j = 1:nrow(data)) %do% { 
    datast1 <- c(rep(1, data[j, "num"]), 
       rep(0, data[j, "denom"])) 
    pct <- foreach(i = 1:boots, .combine = 'c') %dopar% { 
     index <- sample(1:length(datast1), size = length(datast1), replace = T) 
     sampledata <- datast1[index] 
     mean(sampledata) 
    } 
    cbind(quantile(pct, prob=c(0.025))*100000, 
      quantile(pct, prob=c(0.975))*100000) 
    } 
    ci.pcts <- do.call("rbind", ci.pct) 
    return(ci.pcts) 
} 

bootsd(data = maindata, boots = 5, seed = 1234)