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 .