[R-es] Encontrar la primera columna no NA
Jose Luis Cañadas Reche
canadasreche en gmail.com
Jue Oct 27 20:54:15 CEST 2016
jajaja.
Hoy estaba dando un curso y mis alumnos sabían más dplyr y cosas de esas
que yo.
Siempre que tengo que usar dplyr tengo que mirar la vignette ;).
Saludos
El 27/10/16 a las 18:42, Carlos J. Gil Bellosta escribió:
> Las operaciones con columnas de data.frames (y sus variantes modernas) son
> muy caras. Así que:
>
> t <- Sys.time()
>
> 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)]
>
> difftime(Sys.time(), t)
>
> Y una pregunta: ¿alguien programa en R base todavía?
>
> Un saludo,
>
> Carlos J. Gil Bellosta
> http://www.datanalytics.com
>
> El 27 de octubre de 2016, 18:11, Olivier Nuñez <onunez en unex.es> escribió:
>
>> Por último, utilizando la indexación lineal de matriz que propusó luisfo
>> en su momento:
>>
>>> t <- Sys.time()
>>> 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]
>> jugador First_month Value_First_month
>> 1: 1 Uno 0.93520715
>> 2: 2 Uno 0.85930634
>> 3: 3 dos 0.13521503
>> 4: 4 Uno 0.86996341
>> 5: 5 dos 0.65879889
>> ---
>> 99996: 99996 Uno 0.94728423
>> 99997: 99997 Uno 0.24088571
>> 99998: 99998 Uno 0.07458581
>> 99999: 99999 Uno 0.30535050
>> 100000: 100000 Uno 0.54640585
>>> difftime( Sys.time(), t)
>> Time difference of 0.3299999 secs
>> ----- Mensaje original -----
>> De: Javier Villacampa González <javier.villacampa.gonzalez en gmail.com>
>> Para: Olivier Nuñez <onunez en unex.es>
>> CC: R ayuda <r-help-es en r-project.org>
>> Enviado: Thu, 27 Oct 2016 17:17:12 +0200 (CEST)
>> Asunto: Re: [R-es] Encontrar la primera columna no NA
>>
>> Hemos mejorado bastante desde el inicio. Pero aun andamos lejos. Igual es
>> por el merge que hago. Seguire mirando
>> library(microbenchmark)
>> N <- 1e1
>> tabla <-
>> microbenchmark(
>> # JVG_dplyr ={
>> # dat %>%
>> # apply( MARGIN = 1, FUN =
>> # function(x){
>> # which( !is.na(x) ) %>% min( na.rm = TRUE ) %>%
>> return()
>> # }
>> # )
>> # 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 ]
>> # }
>> # },
>> 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 )
>> )
>>
>> 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)
>>
>> },
>> times = N, unit = "s")
>>
>> tabla %>% print
>> beepr::beep(3)
>>
>> # Unit: seconds
>> # expr min lq mean median uq max
>> neval
>> # JVG 0.6479002 0.7518933 0.8673007 0.8216553 0.9137195 1.251891
>> 10
>> # Olivier 2.9568197 3.6663586 3.9364770 3.9069826 4.5619519 4.685842 10
>> # Olivier2 1.1316970 1.4463621 1.4735507 1.4874366 1.5681243 1.631713 10
>> # E comparativa ------------------------------
>> -----------------------------
>>
>> El 27 de octubre de 2016, 15:39, Olivier Nuñez <onunez en unex.es> escribió:
>>
>>> Otra solución algo más rapida:
>>>> t <- Sys.time()
>>>> dat[,jugador:=1:.N]
>>>> dat2=melt(dat,id.vars="jugador")
>>>> setkey(dat2,jugador)
>>>> dat2[,index:=min(which(!is.na(value))),by=jugador]
>>>> dat2[,.(First_month=variable[index[1]],Value_First_month=
>>> value[index[1]]),by=jugador]
>>> jugador First_month Value_First_month
>>> 1: 1 Uno 0.93520715
>>> 2: 2 Uno 0.85930634
>>> 3: 3 dos 0.13521503
>>> 4: 4 Uno 0.86996341
>>> 5: 5 dos 0.65879889
>>> ---
>>> 99996: 99996 Uno 0.94728423
>>> 99997: 99997 Uno 0.24088571
>>> 99998: 99998 Uno 0.07458581
>>> 99999: 99999 Uno 0.30535050
>>> 100000: 100000 Uno 0.54640585
>>>> difftime( Sys.time(), t)
>>> Time difference of 1.060787 secs
>>>
>>>
>>> ----- Mensaje original -----
>>> De: "Olivier Nuñez" <onunez en unex.es>
>>> Para: "Javier Villacampa González" <javier.villacampa.gonzalez en gmail.com
>>>
>>> CC: "R ayuda" <r-help-es en r-project.org>
>>> Enviados: Jueves, 27 de Octubre 2016 15:10:07
>>> Asunto: Re: [R-es] Encontrar la primera columna no NA
>>>
>>> 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
>>>
>>> _______________________________________________
>>> R-help-es mailing list
>>> R-help-es en r-project.org
>>> https://stat.ethz.ch/mailman/listinfo/r-help-es
>>>
>>
>>
>> --
>>
>> _______________________________________________
>> 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]]
>
> _______________________________________________
> 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