2016-06-24 3 views
5

Мне нужно получить результаты следующей функцииУскорение ifelse() без написания C/C++?

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++. Но есть ли способ избежать использования скомпилированного кода?

+1

Если вы хотите оптимизировать код, который уже работает, то это вопрос CodeReview, а не вопрос StackOverflow. http://codereview.stackexchange.com/ –

ответ

5

Я столкнулся с этим раньше. Мы не должны постоянно использовать ifelse(). Если вы посмотрите, как написано ifelse, набрав «ifelse» в вашей консоли 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, поэтому всякий раз, когда мы можем, используйте вектор.


ответ Тестирование @ Мэтью

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 в вопросе.

+1

Core 2 Duo - архитектура до Nehalem, и это может быть частью разницы. Я тестирую Sandy Bridge i7-3740QM. –

+0

У меня есть машина Core 2 здесь, позвольте мне сравнить микрообъект на нем –

+1

На Nehalem и дальше, в то время как умножение имеет более высокую задержку команд, чем добавление, что часто не имеет значения. Инструкции не работают, и количество отработанных инструкций имеет значение. Без зависимостей данных обе инструкции будут «удалены» за один такт. То же, что и вы, я не использую специальный BLAS. Я буду счастлив сделать завтра Rprof, но мне уже почти пора уходить на ночь. –

7

Вы можете использовать логическое умножение для этой задачи для достижения того же эффекта:

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

Benchmark на 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 

Aha! Мой подход медленнее в архитектуре Core 2.

0

Здесь находится более быстрый ifelse, хотя он не быстрее, чем приведенные выше ответы, он поддерживает структуру ifelse.

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

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

    x + y + b *0 
} 
Смежные вопросы