Accelerazione della funzione che utilizza all'interno di una semplice chiamata R

Question

Ho due vettori e e g. Voglio sapere per ogni elemento in e la percentuale di elementi in g che sono più piccoli. Un modo per implementare questo in R è:

set.seed(21) 
e <- rnorm(1e4) 
g <- rnorm(1e4) 
mf <- function(p,v) {100*length(which(v<=p))/length(v)} 
mf.out <- sapply(X=e, FUN=mf, v=g) 

Con grande e o g, questo richiede un sacco di tempo per l'esecuzione. Come posso modificare o adattare questo codice per rendere questa esecuzione più veloce?

Nota: la funzione mf precedente si basa sul codice dalla funzione mess nel pacchetto dismo.

Answer 1

Il motivo per cui è così lento è perché si chiama la funzione length(e) volte. Non fa una grande differenza per i vettori di piccole dimensioni, ma il sovraccarico delle chiamate alla funzione R inizia davvero a sommarsi con vettori più grandi.

Normalmente, si avrebbe bisogno di spostare questo a codice compilato, ma per fortuna è possibile utilizzare findInterval:

set.seed(21) 
e <- rnorm(1e4) 
g <- rnorm(1e4) 
O <- findInterval(e,sort(g))/length(g) 

# Now for some timings: 
f <- function(p,v) mean(v<=p) 
system.time(o <- sapply(e, f, g)) 
# user system elapsed 
# 0.95 0.03 0.98 
system.time(O <- findInterval(e,sort(g))/length(g)) 
# user system elapsed 
#  0  0  0 
identical(o,O) # may be FALSE 
all.equal(o,O) # should be TRUE 

# How fast is this on large vectors? 
set.seed(21) 
e <- rnorm(1e7) 
g <- rnorm(1e7) 
system.time(O <- findInterval(e,sort(g))/length(g)) 
# user system elapsed 
# 22.08 0.08 22.31