while - if r==

Alternativas a declaraciones ifelse anidadas en R

Question

Supongamos que tenemos los siguientes datos. Las filas representan un país y las columnas (en in05:in09 ) indican si ese país estuvo presente en una base de datos de interés en el año determinado ( 2005:2009 ).

id <- c("a", "b", "c", "d")
in05 <- c(1, 0, 0, 1)
in06 <- c(0, 0, 0, 1)
in07 <- c(1, 1, 0, 1)
in08 <- c(0, 1, 1, 1)
in09 <- c(0, 0, 0, 1)
df <- data.frame(id, in05, in06, in07, in08, in09)

Quiero crear una variable de primer año que indique el primer año en el que el país estuvo presente en la base de datos. En este momento hago lo siguiente:

df$firstyear <- ifelse(df$in05==1,2005,
    ifelse(df$in06==1,2006,
        ifelse(df$in07==1, 2007,
            ifelse(df$in08==1, 2008,
                ifelse(df$in09==1, 2009,
                    0)))))

El código anterior ya no es muy bueno y mi conjunto de datos contiene muchos más años. ¿Hay alguna alternativa, usar *apply funciones de *apply , bucles u otra cosa, para crear esta variable de primer año?

Answer 1

Aquí hay otra opción:

years <- as.integer(substr(names(df[-1]), 3, 4)) + 2000L
cbind(df, yr=do.call(pmin.int, Map(`/`, years, df[-1])))

Produce:

  id in05 in06 in07 in08 in09   yr
1  a    1    0    1    0    0 2005
2  b    0    0    1    1    0 2007
3  c    0    0    0    1    0 2008
4  d    1    1    1    1    1 2005

Y es rápido. Aquí solo se mide el tiempo para encontrar el año mínimo utilizando los datos de Alexis:

Unit: milliseconds
                                       expr       min       lq   median       uq      max neval
 do.call(pmin.int, Map(`/`, 11:20, DF[-1])) 178.46993 194.3760 219.8898 229.1597 307.1120    10
                                 ff(DF[-1]) 416.07297 434.0792 439.1970 452.8345 496.2048    10
                   max.col(DF[-1], "first")  99.71936 138.2285 175.2334 207.6365 239.6519    10

Curiosamente, esto no reproduce los tiempos de Alexis, mostrando a David como el más rápido. Esto está en R 3.1.2.

EDITAR : basado en convo con Frank, actualicé la función Alexis para ser más compatible con R 3.1.2:

ff2 = function(x) {
  ans = as.integer(x[[1]])
  for(i in 2:length(x)) {
      inds = which(ans == 0L)
      if(!length(inds)) return(ans)
      ans[inds] = i * (x[[i]][inds] == 1)
  }
  return(ans)
}

Y esto se acerca a los resultados originales:

Unit: milliseconds
        expr       min        lq    median        uq      max neval
  ff(DF[-1]) 407.92699 415.11716 421.18274 428.02092 462.2474    10
 ff2(DF[-1])  64.20484  72.74729  79.85748  81.29153 148.6439    10

Answer 2

Otra respuesta con algunas notas de eficiencia (aunque esta QA no se trata de velocidad).

En primer lugar, podría ser mejor evitar la conversión de una estructura de "lista" -y a una "matriz"; a veces vale la pena convertirlo en una "matriz" y usar una función que maneja eficientemente un ''vector con un'' atributo ''atenuado'' (es decir, una ''matriz'' / ''matriz'') - otras veces no lo es. Tanto max.col como apply convierten en una "matriz".

En segundo lugar, en situaciones como estas, donde no es necesario que verifiquemos todos los datos mientras llegamos a una solución, podríamos beneficiarnos de una solución con un ciclo que controla lo que pasa en la siguiente iteración. Aquí sabemos que podemos detenernos cuando encontremos el primer "1". Ambos max.col (y which.max ) tienen que which.max una vez para, en realidad, encontrar el valor máximo; el hecho de que sabemos que "max == 1" no se aprovecha.

En tercer lugar, la match es potencialmente más lenta cuando buscamos solo un valor en otro vector de valores porque la configuración de los match es bastante complicada y costosa:

x = 5; set.seed(199); tab = sample(1e6)
identical(match(x, tab), which.max(x == tab))
#[1] TRUE
microbenchmark::microbenchmark(match(x, tab), which.max(x == tab), times = 25)
#Unit: milliseconds
#                expr       min        lq    median        uq       max neval
#       match(x, tab) 142.22327 142.50103 142.79737 143.19547 145.37669    25
# which.max(x == tab)  18.91427  18.93728  18.96225  19.58932  38.34253    25

En resumen, una forma de trabajar en la estructura de "lista" de un "data.frame" y detener los cálculos cuando encontramos un "1" podría ser un ciclo como el siguiente:

ff = function(x)
{
    x = as.list(x)
    ans = as.integer(x[[1]])
    for(i in 2:length(x)) {
        inds = ans == 0L
        if(!any(inds)) return(ans)
        ans[inds] = i * (x[[i]][inds] == 1)
    }
    return(ans)
}

Y las soluciones en las otras respuestas (ignorando los pasos adicionales para la salida):

david = function(x) max.col(x, "first")
plafort = function(x) apply(x, 1, match, x = 1)

ff(df[-1])
#[1] 1 3 4 1
david(df[-1])
#[1] 1 3 4 1
plafort(df[-1])
#[1] 1 3 4 1

Y algunos puntos de referencia:

set.seed(007)
DF = data.frame(id = seq_len(1e6),
                "colnames<-"(matrix(sample(0:1, 1e7, T, c(0.25, 0.75)), 1e6), 
                             paste("in", 11:20, sep = "")))
identical(ff(DF[-1]), david(DF[-1]))
#[1] TRUE
identical(ff(DF[-1]), plafort(DF[-1]))
#[1] TRUE
microbenchmark::microbenchmark(ff(DF[-1]), david(DF[-1]), as.matrix(DF[-1]), times = 30)
#Unit: milliseconds
#              expr       min        lq    median        uq       max neval
#        ff(DF[-1])  64.83577  65.45432  67.87486  70.32073  86.72838    30
#     david(DF[-1]) 112.74108 115.12361 120.16118 132.04803 145.45819    30
# as.matrix(DF[-1])  20.87947  22.01819  27.52460  32.60509  45.84561    30

system.time(plafort(DF[-1]))
#   user  system elapsed 
#  4.117   0.000   4.125 

No es realmente un apocalipsis, pero vale la pena ver que los enfoques algorítmicos sencillos y directos pueden, de hecho, probar ser igualmente buenos o incluso mejores dependiendo del problema. Obviamente, (la mayoría) otras veces bucle en R puede ser laborioso.

Answer 3

Otras alternativas desordenadas:

library(tidyr)
library(sqldf)
    newdf <- gather(df, year, code, -id)
    df$firstyear <- sqldf(''SELECT min(rowid) rowid, id, year as firstyear
                            FROM newdf 
                            WHERE code = 1
                            GROUP BY id'')[3]

library(tidyr)
df2 <- gather(df, year, code, -id)
df2 <- df2[df2$code == 1, 1:2]
df2 <- df2[!duplicated(df2$id), ]
merge(df, df2)

library(tidyr)
library(dplyr)
    newdf <- gather(df, year, code, -id)
    df$firstyear <- (newdf %>% 
                      filter(code==1) %>%
                      select(id, year) %>%
                      group_by(id) %>%
                      summarise(first = first(year)))[2]

Salida:

  id in05 in06 in07 in08 in09 year
1  a    1    0    1    0    0 in05
2  b    0    0    1    1    0 in07
3  c    0    0    0    1    0 in08
4  d    1    1    1    1    1 in05

Una solución más limpia que combina la solución de plaforts con alexises_laz es:

names(df) <- c("id", 2005, 2006, 2007, 2008, 2009)
df$firstyear <- names(df[-1])[apply(df[-1], 1, which.max)] 

  id 2005 2006 2007 2008 2009 firstyear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005

Si quisiéramos conservar los nombres de las columnas originales, podríamos usar el cambio de nombre provisto por @David Arenburg.

df$firstYear <- gsub(''in'', ''20'', names(df[-1]))[apply(df[-1], 1, which.max)]

  id in05 in06 in07 in08 in09 firstYear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005

Answer 4

Puede usar dplyr::case_when dentro de dplyr::mutate() siguiendo las líneas del método presentado en este tweet .

# Using version 0.5.0.
# Dev version may work without `with()`.    
df %>%
      mutate(., firstyear = with(., case_when(
        in05 == 1 ~ 2005,
        in06 == 1 ~ 2006,
        in07 == 1 ~ 2007,
        in08 == 1 ~ 2008,
        in09 == 1 ~ 2009,
        TRUE ~ 0
)))

Answer 5

Puedes vectorizar usando max.col

indx <- names(df)[max.col(df[-1], ties.method = "first") + 1L]
df$firstyear <- as.numeric(sub("in", "20", indx))
df
#   id in05 in06 in07 in08 in09 firstyear
# 1  a    1    0    1    0    0      2005
# 2  b    0    0    1    1    0      2007
# 3  c    0    0    0    1    0      2008
# 4  d    1    1    1    1    1      2005

Answer 6

Siempre prefiero trabajar con datos arreglados. Primer método filtra en cumsums

# Tidy
df <- df %>% 
  gather(year, present.or.not, -id) 

# Create df of first instances
first.df <- df %>% 
  group_by(id, present.or.not) %>% 
  mutate(ranky = rank(cumsum(present.or.not)), 
         first.year = year) %>% 
  filter(ranky == 1)

# Prepare for join
first.df <- first.df[,c(''id'', ''first.year'')]

# Join with original
df <- left_join(df,first.df)

# Spread
spread(df, year, present.or.not)

O esta alternativa que, después de ordenar, corta la primera fila de grupos arreglados.

df %>% 
  gather(year, present_or_not, -id) %>% 
  filter(present_or_not==1) %>% 
  group_by(id) %>% 
  arrange(id, year) %>% 
  slice(1) %>% 
  mutate(year = str_replace(year, "in", "20")) %>% 
  select(1:2) %>% 
  right_join(df)`

Answer 7

df$FirstYear <- gsub(''in'', ''20'', names(df))[apply(df, 1, match, x=1)]
df
  id in05 in06 in07 in08 in09 FirstYear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005

Hay muchas formas de hacerlo. Usé la match porque encontrará la primera instancia de un valor especificado. Las otras partes del código son para presentación. Primero ir línea por línea con apply y nombrar los años por los nombres de columna con names . La asignación <- y df$FirstYear es una forma de agregar el resultado al marco de datos.

crédito adicional @David Arenburg tiene una buena idea acerca de sustituir la entrada por 20 en la columna FirstYear .