Question

我最初在this questions的帮助下解决了我的NA问题。但是，我想简化我的代码。在过去，我很享受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＆＃39; 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，但我必须重复三次对数据的引用。我可以用一些方便的方式简化这个吗？我使用dplyr制作了以下代码，但也许有更好的总结行的方法;同时保留NA包含所有NA的行，同时忽略具有一个或多个值的行中的NA，并将值0处理为＆＃39;汇总＆＃ 39;

# 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则生成na.rm = F}。

更新截至16 22：18：33Z

我对这个有点精心设计的 micro -benchmark比较了不同的答案。请不要急于优化任何功能。写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)

Answer 1

这是使用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值的行在第二项中返回1。否则，返回NA。

这假设您只想考虑第一个变量以外的变量。

将OP对上述代码所做的改进与附加步骤相结合，我们可以通过

提高效率

rowSumsNA <- function(dat, ...) {
    W <- data.matrix(dat[...])
    rowSums(W, na.rm=TRUE) * (NA^(rowSums(is.na(W)) == ncol(W)))
}

大多数改进都在OP的计算之前存储子集data.frame的方法（在我的机器上为127ms vs 84ms），但是通过将data.frame转换为矩阵优先级可以获得轻微的额外改进。调用rowSums（84ms vs 77ms在我的机器上）。

Answer 2

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内部以保留foo列。添加了其他解决方案。

Answer 3

这是一个简单的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)
  )

Answer 4

不像其他解决方案那样优雅，但它避免了必须从数据框中删除变量然后重新加入。如果您有兴趣保持数据框完整，那么这很好。如果要包含很多变量，它将失去它的优势。

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

Answer 5

交替地，使用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 fucntion调用

使用dplyr（或其他）到rowSums简化R代码而忽略NA，unlss all为NA

更新截至16 22：18：33Z

5 个答案: