R 中嵌套 ifelse 语句的替代方案
Posted
技术标签:
【中文标题】R 中嵌套 ifelse 语句的替代方案【英文标题】:Alternatives to nested ifelse statements in R 【发布时间】:2015-08-10 06:01:00 【问题描述】:假设我们有以下数据。行代表一个国家,列 (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
变量?
【问题讨论】:
【参考方案1】: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
。
【讨论】:
我认为这也是一个聪明的把戏。@akrun 会很自豪【参考方案2】:您可以使用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
【讨论】:
好老max.col
- 总是来救援。虽然它默认使用"random"
来处理领带确实很烦人,但考虑到which.max
/ which.min
等总是采用他们遇到的第一个结果。【参考方案3】:
另一个关于效率的答案(尽管此 QA 与速度无关)。
首先,最好避免将“列表”-y 结构转换为“矩阵”;有时值得转换为“矩阵”并使用有效处理“具有“暗淡”属性的向量(即“矩阵”/“数组”)的函数 - 其他时候则不然。 max.col
和 apply
都转换为“矩阵”。
其次,在这样的情况下,我们不需要在获得解决方案时检查所有数据,我们可以从具有控制下一次迭代的循环的解决方案中受益。在这里,我们知道当我们找到第一个“1”时我们可以停止。 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”的“列表”结构并在找到“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 中循环可能很费力。
【讨论】:
太棒了。一如既往......很久以前我在列表上编写非常有效的循环并且我的代码非常快,但是“反循环”哲学毁了我:) @DavidArenburg : 循环是一种生活方式——你可以隐藏它,“矢量化”它,但你无法避免它.. :-) 不错的答案;您可能对我的回答中的评论感兴趣。【参考方案4】:其他乱七八糟的选择:
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]
输出:
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
将 plaforts 解决方案与 alexises_laz 相结合的更清洁的解决方案是:
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
如果我们想保留原始列名,我们可以使用@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
【讨论】:
【参考方案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 的 convo,我更新了 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
【讨论】:
有趣。也许是 R 版本的东西。当我使用 Alexis 的示例数据在 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 150、Brodie 275、David 430(平均值或中位数)。
@Frank 嗯,我想我会在升级时检查这个增益,虽然真正令人费解的是max.col
变得更慢。
@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
版本快 8 倍。你能在你的上运行它吗?
是的,我有多个版本的 R. 3.2.0 -- which
的两倍快; 3.0.1 -- 3-4x
在 R-3.2.0 上,我得到 ff: 100 ms | ff2: 65 ms
;在 R-3.1.2 上,ff: 230 ms | ff2: 75ms
。我无法获得 ff 的初始 65 毫秒。对于x[logical]
VS x[which(logical)]
,x[which(x)]
在 R 的两个版本上都是 3 毫秒,但 x[x]
在 R-3.2.0 上是 5 毫秒,而在 R-3.1.2 上是 12 毫秒。看看R-3.1.2's logicalSubscript
VS R-3.2.0's logicalSubscript
,R-3.2.0 似乎避免了在从逻辑索引返回整数索引时扩展使用“%”(随后将被使用)。【参考方案6】:
我总是更喜欢使用经过整理的数据。第一种方法过滤 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)
或者这种替代方法,在整理之后,从排列好的组中分割出第一行。
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)`
【讨论】:
【参考方案7】:您可以按照this tweet 中介绍的方法在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
)))
【讨论】:
以上是关于R 中嵌套 ifelse 语句的替代方案的主要内容,如果未能解决你的问题,请参考以下文章
java,多层for()循环,if()else嵌套分别用啥替代?