r - 在不编写C/C++的情况下加速ifelse()？

Question

我需要获取以下功能的结果

  getScore <- function(history, similarities) {    
    nh<-ifelse(similarities<0, 6-history,history)
    x <- nh*abs(similarities) 
    contados <- !is.na(history)
    x2 <- sum(x, na.rm=TRUE)/sum(abs(similarities[contados]),na.rm=TRUE)
    x2
    }

例如，以下向量:

notes <- c(1:5, NA)
history <- sample(notes, 1000000, replace=T)
similarities <- runif(1000000, -1,1)

这在循环内发生了变化。这需要:

ptm <- proc.time()
for (i in (1:10)) getScore(history, similarities)
proc.time() - ptm

   user  system elapsed 
   3.71    1.11    4.67 

最初，我怀疑问题出在 for循环，但是分析结果指向 ifelse()。

Rprof("foo.out")
for (i in (1:10)) getScore(history, similarities)
Rprof(NULL)
summaryRprof("foo.out")

$by.self
           self.time self.pct total.time total.pct
"ifelse"        2.96    65.78       3.48     77.33
"-"             0.24     5.33       0.24      5.33
"getScore"      0.22     4.89       4.50    100.00
"<"             0.22     4.89       0.22      4.89
"*"             0.22     4.89       0.22      4.89
"abs"           0.22     4.89       0.22      4.89
"sum"           0.22     4.89       0.22      4.89
"is.na"         0.12     2.67       0.12      2.67
"!"             0.08     1.78       0.08      1.78

$by.total
           total.time total.pct self.time self.pct
"getScore"       4.50    100.00      0.22     4.89
"ifelse"         3.48     77.33      2.96    65.78
"-"              0.24      5.33      0.24     5.33
"<"              0.22      4.89      0.22     4.89
"*"              0.22      4.89      0.22     4.89
"abs"            0.22      4.89      0.22     4.89
"sum"            0.22      4.89      0.22     4.89
"is.na"          0.12      2.67      0.12     2.67
"!"              0.08      1.78      0.08     1.78

$sample.interval
[1] 0.02

$sampling.time
[1] 4.5

ifelse()是我的性能瓶颈。 除非R中有一种方法可以加快ifelse()的速度，否则不太可能极大地提高性能。

但是， ifelse()已经是矢量化方法。在我看来，剩下的唯一机会就是使用C/C++。但是有办法避免使用已编译的代码吗？

Answer 1

我以前曾经遇到过。我们不必一直使用ifelse()。如果您查看ifelse的编写方式，请在R控制台中键入“ifelse”，您会看到此函数是用R语言编写的，并且执行了各种检查，这实际上是效率低下的。

不用使用ifelse()，我们可以这样做:

getScore <- function(history, similarities) {
  ######## old code #######
  # nh <- ifelse(similarities < 0, 6 - history, history)
  ######## old code #######
  ######## new code #######
  nh <- history
  ind <- similarities < 0
  nh[ind] <- 6 - nh[ind]
  ######## new code #######
  x <- nh * abs(similarities) 
  contados <- !is.na(history)
  sum(x, na.rm=TRUE) / sum(abs(similarities[contados]), na.rm = TRUE)
  }

然后让我们再次检查分析结果:

Rprof("foo.out")
for (i in (1:10)) getScore(history, similarities)
Rprof(NULL)
summaryRprof("foo.out")

# $by.total
#            total.time total.pct self.time self.pct
# "getScore"       2.10    100.00      0.88    41.90
# "abs"            0.32     15.24      0.32    15.24
# "*"              0.26     12.38      0.26    12.38
# "sum"            0.26     12.38      0.26    12.38
# "<"              0.14      6.67      0.14     6.67
# "-"              0.14      6.67      0.14     6.67
# "!"              0.06      2.86      0.06     2.86
# "is.na"          0.04      1.90      0.04     1.90

# $sample.interval
# [1] 0.02

# $sampling.time
# [1] 2.1

我们的性能提高了 2倍以上。此外，该配置文件更像是一个平面配置文件，没有任何单个部分控制执行时间。

在R中，向量索引/读取/写入以C代码的速度进行，因此，只要有可能，就使用向量。

测试@Matthew的答案

mat_getScore <- function(history, similarities) {
  ######## old code #######
  # nh <- ifelse(similarities < 0, 6 - history, history)
  ######## old code #######
  ######## new code #######
  ind <- similarities < 0
  nh <- ind*(6-history) + (!ind)*history
  ######## new code #######
  x <- nh * abs(similarities) 
  contados <- !is.na(history)
  sum(x, na.rm=TRUE) / sum(abs(similarities[contados]), na.rm = TRUE)
  }

Rprof("foo.out")
for (i in (1:10)) mat_getScore(history, similarities)
Rprof(NULL)
summaryRprof("foo.out")

# $by.total
#                total.time total.pct self.time self.pct
# "mat_getScore"       2.60    100.00      0.24     9.23
# "*"                  0.76     29.23      0.76    29.23
# "!"                  0.40     15.38      0.40    15.38
# "-"                  0.34     13.08      0.34    13.08
# "+"                  0.26     10.00      0.26    10.00
# "abs"                0.20      7.69      0.20     7.69
# "sum"                0.18      6.92      0.18     6.92
# "<"                  0.16      6.15      0.16     6.15
# "is.na"              0.06      2.31      0.06     2.31

# $sample.interval
# [1] 0.02

# $sampling.time
# [1] 2.6

啊？慢点？

完整的分析结果表明，此方法在浮点乘法"*"上花费了更多时间，而逻辑上不是"!"的开销似乎很高。虽然我的方法只需要浮点加法/减法。

好吧，结果可能还取决于体系结构。我目前正在Intel Nahalem(Intel Core 2 Duo)上进行测试。因此，欢迎在各种平台上进行两种方法之间的基准测试。

备注

所有配置文件都在使用问题中的OP数据。