Ajuda para evitar um loop com elegância 2
Olá pessoal, tenho que executar uma função parecida com essa no R. Mas ela normalmente demora longos 500 segundos para executar. Fiz uma versão que chama um código C, e essa é bem eficiente (demora cerca de 0,5 segundos), porém gostaria de uma função totalmente em R. Caso alguém queira ajudar, desde já agradeço. set.seed(1) vetor1 <- rep(1:4, each = 5) var1 <- abs(rnorm(4,3)) * vetor1 cond1 <-abs(rnorm(4,10)) * vetor1 var2 <- matrix(0, nrow=length(vetor1)) cond2 <- matrix(0, nrow=length(vetor1)) for(i in 1:(length(vetor1) - 1)){ if(vetor1[i] == vetor1[i+1]){ var2[i] = var1[i+1] cond2[i] = cond1[i+1] }else { var2[i] = NA cond2[i] = NA } } var2[length(vetor1)] <- NA cond2[length(vetor1)] <- NA dados <- na.exclude(data.frame(var2, cond2)) Gustavo Marcatti Eng. Florestal
Veja o codigo abaixo e encontre o que fazer nos 475 segundos que devem sobrar... b set.seed(1) n <- 1e3 vetor1 <- rep(1:n, each = 5) var1 <- abs(rnorm(n,3)) * vetor1 cond1 <- abs(rnorm(n,10)) * vetor1 fOriginal <- function(vetor1, var1, cond1){ var2 <- matrix(0, nrow=length(vetor1)) cond2 <- matrix(0, nrow=length(vetor1)) for(i in 1:(length(vetor1) - 1)){ if(vetor1[i] == vetor1[i+1]){ var2[i] = var1[i+1] cond2[i] = cond1[i+1] }else { var2[i] = NA cond2[i] = NA } } var2[length(vetor1)] <- NA cond2[length(vetor1)] <- NA na.exclude(data.frame(var2, cond2)) } fOtimizada <- function(vetor1, var1, cond1){ data.frame(var1[-1], cond1[-1])[diff(vetor1)==0,] } library(rbenchmark) (res <- benchmark(original=fOriginal(vetor1, var1, cond1), oneliner=fOtimizada(vetor1, var1, cond1), columns=c('test', 'elapsed', 'relative')))
Muito Bom!!! Impressionante a diferença (no tempo e no tamanho da função)! Valeu Gustavo ________________________________ De: Benilton Carvalho <beniltoncarvalho@gmail.com> Para: r-br@listas.c3sl.ufpr.br; Gustavo Marcatti <vgp.gustavo@yahoo.com.br> Enviadas: Quarta-feira, 18 de Abril de 2012 18:48 Assunto: Re: [R-br] Ajuda para evitar um loop com elegância 2 Veja o codigo abaixo e encontre o que fazer nos 475 segundos que devem sobrar... b set.seed(1) n <- 1e3 vetor1 <- rep(1:n, each = 5) var1 <- abs(rnorm(n,3)) * vetor1 cond1 <- abs(rnorm(n,10)) * vetor1 fOriginal <- function(vetor1, var1, cond1){ var2 <- matrix(0, nrow=length(vetor1)) cond2 <- matrix(0, nrow=length(vetor1)) for(i in 1:(length(vetor1) - 1)){ if(vetor1[i] == vetor1[i+1]){ var2[i] = var1[i+1] cond2[i] = cond1[i+1] }else { var2[i] = NA cond2[i] = NA } } var2[length(vetor1)] <- NA cond2[length(vetor1)] <- NA na.exclude(data.frame(var2, cond2)) } fOtimizada <- function(vetor1, var1, cond1){ data.frame(var1[-1], cond1[-1])[diff(vetor1)==0,] } library(rbenchmark) (res <- benchmark(original=fOriginal(vetor1, var1, cond1), oneliner=fOtimizada(vetor1, var1, cond1), columns=c('test', 'elapsed', 'relative')))
participantes (2)
-
Benilton Carvalho -
Gustavo Marcatti