我需要获得以下函数的结果
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 ++。但有没有办法避免使用编译代码？
答案 0 :(得分：7)
您可以使用逻辑乘法来实现此任务：
s <- similarities < 0
nh <- s*(6-history) + (!s)*history
i7-3740QM的基准：
f1 <- function(history, similarities) { s <- similarities < 0
s*(6-history) + (!s)*history}
f2 <- function(history, similarities) ifelse(similarities<0, 6-history,history)
f3 <- function(history, similarities) { nh <- history
ind <- similarities<0
nh[ind] <- 6 - nh[ind]
nh }
microbenchmark(f1(history, similarities),
f2(history, similarities),
f3(history, similarities))
## Unit: milliseconds
## expr min lq mean median uq max neval cld
## f1(history, similarities) 22.830260 24.6167695 28.31384860 24.89869950000000 25.651655 81.043713 100 a
## f2(history, similarities) 364.514460 412.7117810 408.37156626 415.10114899999996 417.345748 437.977256 100 c
## f3(history, similarities) 84.220279 86.2894795 92.64614571 87.18016549999999 89.616522 149.243051 100 b
在E5-2680 v2：
## Unit: milliseconds
## expr min lq mean median uq max neval cld
## f1(history, similarities) 20.03963 20.10954 21.41055 20.68597 21.25920 50.95278 100 a
## f2(history, similarities) 314.54913 315.96621 324.91486 319.50290 325.93168 378.26016 100 c
## f3(history, similarities) 73.81413 73.92162 76.10418 74.79893 75.84634 105.98770 100 b
在T5600（Core2 Duo Mobile）上：
## Unit: milliseconds
expr min lq mean median uq max neval cld
## f1(history, similarities) 147.2953 152.9307 171.0870 155.5632 167.0998 344.7524 100 b
## f2(history, similarities) 408.5728 493.3886 517.0573 501.6993 525.8573 797.9624 100 c
## f3(history, similarities) 102.9621 110.6003 131.1826 112.9961 125.3906 303.1170 100 a
啊哈！我的方法在Core 2架构上的速度较慢。
答案 1 :(得分：5)
我之前遇到过这个。我们不必一直使用ifelse()。如果你看一下ifelse是如何写的，可以输入＆＃34; ifelse＆＃34;在你的R控制台中，你可以看到这个函数是用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的数据。
答案 2 :(得分：0)
这是一个更快ifelse，但它不比上面的答案快，它维持ifelse结构。
ifelse_sign <- function(b,x,y){
x[!b] <- 0
y[b] <-0
x + y + b *0
}