Самый быстрый способ сохранить только первый случай истины; установить отдых на ложь

Question

Мой вопрос в основном о том, что говорит название. Для некоторого вектора x, состоящего из TRUE и FALSE, оставьте только первое вхождение TRUE и установите для остальных значение FALSE.

Небольшой пример:

smallExample <- c(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE)
# Expected result:
# FALSE FALSE  TRUE FALSE FALSE FALSE

До сих пор я придумал 3 возможных решения.

matchFun <- function(x) {
    1:length(x) == match(TRUE, x)
}

whichFun <- function(x) {
    1:length(x) == which(x)[1]
}

vec_repl <- function(x) {
    {tmp <- rep(FALSE, length(x)); tmp[match(TRUE,x)] <- TRUE; tmp}
}

Проверка их на небольшом примере:

microbenchmark(
    `matchFun` = matchFun(smallExample),
    `whichFun` = whichFun(smallExample),
    `vec_repl` = vec_repl(smallExample),
    times = 500L
)

# Unit: nanoseconds
#      expr  min   lq   mean median   uq   max neval cld
#  matchFun  500  600  723.8    700  800  2100   500 a  
#  whichFun 1500 1700 1832.4   1800 1900 13500   500   c
#  vec_repl  700  800  919.2    900 1000  8400   500  b 

Однако данные, с которыми я работаю, гораздо больше, поэтому мне интересно посмотреть, как они масштабируются до более крупных векторов. Вышеприведенный тест, вероятно, не является репрезентативным, поскольку при таких небольших количествах накладные расходы играют существенную роль. С этой целью я провел сравнение, зацикливаясь на нескольких векторных диапазонах (n) и используя различные rat ios из TRUE и FALSE (odds).

library(dplyr)
library(purrr)
library(microbenchmark)
library(plotly)

# The length of the vector to process
ns <- c(100, 1000, 10000, 20000, 40000, 60000, 80000, 100000)

# The ratio of TRUE/FALSE
odds <- c(0, 0.01, 0.1, 0.3, 0.5, 0.7, 0.9, 1)
res <- vector(mode = "list", length = length(cross(list(ns, odds))))

# Add counter so we know where to store the result
t <- 1

# Loop over n's and odds, and save microbenchmarks in res
for(n in ns) {
    for(odd in odds) {
        bigExample <- runif(n = n) < odd
        mb <- microbenchmark(
            `matchFun` = matchFun(bigExample),
            `whichFun` = whichFun(bigExample),
            `vec_repl` = vec_repl(bigExample),
            times = 500L
        )
        mb <- summary(mb)
        mb$n <- n
        mb$ratio <- odd
        res[[t]] <- mb
        t <- t + 1
    }
}

# Combine all results
res <- bind_rows(res)

# Make a nice interactive 3D plot
plot_ly(data = res, x = ~ratio, y = ~n, z = ~median, color = ~expr, type = "scatter3d", mode = "markers")

Эта взаимосвязь также показана коэффициентами линейной модели, использующей длину вектора n в качестве предикторов median время обработки (хотя и небольшое):

res %>% 
    group_by(expr) %>% 
    nest() %>% 
    mutate(model = map(data, ~lm(median ~ n, data = .x))) %>% 
    ungroup() %>% 
    transmute(expr, beta = map_dbl(model, ~coefficients(.x)[[2]]))

# A tibble: 3 x 2
#   expr        beta
#   <fct>      <dbl>
# 1 matchFun 0.00193
# 2 whichFun 0.00332
# 3 vec_repl 0.00122

Теперь мой вопрос: можете ли вы придумать какой-либо другой метод, который быстрее, чем тот, который я придумал до сих пор?

Answer 1

Эта настройка вашего vec_repl() дает небольшое ускорение для более крупных примеров:

vec_repl2 <- function(x) {
  {tmp <- logical(length(x)); tmp[match(TRUE,x)] <- TRUE; tmp}
}

Например:

bigExample <- c(logical(10000),TRUE,logical(10000))
microbenchmark(vec_repl(bigExample),vec_repl2(bigExample))
Unit: microseconds
                  expr    min     lq     mean median       uq      max neval
  vec_repl(bigExample) 34.204 47.428 157.2569 95.383 102.7885 6130.591   100
 vec_repl2(bigExample) 18.336 28.386 116.0537 78.282  85.6865 5439.463   100

Помимо этого, вы можете, возможно, заглянуть в R cpp.

При редактировании Вот эксперимент R cpp:

library(Rcpp)
cppFunction('LogicalVector vec_repl3(LogicalVector x){
    int n = x.size();
    LogicalVector v(n);
    for(int i = 0; i < n; i++){
        if(x[i]){
            v[i] = TRUE;
            return v;
        }
    }
    return v; //if you get here -- x had no TRUE to begin with
}')

Сравнение:

microbenchmark(vec_repl(bigExample),vec_repl2(bigExample),vec_repl3(bigExample))
Unit: microseconds
                  expr    min      lq      mean median       uq     max neval
  vec_repl(bigExample) 69.113 70.8765 323.53679 76.166 167.3170 5882.35   100
 vec_repl2(bigExample) 33.499 36.6725 136.80877 38.084 135.4055 6405.28   100
 vec_repl3(bigExample) 31.031 33.3230  69.85751 35.263  80.3975 1836.78   100

Как видите, R cpp обеспечивает повышение скорости (в данном случае), но, учитывая, что полученный код будет труднее распространять, это может не стоить этого. Чтобы действительно получить хорошее представление об этом, сравнительный анализ, вероятно, должен включать более широкий диапазон размеров векторов, а также распределение TRUE в этих векторах.