使用 dplyr（或其他）将 R 代码简化为 rowSums，同时忽略 NA，除非全部为 NA
simplifying R code using dplyr (or other) to rowSums while ignoring NA, unlss all is NA
我最初解决了我的 NA 问题，this questions. However, I would like to simplify my code. In the past, I've enjoyed the way dplyr 帮助我简化了 R 代码。
下面是一个最小的工作示例，说明了我当前的解决方案以及我使用 dplyr 所处的位置。
我有这样的数据，
dta <- data.frame(foo=c(1,NA,3,4), fooZ=c(4,NA,5,NA), fooQ2=c(7,0,9,NA))
我需要总结很多行，使用 0 作为 我 sum 的值 并保持 NA' s 表示所有 NA 的行。像这样，
dta$sum1 <- rowSums(dta[, c('fooZ', 'fooQ2') ], na.rm=TRUE) * ifelse(
rowSums(is.na(dta[, c('fooZ', 'fooQ2') ])) ==
ncol(dta[, c('fooZ', 'fooQ2') ]), NA, 1)
dta
# > foo fooZ fooQ2 sum1
# > 1 1 4 7 11
# > 2 NA NA 0 0
# > 3 3 5 9 14
# > 4 4 NA NA NA
这确实有效并创建了 sum1，但我必须重复引用数据 3 次。我可以用一些方便的方式简化它吗？我使用 dplyr 编写了以下代码，但也许有更好的汇总行的方法；同时为具有所有 NA 的行保留 NA，忽略具有一个或多个值的行中的 NA，并将 0 值视为 'summarized'?
# install.packages(c("dplyr", "ggplot2"), dependencies = TRUE)
require(dplyr)
dta$sum2 = dta %>% select(fooZ, fooQ2) %>% rowSums(., na.rm = TRUE)
dta
# > foo fooZ fooQ2 sum1 sum2
# > 1 1 4 7 11 11
# > 2 NA NA 0 0 0
# > 3 3 5 9 14 14
# > 4 4 NA NA NA 0
这将创建 sum2，但如果 na.rm = TRUE 则生成 0，如果 na.rm = F 则生成太多 NA。
16 日更新22:18:33Z
我做了这个比较详细的 micro-不同答案的基准比较。请不要急于优化任何功能。编写 R 函数不是我的强项。不管怎样，
set.seed(667)
n <- 1e5+22
dta <- data.frame(
foo = sample(c(1:10, NA), n, replace = TRUE),
fooZ = sample(c(1:10, NA), n, replace = TRUE),
fooQ2 = sample(c(1:10, NA), n, replace = TRUE))
slice <- c(902:907,979:984)
dta[slice,]
#> foo fooZ fooQ2
#> 902 10 7 2
#> 903 10 10 9
#> 904 NA NA 8
#> 905 6 4 3
#> 906 8 9 10
#> 907 1 5 NA
#> 979 NA 1 1
#> 980 10 2 NA
#> 981 7 NA NA
#> 982 3 7 7
#> 983 NA 9 6
#> 984 7 10 7
# `baseline' solution
baseline <- function(z, ...) {W <- z[, c(...)]; W <- rowSums(W, na.rm=TRUE) * ifelse(rowSums(is.na(W)) == ncol(W), NA, 1); W}
# install.packages(c("dplyr", "ggplot2"), dependencies = TRUE)
require(dplyr)
# G. G.Gro's dplyr solution
G.Gro_dplyr1 <- function(z, ...) z %>% mutate(sum2 = select(., ...) %>% { rowSums(., na.rm = TRUE) + ifelse(apply(is.na(.), 1, all), NA, 0) })
# G. G.Gro's Variation 1a solution
G.Gro_dplyr1a <- function(z, ...) z %>% mutate(sum2 = select(., fooZ, fooQ2) %>% apply(1, . %>% { sum(., na.rm = TRUE) + if (all(is.na(.))) NA else 0}))
# G. G.Gro's base solution
G.Gro_base <- function(z, ...) {W <- z[, c(...)]; S = {X <- dta[, c("fooZ", "fooQ2")]; rowSums(X, na.rm = TRUE) + ifelse(apply(is.na(X), 1, all), NA, 0)}; S}
# Thierry's solution
Thierry_my_sum <- function(z, ...){z <- select(z, ...); sums <- rowSums(z, na.rm = TRUE); sums[apply(is.na(z), 1, all)] <- NA; sums}
# lmo's solution
lmo <- function(z, ...) {W <- z[, c(...)]; rowSums(W, na.rm=TRUE) * (NA^(rowSums(is.na(W)) == ncol(W)))}
# Benjamin's solution
Benjamin <- function(..., na.rm = FALSE, all.na = NA){v <- list(...); all_na <- lapply(v, is.na); all_na <- Reduce(`&`, all_na); all_na; if (na.rm){v <- lapply(v, function(x) {x[is.na(x)] <- 0; x}); }; v <- Reduce(`+`, v); v[all_na] <- all.na; v;}
# Aramis7d's solution
Aramis7d <- function(z, ...) {z %>% select(...) %>% mutate(sum = rowSums(., na.rm=TRUE)) %>% mutate(s2 = rowSums(is.na(.))) %>% mutate(sum = if_else(s2 < 2, sum, as.double(NA))) %>% select(sum) }
# Fail's solution combining from all
Fail <- function(z, ...){z <- select(z, ...); zTF <- rowMeans(is.na(z)) == 1; replace(rowSums(z, na.rm = TRUE), zTF, NA)}
# install.packages("microbenchmark", dependencies = TRUE)
require(microbenchmark)
# run test
res <- microbenchmark(
baseline(dta, c("fooZ", "fooQ2")),
Thierry_my_sum(dta, fooZ, fooQ2),
G.Gro_dplyr1(dta, fooZ, fooQ2)[,ncol(dta)+1],
G.Gro_dplyr1a(dta, fooZ, fooQ2)[, ncol(dta) + 1],
G.Gro_base(dta, c("fooZ", "fooQ2")),
(dta %>% mutate(sum99 = Benjamin(fooZ, fooQ2, na.rm = TRUE)))[,ncol(dta)+1],
lmo(dta, c("fooZ", "fooQ2")),
Aramis7d(dta, fooZ, fooQ2)[,1],
Fail(dta, fooZ, fooQ2),
times = 25)
# clean up
levels(res[[1]]) <- c('baseline', 'Thierry', 'G.Gro1', 'G.Gro1a', 'G.Gro2', 'Benjamin', 'lmo', 'Aramis7d', 'Fail')
## Print results:
print(res)
print(res)
#> Unit: milliseconds
#> expr min lq mean median uq max neval cld
#> baseline 12.729803 15.691060 31.141114 23.299101 48.694436 72.83702 25 a
#> Thierry 215.541035 241.795764 298.319826 263.822553 363.066476 494.90875 25 b
#> G.Gro1 226.761181 242.617099 295.413437 264.911513 307.339115 591.28424 25 b
#> G.Gro1a 935.176542 985.329298 1088.300741 997.788858 1030.085839 1736.51506 25 c
#> G.Gro2 219.650080 227.464694 292.898566 246.188189 320.789036 505.08154 25 b
#> Benjamin 6.227054 9.327364 15.583907 11.230079 14.345366 55.44653 25 a
#> lmo 4.138434 5.970850 9.329506 6.851132 8.406799 39.40295 25 a
#> Aramis7d 33.966101 38.737671 60.777304 66.663967 72.686939 100.72799 25 a
#> Fail 11.464254 13.932386 20.476011 14.865245 25.156740 58.37730 25 a
### Plot results:
boxplot(res)
这是使用 NA 求幂的基础 R 技巧：
rowSums(dta[-1], na.rm=TRUE) * (NA^(rowSums(is.na(dta[-1])) == ncol(dta[-1])))
[1] 11 8 14 NA
任何数字的 0 次方都是 1，因此任何包含非 NA 值的行 return 在第二项中都是 1。否则，NA 是 returned.
这假设您只想考虑第一个变量以外的变量。
将 OP 对上述代码所做的改进与一个额外的步骤相结合，我们可以通过
提高效率
rowSumsNA <- function(dat, ...) {
W <- data.matrix(dat[...])
rowSums(W, na.rm=TRUE) * (NA^(rowSums(is.na(W)) == ncol(W)))
}
大部分改进都在 OP 在计算之前存储子集 data.frame 的方法（在我的机器上是 127 毫秒对 84 毫秒），但是通过转换 data.frame 在调用 rowSums 之前转换为矩阵（在我的机器上是 84 毫秒对 77 毫秒）。
1) dplyr 这会计算行总和，然后根据整行是否为 NA 添加 NA 或 0。
dta %>%
mutate(sum2 = select(., fooZ, fooQ2) %>%
{ rowSums(., na.rm = TRUE) + ifelse(apply(is.na(.), 1, all), NA, 0) })
给予：
foo fooZ fooQ2 sum2
1 1 4 7 11
2 NA NA 8 8
3 3 5 9 14
4 4 NA NA NA
1a) 变体 (1) 的变体是：
dta %>%
mutate(sum2 = select(., fooZ, fooQ2) %>%
apply(1, . %>% { sum(., na.rm = TRUE) + if (all(is.na(.))) NA else 0}))
2) base 不使用包我们可以做到这一点：
transform(dta, sum2 = {
X <- data.frame(fooZ, fooQ2)
rowSums(X, na.rm = TRUE) + ifelse(apply(is.na(X), 1, all), NA, 0)
})
3) data.table
library(data.table)
DT <- as.data.table(dta)
DT[, sum2 := rowSums(.SD, na.rm = TRUE) + ifelse(apply(is.na(.SD), 1, all), NA, 0) , .SDcols = c("fooZ", "fooQ2")]
更新： 在 mutate 中移动 select 以保留 foo 列。添加了其他解决方案。
或者，使用 dplyr，您可以尝试类似的方法：
dta %>%
select(-foo) %>%
mutate(sum1 = rowSums(., na.rm=TRUE)) %>%
mutate(s2 = rowSums(is.na(.))) %>%
mutate(sum1 = if_else(s2 < 2, sum1, as.double(NA))) %>%
bind_cols(dta) %>%
select(foo, fooZ, fooQ2, sum1)
给出：
foo fooZ fooQ2 sum1
1 1 4 7 11
2 NA NA 8 8
3 3 5 9 14
4 4 NA NA NA
如果您真的不关心保留列 foo ，您可以去掉 col_bind 函数调用
不像其他解决方案那样优雅，但它避免了必须从数据框中删除变量然后重新加入。因此，如果您有兴趣保持数据框完好无损，这很好。如果你有很多变量要包含，它就会失去它的优势。
dta %>%
mutate(all_na = Reduce(`&`, lapply(list(fooZ, fooQ2), is.na)),
sum1 = Reduce(`+`, lapply(list(fooZ, fooQ2), function(x) {x[is.na(x)] <- 0; x})),
sum1 = ifelse(all_na, NA, sum1)) %>%
select(-all_na)
或者，您可以将其捆绑到一个函数中：
rsum <- function(..., na.rm = FALSE, all.na = NA){
v <- list(...)
all_na <- lapply(v, is.na)
all_na <- Reduce(`&`, all_na)
all_na
if (na.rm){
v <- lapply(v, function(x) {x[is.na(x)] <- 0; x})
}
v <- Reduce(`+`, v)
v[all_na] <- all.na
v
}
dta %>%
mutate(sum1 = rsum(fooZ, fooQ2, na.rm = TRUE))
这是一个简单的 dplyr 解决方案
library(dplyr)
dta <- data.frame(foo=c(1,NA,3,4), fooZ=c(4,NA,5,NA), fooQ2=c(7,0,9,NA))
my_sum <- function(z, ...){
z <- select(z, ...)
sums <- rowSums(z, na.rm = TRUE)
sums[apply(is.na(z), 1, all)] <- NA
sums
}
dta %>%
mutate(
sum1 = my_sum(., fooZ, fooQ2),
sum2 = my_sum(., foo, fooQ2),
sum3 = my_sum(., foo, fooZ)
)
我最初解决了我的 NA 问题，this questions. However, I would like to simplify my code. In the past, I've enjoyed the way dplyr 帮助我简化了 R 代码。
下面是一个最小的工作示例，说明了我当前的解决方案以及我使用 dplyr 所处的位置。
我有这样的数据，
dta <- data.frame(foo=c(1,NA,3,4), fooZ=c(4,NA,5,NA), fooQ2=c(7,0,9,NA))
我需要总结很多行，使用 0 作为 我 sum 的值 并保持 NA' s 表示所有 NA 的行。像这样，
dta$sum1 <- rowSums(dta[, c('fooZ', 'fooQ2') ], na.rm=TRUE) * ifelse(
rowSums(is.na(dta[, c('fooZ', 'fooQ2') ])) ==
ncol(dta[, c('fooZ', 'fooQ2') ]), NA, 1)
dta
# > foo fooZ fooQ2 sum1
# > 1 1 4 7 11
# > 2 NA NA 0 0
# > 3 3 5 9 14
# > 4 4 NA NA NA
这确实有效并创建了 sum1，但我必须重复引用数据 3 次。我可以用一些方便的方式简化它吗？我使用 dplyr 编写了以下代码，但也许有更好的汇总行的方法；同时为具有所有 NA 的行保留 NA，忽略具有一个或多个值的行中的 NA，并将 0 值视为 'summarized'?
# install.packages(c("dplyr", "ggplot2"), dependencies = TRUE)
require(dplyr)
dta$sum2 = dta %>% select(fooZ, fooQ2) %>% rowSums(., na.rm = TRUE)
dta
# > foo fooZ fooQ2 sum1 sum2
# > 1 1 4 7 11 11
# > 2 NA NA 0 0 0
# > 3 3 5 9 14 14
# > 4 4 NA NA NA 0
这将创建 sum2，但如果 na.rm = TRUE 则生成 0，如果 na.rm = F 则生成太多 NA。
16 日更新22:18:33Z
我做了这个比较详细的 micro-不同答案的基准比较。请不要急于优化任何功能。编写 R 函数不是我的强项。不管怎样，
set.seed(667)
n <- 1e5+22
dta <- data.frame(
foo = sample(c(1:10, NA), n, replace = TRUE),
fooZ = sample(c(1:10, NA), n, replace = TRUE),
fooQ2 = sample(c(1:10, NA), n, replace = TRUE))
slice <- c(902:907,979:984)
dta[slice,]
#> foo fooZ fooQ2
#> 902 10 7 2
#> 903 10 10 9
#> 904 NA NA 8
#> 905 6 4 3
#> 906 8 9 10
#> 907 1 5 NA
#> 979 NA 1 1
#> 980 10 2 NA
#> 981 7 NA NA
#> 982 3 7 7
#> 983 NA 9 6
#> 984 7 10 7
# `baseline' solution
baseline <- function(z, ...) {W <- z[, c(...)]; W <- rowSums(W, na.rm=TRUE) * ifelse(rowSums(is.na(W)) == ncol(W), NA, 1); W}
# install.packages(c("dplyr", "ggplot2"), dependencies = TRUE)
require(dplyr)
# G. G.Gro's dplyr solution
G.Gro_dplyr1 <- function(z, ...) z %>% mutate(sum2 = select(., ...) %>% { rowSums(., na.rm = TRUE) + ifelse(apply(is.na(.), 1, all), NA, 0) })
# G. G.Gro's Variation 1a solution
G.Gro_dplyr1a <- function(z, ...) z %>% mutate(sum2 = select(., fooZ, fooQ2) %>% apply(1, . %>% { sum(., na.rm = TRUE) + if (all(is.na(.))) NA else 0}))
# G. G.Gro's base solution
G.Gro_base <- function(z, ...) {W <- z[, c(...)]; S = {X <- dta[, c("fooZ", "fooQ2")]; rowSums(X, na.rm = TRUE) + ifelse(apply(is.na(X), 1, all), NA, 0)}; S}
# Thierry's solution
Thierry_my_sum <- function(z, ...){z <- select(z, ...); sums <- rowSums(z, na.rm = TRUE); sums[apply(is.na(z), 1, all)] <- NA; sums}
# lmo's solution
lmo <- function(z, ...) {W <- z[, c(...)]; rowSums(W, na.rm=TRUE) * (NA^(rowSums(is.na(W)) == ncol(W)))}
# Benjamin's solution
Benjamin <- function(..., na.rm = FALSE, all.na = NA){v <- list(...); all_na <- lapply(v, is.na); all_na <- Reduce(`&`, all_na); all_na; if (na.rm){v <- lapply(v, function(x) {x[is.na(x)] <- 0; x}); }; v <- Reduce(`+`, v); v[all_na] <- all.na; v;}
# Aramis7d's solution
Aramis7d <- function(z, ...) {z %>% select(...) %>% mutate(sum = rowSums(., na.rm=TRUE)) %>% mutate(s2 = rowSums(is.na(.))) %>% mutate(sum = if_else(s2 < 2, sum, as.double(NA))) %>% select(sum) }
# Fail's solution combining from all
Fail <- function(z, ...){z <- select(z, ...); zTF <- rowMeans(is.na(z)) == 1; replace(rowSums(z, na.rm = TRUE), zTF, NA)}
# install.packages("microbenchmark", dependencies = TRUE)
require(microbenchmark)
# run test
res <- microbenchmark(
baseline(dta, c("fooZ", "fooQ2")),
Thierry_my_sum(dta, fooZ, fooQ2),
G.Gro_dplyr1(dta, fooZ, fooQ2)[,ncol(dta)+1],
G.Gro_dplyr1a(dta, fooZ, fooQ2)[, ncol(dta) + 1],
G.Gro_base(dta, c("fooZ", "fooQ2")),
(dta %>% mutate(sum99 = Benjamin(fooZ, fooQ2, na.rm = TRUE)))[,ncol(dta)+1],
lmo(dta, c("fooZ", "fooQ2")),
Aramis7d(dta, fooZ, fooQ2)[,1],
Fail(dta, fooZ, fooQ2),
times = 25)
# clean up
levels(res[[1]]) <- c('baseline', 'Thierry', 'G.Gro1', 'G.Gro1a', 'G.Gro2', 'Benjamin', 'lmo', 'Aramis7d', 'Fail')
## Print results:
print(res)
print(res)
#> Unit: milliseconds
#> expr min lq mean median uq max neval cld
#> baseline 12.729803 15.691060 31.141114 23.299101 48.694436 72.83702 25 a
#> Thierry 215.541035 241.795764 298.319826 263.822553 363.066476 494.90875 25 b
#> G.Gro1 226.761181 242.617099 295.413437 264.911513 307.339115 591.28424 25 b
#> G.Gro1a 935.176542 985.329298 1088.300741 997.788858 1030.085839 1736.51506 25 c
#> G.Gro2 219.650080 227.464694 292.898566 246.188189 320.789036 505.08154 25 b
#> Benjamin 6.227054 9.327364 15.583907 11.230079 14.345366 55.44653 25 a
#> lmo 4.138434 5.970850 9.329506 6.851132 8.406799 39.40295 25 a
#> Aramis7d 33.966101 38.737671 60.777304 66.663967 72.686939 100.72799 25 a
#> Fail 11.464254 13.932386 20.476011 14.865245 25.156740 58.37730 25 a
### Plot results:
boxplot(res)
这是使用 NA 求幂的基础 R 技巧：
rowSums(dta[-1], na.rm=TRUE) * (NA^(rowSums(is.na(dta[-1])) == ncol(dta[-1])))
[1] 11 8 14 NA
任何数字的 0 次方都是 1，因此任何包含非 NA 值的行 return 在第二项中都是 1。否则，NA 是 returned.
这假设您只想考虑第一个变量以外的变量。
将 OP 对上述代码所做的改进与一个额外的步骤相结合，我们可以通过
提高效率rowSumsNA <- function(dat, ...) {
W <- data.matrix(dat[...])
rowSums(W, na.rm=TRUE) * (NA^(rowSums(is.na(W)) == ncol(W)))
}
大部分改进都在 OP 在计算之前存储子集 data.frame 的方法（在我的机器上是 127 毫秒对 84 毫秒），但是通过转换 data.frame 在调用 rowSums 之前转换为矩阵（在我的机器上是 84 毫秒对 77 毫秒）。
1) dplyr 这会计算行总和，然后根据整行是否为 NA 添加 NA 或 0。
dta %>%
mutate(sum2 = select(., fooZ, fooQ2) %>%
{ rowSums(., na.rm = TRUE) + ifelse(apply(is.na(.), 1, all), NA, 0) })
给予：
foo fooZ fooQ2 sum2
1 1 4 7 11
2 NA NA 8 8
3 3 5 9 14
4 4 NA NA NA
1a) 变体 (1) 的变体是：
dta %>%
mutate(sum2 = select(., fooZ, fooQ2) %>%
apply(1, . %>% { sum(., na.rm = TRUE) + if (all(is.na(.))) NA else 0}))
2) base 不使用包我们可以做到这一点：
transform(dta, sum2 = {
X <- data.frame(fooZ, fooQ2)
rowSums(X, na.rm = TRUE) + ifelse(apply(is.na(X), 1, all), NA, 0)
})
3) data.table
library(data.table)
DT <- as.data.table(dta)
DT[, sum2 := rowSums(.SD, na.rm = TRUE) + ifelse(apply(is.na(.SD), 1, all), NA, 0) , .SDcols = c("fooZ", "fooQ2")]
更新： 在 mutate 中移动 select 以保留 foo 列。添加了其他解决方案。
或者，使用 dplyr，您可以尝试类似的方法：
dta %>%
select(-foo) %>%
mutate(sum1 = rowSums(., na.rm=TRUE)) %>%
mutate(s2 = rowSums(is.na(.))) %>%
mutate(sum1 = if_else(s2 < 2, sum1, as.double(NA))) %>%
bind_cols(dta) %>%
select(foo, fooZ, fooQ2, sum1)
给出：
foo fooZ fooQ2 sum1
1 1 4 7 11
2 NA NA 8 8
3 3 5 9 14
4 4 NA NA NA
如果您真的不关心保留列 foo ，您可以去掉 col_bind 函数调用
不像其他解决方案那样优雅，但它避免了必须从数据框中删除变量然后重新加入。因此，如果您有兴趣保持数据框完好无损，这很好。如果你有很多变量要包含，它就会失去它的优势。
dta %>%
mutate(all_na = Reduce(`&`, lapply(list(fooZ, fooQ2), is.na)),
sum1 = Reduce(`+`, lapply(list(fooZ, fooQ2), function(x) {x[is.na(x)] <- 0; x})),
sum1 = ifelse(all_na, NA, sum1)) %>%
select(-all_na)
或者，您可以将其捆绑到一个函数中：
rsum <- function(..., na.rm = FALSE, all.na = NA){
v <- list(...)
all_na <- lapply(v, is.na)
all_na <- Reduce(`&`, all_na)
all_na
if (na.rm){
v <- lapply(v, function(x) {x[is.na(x)] <- 0; x})
}
v <- Reduce(`+`, v)
v[all_na] <- all.na
v
}
dta %>%
mutate(sum1 = rsum(fooZ, fooQ2, na.rm = TRUE))
这是一个简单的 dplyr 解决方案
library(dplyr)
dta <- data.frame(foo=c(1,NA,3,4), fooZ=c(4,NA,5,NA), fooQ2=c(7,0,9,NA))
my_sum <- function(z, ...){
z <- select(z, ...)
sums <- rowSums(z, na.rm = TRUE)
sums[apply(is.na(z), 1, all)] <- NA
sums
}
dta %>%
mutate(
sum1 = my_sum(., fooZ, fooQ2),
sum2 = my_sum(., foo, fooQ2),
sum3 = my_sum(., foo, fooZ)
)