[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