[R-es] Encontrar la primera columna no NA
Olivier Nuñez
onunez en unex.es
Jue Oct 27 15:10:07 CEST 2016
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
Más información sobre la lista de distribución R-help-es