Tăng tốc ifelse() mà không cần viết C/C++?

Question

tôi cần để có được những kết quả của hàm sau

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 
    } 

Ví dụ cho các vectơ sau:

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

Đó thay đổi bên trong một vòng lặp. Này có:

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

    user system elapsed 
    3.71 1.11 4.67 

Ban đầu tôi nghi ngờ rằng vấn đề là for vòng lặp, nhưng profiling điểm kết quả để 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() là nút cổ chai hiệu suất của tôi. Trừ khi có một cách trong R để tăng tốc độ ifelse(), không có khả năng tăng hiệu suất tuyệt vời.

Tuy nhiên, ifelse() đã là phương pháp được vector hóa. Dường như với tôi rằng cơ hội duy nhất còn lại là sử dụng C/C++. Nhưng có cách nào để tránh sử dụng mã được biên dịch không?

Answer 1

Tôi đã gặp phải điều này trước đây. Chúng tôi không phải sử dụng ifelse() mọi lúc. Nếu bạn có một cái nhìn như thế nào ifelse được viết, bằng cách gõ "ifelse" trong R console của bạn, bạn có thể thấy rằng chức năng này được viết bằng ngôn ngữ R, và nó kiểm tra khác nhau mà thực sự là không hiệu quả.

Thay vì sử dụng ifelse(), chúng ta có thể làm điều này:

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) 
    } 

Và sau đó chúng ta hãy kiểm tra kết quả hồ sơ một lần nữa:

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 

Chúng tôi có một 2+ lần tăng trong hoạt động. Hơn nữa, hồ sơ giống như một hồ sơ phẳng, mà không có bất kỳ phần nào thống trị thời gian thực hiện.

Trong R, lập chỉ mục vector/đọc/ghi ở tốc độ mã C, vì vậy bất cứ khi nào có thể, hãy sử dụng vectơ.

---

Testing @ Matthew câu trả lời

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 

Ah? Chậm hơn?

Kết quả lược tả đầy đủ cho thấy phương pháp này dành nhiều thời gian hơn cho phép nhân dấu phẩy động "*" và lôgic không "!" có vẻ khá tốn kém. Trong khi cách tiếp cận của tôi chỉ yêu cầu phép cộng/trừ dấu chấm động.

Vâng, Kết quả cũng có thể phụ thuộc vào kiến ​​trúc. Tôi đang thử nghiệm Intel Nahalem (Intel Core 2 Duo) vào lúc này. Vì vậy, điểm chuẩn giữa hai phương pháp tiếp cận trên các nền tảng khác nhau được hoan nghênh.

---

Ghi chú

Tất cả các hồ sơ đang sử dụng dữ liệu OP trong câu hỏi.

Answer 2

Bạn có thể sử dụng nhân hợp lý cho công việc này để đạt được hiệu quả tương tự:

s <- similarities < 0 
nh <- s*(6-history) + (!s)*history 

Benchmark trên 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 

On 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 

Trên 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 

Aha! Cách tiếp cận của tôi chậm hơn trên kiến ​​trúc Core 2.

Answer 3

Đây là một nhanh hơn ifelse, mặc dù nó không nhanh hơn các câu trả lời ở trên, nó duy trì cấu trúc ifelse.

ifelse_sign <- function(b,x,y){ 

    x[!b] <- 0 
    y[b] <-0 

    x + y + b *0 
}