另一个 "how to deal with NAs in logical statements" 个问题

Another "how to deal with NAs in logical statements" question

简短版本: 我需要得到这样的结果列 r,理想情况下使用 dplyr(但也对 base R 感到满意):

d <- tibble(c1 = c(T,T,F,T,F,NA), c2 = c(T,F,F,F,F,NA), c3 = c(T,F,F,NA,NA,NA))
d %>% rowwise() %>% mutate(r = something())
# A tibble: 6 x 3
  c1    c2    c3    r
  <lgl> <lgl> <lgl> <lgl>
1 TRUE  TRUE  TRUE  TRUE
2 TRUE  FALSE FALSE TRUE
3 FALSE FALSE FALSE FALSE
4 TRUE  FALSE NA    TRUE
5 FALSE FALSE NA    FALSE
6 NA    NA    NA    NA

我明白为什么NA|FALSE == NA。 table中的每个TRUE/FALSE都是比较的结果,我真的希望语法尽可能短。

长版: 我有调查结果,需要创建一个包含三个问题的摘要,要求小学、中学和大学 'route to something'(现实中有 3 个以上的级别)。摘要应该告诉我,对于每个受访者,他们是否使用了路线 A、路线 B ​​等。并非所有受访者都填写了所有问题,因此可能会有 NA。一些受访者根本没有回答任何问题,他们的总结应该是NA。所以我有:

df <- tibble(primary   = c("C", "A", "B", "D", NA),
             secondary = c("B", "D", "C", NA,  NA),
             tertiary  = c("A", "E", NA,  NA,  NA))

# I think I need something along these lines:
df <- df %>% rowwise() %>%
  mutate(
    routeA = (primary == "A") | (secondary == "A") | (tertiary == "A") ...
    routeB = ....
  )
# Result expected
df
# A tibble:
primary secondary tertiary routeA routeB ...
<chr>   <chr>     <chr>    <lgl>  <lgl>
C       B         A        TRUE   TRUE
A       D         E        TRUE   FALSE
B       C         NA       FALSE  TRUE
D       NA        NA       FALSE  FALSE
NA      NA        NA       NA     NA

次优:

my_match <- function(x, val) {
   if (all(is.na(x))) return(NA)
   return(any(na.omit(x) == val))
}

df %>% rowwise() %>% mutate(rA = my_match(c_across(where(is.character)), "A"),
                            rB = my_match(c_across(where(is.character)), "B"))

待改进:

  • 这不会很好地扩展到更多的路线
  • 太多重复的代码(另一种表达同一件事的方式)——但我不太确定如何创建这个的 function/shortcut 版本(可以在可能的网站上循环添加一列时间,但我现在不想在 rlang/tidy-evaluation/NSE 兔子洞里走得太远...)

您可以使用来自基础 R:

applymatch 相对有效地完成此操作
f <- function(x, levels) {
    if (all(is.na(x))) {
        rep.int(NA, length(levels))
    } else {
        as.logical(match(levels, x, 0L))
    }
}

lv <- LETTERS[1:5]
df[paste0("route", lv)] <- t(apply(df, 1L, f, levels = lv))
df
## # A tibble: 5 × 8
##   primary secondary tertiary routeA routeB routeC routeD routeE
##   <chr>   <chr>     <chr>    <lgl>  <lgl>  <lgl>  <lgl>  <lgl> 
## 1 C       B         A        TRUE   TRUE   TRUE   FALSE  FALSE 
## 2 A       D         E        TRUE   FALSE  FALSE  TRUE   TRUE  
## 3 B       C         NA       FALSE  TRUE   TRUE   FALSE  FALSE 
## 4 D       NA        NA       FALSE  FALSE  FALSE  TRUE   FALSE 
## 5 NA      NA        NA       NA     NA     NA     NA     NA

我说“相对”是因为对数据帧的行向操作往往比对矩阵的行向操作效率低,需要对矩阵进行强制转换或对长格式进行整形。

这种情况也不例外,因为applydf从数据帧强制转换为矩阵,而赋值将t的结果从矩阵强制转换为数据帧。

如评论中所述,将数据重新整形为长格式然后再恢复为宽格式时,这很简单。

library(tidyr)
library(dplyr)
library(tibble)

df <- df %>%
  rowid_to_column() 

df %>%
  pivot_longer(-rowid) %>%
  filter(!is.na(value)) %>%
  pivot_wider(id_cols = rowid, names_from = value, values_fill = FALSE, values_fn = ~ TRUE, names_sort = TRUE) %>%
  left_join(df, ., by  = "rowid")

# A tibble: 5 x 9
  rowid primary secondary tertiary A     B     C     D     E    
  <int> <chr>   <chr>     <chr>    <lgl> <lgl> <lgl> <lgl> <lgl>
1     1 C       B         A        TRUE  TRUE  TRUE  FALSE FALSE
2     2 A       D         E        TRUE  FALSE FALSE TRUE  TRUE 
3     3 B       C         NA       FALSE TRUE  TRUE  FALSE FALSE
4     4 D       NA        NA       FALSE FALSE FALSE TRUE  FALSE
5     5 NA      NA        NA       NA    NA    NA    NA    NA   

另一个想法是:

ans = unclass(table(row(df), unlist(df)))
ans
   
#    A B C D E
#  1 1 1 1 0 0
#  2 1 0 0 1 1
#  3 0 1 1 0 0
#  4 0 0 0 1 0
#  5 0 0 0 0 0

也可以在适当的地方填充缺失值:

ans[!rowSums(ans)] = NA
ans