2016-06-24 31 views
5

Ho bisogno di ottenere i risultati della seguente funzioneAccelerare ifelse() senza scrivere 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 
    } 

Per esempio, per i seguenti vettori:

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

che i cambiamenti all'interno di un ciclo. Questo richiede:

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

    user system elapsed 
    3.71 1.11 4.67 

Inizialmente ho il sospetto che il problema è il ciclo for, ma profiling Risultato Punti di 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() è il collo di bottiglia delle mie prestazioni. A meno che non ci sia un modo in R per accelerare ifelse(), è improbabile che ci sia un grande incremento delle prestazioni.

Tuttavia, ifelse() è già l'approccio vettoriale. Mi sembra che l'unica possibilità rimasta è quella di usare C/C++. Ma c'è un modo per evitare l'uso di codice compilato?

+1

Se stai solo cercando di ottimizzare il codice che funziona già, questa è una domanda CodeReview e non una domanda StackOverflow. http://codereview.stackexchange.com/ –

risposta

5

L'ho incontrato prima. Non è necessario utilizzare ifelse() per tutto il tempo. Se si osserva come viene scritto ifelse, digitando "ifelse" nella console R, è possibile vedere che questa funzione è scritta in linguaggio R e esegue vari controlli che sono davvero inefficienti.

Invece di usare ifelse(), siamo in grado di fare questo:

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

E poi andiamo a controllare di nuovo risultato profiling:

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 

abbiamo un 2+ volte incremento delle prestazioni. Inoltre, il profilo è più simile a un profilo piatto, senza nessuna singola parte che domina il tempo di esecuzione.

In R, l'indicizzazione/lettura/scrittura vettoriale è alla velocità del codice C, quindi ogni volta che è possibile, utilizzare un vettore.


di test @ Matthew risposta

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? Più lentamente?

Il risultato della profilazione completa indica che questo approccio impiega più tempo per la moltiplicazione in virgola mobile "*" e la logica non "!" sembra piuttosto costosa. Mentre il mio approccio richiede solo addizione/sottrazione in virgola mobile.

Bene, il risultato potrebbe dipendere anche dall'architettura. Sto testando Intel Nahalem (Intel Core 2 Duo) al momento. Pertanto, il benchmark tra due approcci su varie piattaforme è ben accetto.


Osservazioni

Tutti profilazione stanno utilizzando i dati di OP nella questione.

+1

Il Core 2 duo è un'architettura pre-Nehalem e potrebbe far parte della differenza. Sto testando su un Sandy Bridge i7-3740QM. –

+0

Ho una macchina Core 2 qui, mi permetta di confrontare il microbenchmark su di esso –

+1

Su Nehalem e oltre, mentre la moltiplicazione ha una latenza di istruzioni più alta dell'aggiunta, che spesso non ha importanza. Le istruzioni sono esaurite e il numero di istruzioni ritirate è ciò che conta. Senza le dipendenze dei dati, entrambe le istruzioni saranno "ritirate" in un tick di clock. Come te, non sto usando un BLAS speciale. Sarò felice di fare una gara di Rprof su questo domani, ma è quasi ora che mi ritiri per la notte. –

7

È possibile utilizzare la moltiplicazione logica per questo compito per ottenere lo stesso effetto:

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

Benchmark su 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 

Su 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 

Su 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! Il mio approccio è più lento nell'architettura Core 2.

0

Ecco un ifelse più veloce, anche se non è più veloce delle risposte di cui sopra, mantiene la struttura ifelse.

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

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

    x + y + b *0 
}