[R-es] Encontrar la primera columna no NA
Javier Villacampa González
javier.villacampa.gonzalez en gmail.com
Jue Oct 27 15:37:59 CEST 2016
Pues parece que para este caso en particular es mejor la solucon con el for
vectorizado. Aunque la verdad que la tuyaes muy buena de cara compresion y
comprensión de codigo. Igual si tuviese mas columnas la solucin la tuya
sería más rápida. Tendré que mirarlo.
library(microbenchmark)
N <- 1e1
tabla <-
microbenchmark(
JVG ={
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[,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)))])]
},
times = N, unit = "s")
tabla %>% print
beepr::beep(3)
# Unit: seconds
# expr min lq mean median uq max neval
# JVG 2.345127 2.440396 2.591505 2.509842 2.738680 3.013498 10
# Olivier 5.445869 5.454217 6.132737 6.212742 6.410948 7.008085 10
El 27 de octubre de 2016, 15:10, Olivier Nuñez <onunez en unex.es> escribió:
> Prueba lo siguiente, no es óptimo, pero creo va bastnate más rapido que
> los que mencionaste:
>
> t <- Sys.time()
> dat[,First_month := apply(.SD,1,function(x) colnames(.SD)[min(which(!is.na
> (x)))])]
> dat[,Value_First_month := apply(.SD,1,function(x) x[min(which(!is.na
> (x)))])]
> difftime( Sys.time(), t)
>
> Time difference of 3.478778 secs
>
>
> ----- Mensaje original -----
> De: "Javier Villacampa González" <javier.villacampa.gonzalez en gmail.com>
> Para: "R ayuda" <r-help-es en r-project.org>
> Enviados: Jueves, 27 de Octubre 2016 13:43:19
> Asunto: [R-es] Encontrar la primera columna no NA
>
> Imaginemos que tenemos una matriz con datos temporales por sujetos.
> Pongamos que numero de veces que ha jugado una carta en un juego online. Y
> que quiero saber cuantas veces jugo la carta el primer mes que estuvo en el
> juego.
>
> Pero claro mi matriz guarda los datos temporalmente de tal manera que:
>
> # data.table( Enero = c( 1, 4, NA , NA , NA) , Febrero = c( 2, 6, 1, NA, NA
> ) , Marzo = c( 8,6,7,3, NA) , Abril = c( NA, 15, 5, 6,6 ))
> # Enero Febrero Marzo Abril
> # 1: 1 2 8 NA
> # 2: 4 6 6 15
> # 3: NA 1 7 5
> # 4: NA NA 3 6
> # 5: NA NA NA 6
> # Suponiendo que cada fila es un jugador
> # En este caso la solucion debería ser
> # 1 para el primero que empezó en Enero
> # 4 para el segundo jugador que empezó en Enero
> # 1 para el tercero que empezó en Febrero
> # 3 Para el cuarto que empezó en Marzo
> # 6 para el quinto que empezó en Abril
>
>
> A alguno se os ocurre una solucion más eficiente que la siguiente. Esto
> seguro que con data table o dplyr se puede. Ya he quitados los pipes que
> facilitan la lectura pero que no se llevan bien con data.table. Pero estoy
> seguro que se puede mejorar más.
>
> #=======================================================
> # Como ejemplo de codigo
> #=======================================================
> # S Primera solucion ------------------------------
> ------------------------
> # First not NA colum per subject
> library(data.table)
> library(dplyr)
> set.seed(123456)
> numero <- 1e5
> 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 )
> )
>
>
> t <- Sys.time()
> First_month <-
> dat %>%
> apply( MARGIN = 1, FUN =
> function(x){
> which( !is.na(x) ) %>% min( na.rm = TRUE ) %>% return()
> }
> )
>
>
>
> First_month %>% table %>% prop.table
> 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 ]
> }
>
> dat %>% print
> # dat %>% summary
>
> cat( "===============================\n", difftime( Sys.time(), t, units =
> "min") , " minutos que cuesta \n===============================\n" )
> beepr::beep(3)
> # E Primera solucion ------------------------------
> ------------------------
>
>
>
>
> # S comparativa ------------------------------
> -----------------------------
> library(microbenchmark)
> N <- 1e2
> tabla <-
> microbenchmark(
> JVG_dplyr ={ dat %>%
> apply( MARGIN = 1, FUN =
> function(x){
> which( !is.na(x) ) %>% min( na.rm = TRUE ) %>%
> return()
> }
> )
> },
> JVG ={
> apply(X = dat, MARGIN = 1, FUN =
> function(x){
> return( min( which( !is.na(x) ), na.rm = TRUE ) )
> }
> )
> },
> times = N, unit = "s")
>
> tabla %>% print
> beepr::beep(3)
>
> # Unit: seconds
> # expr min lq mean median uq max
> neval
> # JVG_dplyr 21.2321152 22.233428 22.9575357 22.5701781 23.444432
> 26.642730 10
> # JVG 0.7628928 0.843067 0.9260389 0.8495834 1.027036
> 1.295868 10
> # E comparativa ------------------------------
> -----------------------------
>
> --
>
> [[alternative HTML version deleted]]
>
> _______________________________________________
> R-help-es mailing list
> R-help-es en r-project.org
> https://stat.ethz.ch/mailman/listinfo/r-help-es
>
--
[[alternative HTML version deleted]]
Más información sobre la lista de distribución R-help-es