3

と の 2 つのベクトルがrありsます。これら2つの配列の外側の違いを見つけたいのですが、次のように負になることはありません

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で結果xを高速化するにはどうすればよいですか?

4

2 に答える 2

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 )

outerこれは、andを使用するよりも約 6 倍高速であり、サブセット化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)
})
于 2013-08-28T06:33:11.320 に答える
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
于 2013-08-28T06:33:16.127 に答える