ускорить код R - векторизация?

Question

Я изо всех сил пытаюсь сделать мой код быстрее. В настоящее время я где-то использую doParallel, но мне интересно, можно ли сделать это быстрее, используя более умное программирование вместо более быстрого аппаратного обеспечения. Вот стилизованная версия того, что я хочу сделать:

    library(dplyr)
    library(doParallel)
    library(data.table)
    cl <- makeCluster(detectCores(all.tests=FALSE,logical=TRUE))
    registerDoParallel(cl)
    set.seed(12345)
    crit <- 0.5
    dta <- data.frame(treat = sample(1:12,1000, replace=TRUE),
                      dep   = sample(100:200,1000, replace=TRUE),
                      uniqID = rep(1:100,length.out = 1000))
    nr_repl <- 1000

    oper <- foreach (repl = 1:nr_repl, .combine=cbind,.packages = c("data.table")) %dopar% {
        dta_sim <- data.table(dta)
        setDT(dta_sim)[,perm:=sample(treat),by = (uniqID)]
        dta_sim$recipient <- "single"
        dta_sim$recipient[dta_sim$perm == 5  |dta_sim$perm == 6  |dta_sim$perm == 7 |dta_sim$perm == 12  ] <- "couple"
        return(abs(summary(lm(dep~recipient=='couple', data=dta_sim))$coefficients[2,1]) > abs(crit) )
        }

    mean(oper)

После полезных комментариев и предложений вот что я закончил:

library(dplyr)
library(doParallel)
library(data.table)
cl <- makeCluster(detectCores(all.tests=FALSE,logical=TRUE))
registerDoParallel(cl)
set.seed(12345)
crit <- .5
dta <- data.frame(treat = sample(1:12,1000, replace=TRUE),
                      dep   = sample(100:200,1000, replace=TRUE),
                      uniqID = rep(1:100,length.out = 1000))
nr_repl <- 1000    
oper <- foreach (repl = 1:nr_repl, .combine=cbind,.packages = c("data.table")) %dopar% {
        dta_sim <- data.table(dta)
        setDT(dta_sim)[,perm:=sample(treat),by = (uniqID)]
        dta_sim$recipient <- ifelse(dta_sim$perm %in% c(5,6,7,12), "couple", "single")
            return(abs(coef(lm(dep~recipient=='couple', data=dta_sim))[2]) > abs(crit) )
        }

mean(oper)

Answer 1

Одна вещь, которую нужно оптимизировать, это заменить names(table(dta$uniqID)) в вызове sapply на as.character(unique(dta$uniqID)). В зависимости от размера ваших данных, это будет в несколько раз быстрее.

Бенчмарк с вектором длины 1 000 000:

x <- rep(1:100, 10000)

> test <- microbenchmark(names(table(x)), as.character(unique(x)), times = 100, unit = "s")
> test
Unit: seconds
                    expr        min          lq       mean      median          uq       max neval cld
         names(table(x)) 0.22017963 0.222114845 0.27556537 0.226181405 0.328574578 0.4403513   100   b
 as.character(unique(x)) 0.00714553 0.007643307 0.02098216 0.008296107 0.009429619 0.1173899   100  a 

Сравнивая медианные значения, as.character(unique(x)) работает в 28 раз быстрее, чем names(table(x)). Остальная часть вашего кода кажется мне довольно упрощенной.