Inspirado por Adolfo, otra vueltica de tuerca: #matrices mejor que dfs tmp <- as.matrix(dat)
# min implementado a mano: my.cols <- rep(ncol(tmp), nrow(tmp)) for (i in (ncol(tmp) - 1):1) my.cols[!is.na(tmp[,i])] <- i # al canasto: my.values <- tmp[cbind(1:nrow(tmp), my.cols)] Un saludo, Carlos J. Gil Bellosta http://www.datanalytics.com El 28 de octubre de 2016, 13:48, Adolfo Álvarez <adalva...@gmail.com> escribió: > Hola a todos, me ha gustado mucho la solución de Carlos, muy eficiente y > muy ingeniosa al utilizar la funcion col() que o no la conocia o no me > acordaba de ella. > > La parte mas "lenta" sigue siendo el apply que en el fondo no es mas que un > ciclo for a traves de las filas, asi que inspirado por el metodo de Carlos > pense que podria ser mas rapido si iteramos a traves de las columnas por lo > que en general seran menos iteraciones. He incluido esta modificacion en el > benchmark, es un poco menos elegante que la original de Carlos pero algo > mas rapida. Seguro que aun se puede mejorar un poco mas en R base o > incorporar Rcpp, pero creo que al menos por mi parte llego hasta aqui. > > Muy interesante tanto el problema como las soluciones propuestas, un > saludo! > Adolfo. > > library(microbenchmark) > library(data.table) > library(dplyr) > library(tidyr) > set.seed(123456) > numero <- 1e5 > N <- 1e1 > tabla <- > microbenchmark( > JVG ={ > dat <- > data.table( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > First_month <- > apply(X = dat, MARGIN = 1, FUN = > function(x){ > return( min( which( !is.na(x) ), na.rm = TRUE ) ) > } > ) > dat[ , First_month := First_month] > N_for <- length( unique(First_month )) > for( j in 1:N_for){ > x <- dat[ First_month == j, j, with = FALSE] > dat[ First_month == j , Value_First_month := x ] > } > }, > Olivier ={ > dat <- > data.table( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > dat[,First_month := apply(X = .SD,MARGIN = 1,FUN = function(x) > colnames(.SD)[min(which(!is.na(x)))])] > dat[,Value_First_month := apply(X = .SD,MARGIN = 1,FUN = function(x) > x[min(which(!is.na(x)))])] > }, > Olivier2={ > dat <- > data.table( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > > dat[,jugador:=1:.N] > dat2=melt(dat,id.vars="jugador") > setkey(dat2,jugador) > dat2[,index:=min(which(!is.na(value))),by=jugador] > dat3 <- dat2[,list(First_month_Olivier > =variable[index[1]],Value_First_month_Olivier > =value[index[1]]),by=jugador] > setkey(x = dat, jugador) > dat0 <- merge( x = dat, y = dat3, all.x = TRUE, all.y = FALSE) > > }, > > Adolfo = { > > dat <- > data.table( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > # 1) Creamos una columna con la informacion de los jugadores, > # Como es un jugador por fila, hacemos 1:nrow. > step1 <- dat %>% > mutate(player = 1:nrow(dat)) > > #2) Convertimos las columnas de tiempo (uno, dos, tres, ...) en dos > # columnas, mes y numero de juegos. (Ojo, asumimos que en los datos > las > # columnas estan ordenadas como en > el ejemplo, es decir uno, dos, tres y no > # tres, uno, dos) > # > step2 <- gather(step1, month, games, -player) > > #y 3) Filtramos los meses con NA y por cada jugador nos quedamos con > # el primer dato: > step3 <- step2 %>% > filter(!is.na(games)) %>% > group_by(player) %>% > slice(1) > }, > > Olivier3 = { > dat <- > data.table( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > M=as.matrix(dat) > index <- which(!is.na(M)) - 1 > meses<-colnames(M) > M2<- data.table(columna=index %/% nrow(M) +1L, jugador=index %% > nrow(M) +1L , valor=M[index+1L]) > setkey(M2,jugador,columna) > > > M2[,.(First_month=meses[columna[1]],Value_First_month= > valor[1]),by=jugador] > }, > GilBellosta = { > > dat <- > data.frame( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > tmp <- (as.matrix(dat)) > cols <- col(tmp) > cols[is.na(tmp)] <- Inf > my.cols <- apply(cols, 1, min) > my.values <- tmp[cbind(1:nrow(tmp), my.cols)] > }, > Adolfo2 = { > dat <- > data.frame( Uno = sample( c(runif(numero) , rep(NA , numero /2e0 > )) , size = numero ) , > dos = sample( c(runif(numero) , rep(NA , numero /1e1 > )) , size = numero ) , > tres = sample( c(runif(numero) , rep(NA , numero /2e1 > )) , size = numero ) , > cuatro = sample( c(runif(numero) , rep(NA , numero /1e2 > )) , size = numero ) , > cinco = sample( c(runif(numero) , rep(NA , numero /2e2 > )) , size = numero ) , > seis = sample( c(runif(numero) , rep(NA , numero /1e3 > )) , size = numero ) > ) > tmp <- (as.matrix(dat)) > cols <- col(tmp) > cols[is.na(tmp)] <- NA > my.cols <- cols[,ncol(cols)] > for (j in (ncol(cols)-1):1){ > my.cols <- ifelse(is.na(cols[,j]), my.cols, cols[,j]) > } > my.values <- tmp[cbind(1:nrow(tmp), my.cols)] > }, > times = N, unit = "s") > > > tabla > Unit: seconds > expr min lq mean median uq max > neval > JVG 1.0458327 1.3045354 1.3660296 1.3486868 1.4004353 2.0389759 > 10 > Olivier 4.4031746 4.6501372 4.9638930 4.9841975 5.2855783 5.5569627 > 10 > Olivier2 1.7937688 2.1531256 2.4749540 2.5052893 2.8389349 3.0933835 > 10 > Adolfo 0.3520900 0.3615358 0.4764479 0.3942295 0.5072621 1.0266727 > 10 > Olivier3 0.3936536 0.4454847 0.5254894 0.4784246 0.5269834 0.8900983 > 10 > GilBellosta 0.2721629 0.3097020 0.3901691 0.3466332 0.4294069 0.7126116 > 10 > Adolfo2 0.1110292 0.1611071 0.1812212 0.1639743 0.2007791 0.2948245 > 10 > > [[alternative HTML version deleted]] > > _______________________________________________ > R-help-es mailing list > R-help-es@r-project.org > https://stat.ethz.ch/mailman/listinfo/r-help-es > [[alternative HTML version deleted]] _______________________________________________ R-help-es mailing list R-help-es@r-project.org https://stat.ethz.ch/mailman/listinfo/r-help-es