在R中替代嵌套ifelse语句的方法

Question

假设我们有以下数据。每行表示一个国家，而列（in05:in09）则表示该国家在给定年份（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)

我想创建一个名为firstyear的变量，它表示该国在数据库中出现的第一年。目前我做的是：

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)))))

上述代码已经不太好，而我的数据集包含更多年份。是否有其他替代方式，例如使用*apply函数、循环或其他方法来创建firstyear变量？

- Kat

Answer 1

您可以使用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

- David Arenburg

---

好老的 max.col 函数 - 总是拯救我们于水深火热之中。尽管它默认处理并列结果时选择随机值实在很令人烦恼，考虑到 which.max / which.min 等函数总是返回首个遇到的结果。 - thelatemail

Answer 2

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

有多种方法可以做到这一点。我使用了match，因为它会找到指定值的第一个实例。代码的其他部分是用于演示的。首先使用apply逐行进行处理，并使用names将年份命名为列名。赋值符<-和df$FirstYear是向数据框添加结果的一种方式。

鸣谢@David Arenburg提出的在FirstYear列中用in代替20的很棒的想法。

- Pierre L

---

我认为那也是一个聪明的技巧。@akrun会感到自豪。 - rawr

Answer 3

另一个答案提供了一些效率的注意事项（虽然这个QA不是关于速度的）。首先，最好避免将“列表”结构转换为“矩阵”，有时将其转换为“矩阵”并使用能够有效处理带有“dim”属性的向量（即“矩阵”/“数组”）的函数更加值得——有时则不是。Both max.col和apply都会转换为“矩阵”。其次，在这种情况下，我们不需要在获取解决方案时检查所有数据，可以从控制通过到达下一次迭代的循环中受益。在这里，我们知道当找到第一个“1”时可以停止。Both max.col（和which.max）必须循环一次才能找到最大值；我们知道“max == 1”的事实没有被利用。第三，当我们在另一个值向量中寻找一个值时，match可能会更慢，因为match的设置相当复杂且成本高昂：

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

总的来说，处理“data.frame”的“list”结构并在找到“1”时停止计算的方法可以采用以下循环方式：

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)
}

其他答案中的解决方案（忽略输出的额外步骤）：

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

以下是一些基准测试结果：

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 

虽然不是真正的末日，但这个例子值得一看。简单、直接的算法方法确实可以证明在不同的问题上同样好甚至更好。当然，在大多数情况下，使用R循环可能会很费力。

- alexis_laz

---

非常好，一如既往。很久以前我在列表上编写了非常高效的循环，我的代码运行非常快，但是 Stack Overflow 的“反循环”哲学毁了我 :) - David Arenburg

循环是一种生活方式——你可以隐藏它、将其“向量化”，但无法避免它.. :-) - alexis_laz

不错的答案；你可能会对我回答中的评论感兴趣。 - BrodieG

Answer 4

您可以在dplyr::mutate()中使用dplyr::case_when，沿用这条推文中介绍的方法。

# 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
)))

- seasmith

Answer 5

这里还有另一种选择：

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

生成：

  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

它速度快。这里只计时使用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

奇怪的是，这并不能重现Alexis的时间，而显示David的时间最快。这是在R 3.1.2上的情况。

---

编辑：根据与Frank的交谈，我更新了Alexis函数以更兼容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)
}

这更接近原始结果：

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

- BrodieG

---

有趣。可能是R版本的问题。当我在R 3.2.0上运行microbenchmark(do.call(pmin.int, Map(\/`, 11:20, DF[-1])),ff(DF[-1]),max.col(DF[-1], "first"),times=10)`，使用Alexis的示例数据时，我得到了Alexis 150，Brodie 275，David 430（对于平均值或中位数）。 - Frank

@Frank 嗯，我想我会在升级时再检查这个增益，不过真正令人费解的是 max.col 变得更慢了。 - BrodieG

@Frank，我有一个关于为什么Alexis更快的理论。我认为R 3.2.0在处理x[logical]和x[which(logical)]时更加智能。后者传统上更快。在我的系统上，x <- logical(1e5); x[sample(1e5, 1e4)] <- TRUE; microbenchmark(x[which(x)], x[x])使用which版本比使用x版本快8倍。你能在你的系统上运行一下吗？ - BrodieG

是的，在我的电脑上我有多个版本的R。3.2.0 - which函数快2倍；3.0.1 - 速度快3-4倍。 - Frank

在R-3.2.0上，我得到了ff: 100 ms | ff2: 65 ms；在R-3.1.2上，ff: 230 ms | ff2: 75ms。我无法获得ff的初始65毫秒。对于x[logical]与x[which(logical)]，x[which(x)]在R的两个版本中都是3毫秒，但是x[x]在R-3.2.0上为5毫秒，在R-3.1.2上为12毫秒。查看R-3.1.2的logicalSubscript与R-3.2.0的logicalSubscript，似乎R-3.2.0避免了在从逻辑索引返回整数索引时过度使用“%”。 - alexis_laz

Answer 6

我总是更喜欢使用整理过的数据。第一种方法是基于累加和进行过滤。

# 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)

或者这个替代方案，整理后从排列好的组中切割出第一行。

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)`

- Nettle

Answer 7

其他混乱的选择：

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]

Output:

  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

A cleaner solution combining plaforts solution with alexises_laz is:

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

If we'd like to keep the original column names we could use the renaming provided by @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

- mpalanco