Самый быстрый способ создать эту матрицу в R

Question

У меня есть два вектора r и s. Я хочу, чтобы найти внешнюю разность этих двух массивов, а не отрицательным, как следующий

r = rnorm(100000) 
s = c(0.02, 0.04, 0.3, 0.43, 0.5, 0.7, 0.8, 0.9) 
res = t(pmax(outer(r, s, "-"), 0)) 
system.time({ 
res = t(pmax(outer(r, s, "-"), 0)) 
}) 
## system elapsed 
## 0.05 0.00 0.05 

или

system.time({ 
    x = pmax(r - rep(s, each = length(r)), 0) 
    res = matrix(x, nrow = length(s), byrow = TRUE) 
}) 

## system elapsed 
## 0.05 0.00 0.05 

Как я могу получить быстрее результата х в R?

Answer 1

После комментария @ thelatemail в:

fun1 <- function(r,s) t(pmax(outer(r, s, "-"), 0)) 


fun2 <- function(r,s) { 
    x = pmax(r - rep(s, each = length(r)), 0) 
    matrix(x, nrow = length(s), byrow = TRUE) 
} 

fun3 <- function(r,s) { 
    dr <- length(r) 
    ds <- length(s) 
    R <- rep(s, rep.int(length(r), length(s))) 
    S <- rep(r, times = ceiling(length(s)/length(r))) 
    res <- pmax(S - R, 0) 
    dim(res) <- c(dr, ds) 
    t(res) 
} 

library(microbenchmark) 

microbenchmark(res1 <- fun1(r,s), 
       res2 <- fun2(r,s), 
       res3 <- fun3(r,s), 
       times=20) 

# Unit: milliseconds 
#    expr  min  lq median  uq  max neval 
# res1 <- fun1(r, s) 43.28387 46.68182 66.03417 78.78109 83.75569 20 
# res2 <- fun2(r, s) 50.52941 54.36576 56.77067 60.87218 91.14043 20 
# res3 <- fun3(r, s) 34.18374 35.37835 37.97405 40.10642 70.78626 20 

identical(res1, res3) 
#[1] TRUE 

Answer 2

я получаю немного более высокую производительность, запустив outer функцию отдельно и подмножества нулевой < 0 статей, как это ...

res1 <- t(outer(r , s , "-")) 
res1[ res1 < 0 ] <- 0 

Но если вы хотите еще больше скорости, то попробуйте использовать Rcpp. Это достаточно легко, просто запустите следующий фрагмент кода ....

if(! require(Rcpp)) install.packages("Rcpp") 
Rcpp::cppFunction(' 
    NumericMatrix gtzero(NumericVector r , NumericVector s){ 
     int cols = r.size(); 
     int rows = s.size(); 
     NumericMatrix out(rows, cols); 
     for(int i = 0; i < cols; i++){ 
      NumericMatrix::Column ncol = out(_, i); 
      ncol = ifelse(r[i] - s > 0 , r[i] - s , 0); 
     } 
     return out; 
    } 
    ') 

Затем используйте функцию следующим образом:

gtzero(r , s) 

Это оказывается примерно в 6 раз быстрее, чем при использовании outer и pmax и в 3 раза быстрее, чем outer затем [ Подменю:

require(microbenchmark) 
bm <- microbenchmark(eval(rose.baseR) , eval(simon.baseR) , eval(simon.Rcpp)) 

print(bm , "relative" , order = "median" , digits = 2) 
#Unit: relative 
#    expr min lq median uq max neval 
# eval(simon.Rcpp) 1 1.0 1.0 1.0 1.0 100 
# eval(simon.baseR) 3 3.1 3.2 3.2 1.5 100 
# eval(rose.baseR) 3 3.4 6.0 5.9 1.8 100 

и дает тот же результат:

identical(res0 , res2) 
#[1] TRUE 

Следующие выражения были оценены:

set.seed(123) 
r = rnorm(100000) 
s = c(0.02, 0.04, 0.3, 0.43, 0.5, 0.7, 0.8, 0.9) 

rose.baseR <- quote({ 
    res0 <- t(pmax(outer(r, s, "-"), 0)) 
}) 

simon.baseR <- quote({ 
    res1 <- outer(r , s , "-") 
    res1[ res1 < 0 ] <- 0 
}) 

simon.Rcpp <- quote({ 
    res2 <- gtzero(r,s) 
})