仅当列存在时才适用于数据框列表

Posted 2023-03-14

【中文标题】仅当列存在时才适用于数据框列表

【英文标题】：Lapply to a list of dataframes only if column exists

【发布时间】：2019-09-16 18:48:36

【问题描述】：

我有一个数据帧列表，我想（在单独的数据帧中）获取指定列的行平均值，该列可能存在或不存在于列表的所有数据帧中。当列表的至少一个数据框中不存在指定的列时，我的问题就出现了。

假设以下数据框示例列表：

df1 <- read.table(text = 'X   A   B   C
                       name1  1   2   3
                       name2  5  10   4',
                 header = TRUE)  

df2 <- read.table(text = 'X   B   C   A
                       name1  8   1  31
                       name2  9   9   8', 
                 header = TRUE)

df3 <- read.table(text = 'X   B   A   E
                       name1  9   9  29
                       name2  5  15  55', 
                 header = TRUE)

mylist_old <-list(df1, df2)
mylist_new <-list(df1, df2, df3)

假设我想 rowMeans 列 C 当数据框列表 (mylist_old) 由元素 df1 和 df2 组成时，以下代码可以完美运行：

Mean_C <- rowMeans(do.call(cbind, lapply(mylist_old, "[", "C")))
Mean_C <- as.data.frame(Mean_C)

当列表由至少一个数据框组成时，问题就来了

Mean_C <- rowMeans(do.call(cbind, lapply(mylist_new, "[", "C")))

导致：“[.data.frame(X[[i]], ...) 中的错误：选择了未定义的列

规避此问题的一种方法是将df3 从mylist_new 中排除。但是，我的真实程序有一个包含 64 个数据框的列表，我不知道列 C 是否存在。仅当检测到列C 存在时，我才想lapply 我的代码段，即将该命令应用于数据帧列表，但仅适用于存在C 列的数据帧为真。

我试过了

if("C" %in% colnames(mylist_new))
 
     Mean_C <- rowMeans(do.call(cbind, lapply(mylist_new, "[", "C")))
     Mean_C <- as.data.frame(Mean_C)    
 

但是什么也没发生，可能是因为colnames 指的是列表，而不是列表中的每个数据框。有 64 个数据框，我不能“手动”引用每个数据框，需要一个自动化的过程。

【参考方案1】：

这是Filter list 元素的一种选择，然后将lapply 应用于过滤后的list

rowMeans(do.call(cbind, lapply(Filter(function(x) "C" %in% names(x), 
               mylist_new), `[[`, "C")))
#[1] 2.0 6.5

---

或使用tidyverse 而不使用Filtering，但使用select 来忽略列不存在的情况

library(tidyverse)
map(mylist_new, ~ .x %>% 
                   select(one_of("C"))) %>% # gives a warning
                   bind_cols  %>%
                   rowMeans
#[1] 2.0 6.5

最好有一些警告表明该列不存在

---

或者没有警告

map(mylist_new, ~ .x %>% 
                 select(matches("^C$"))) %>%
                 bind_cols  %>%
                 rowMeans
#[1] 2.0 6.5

【参考方案2】：

我们可以在做子集之前使用 if 来检查名字

rowMeans(do.call(cbind,
         lapply(mylist_new, function(x) if('C' %in% names(x)) x['C'] else NA)),na.rm = TRUE)

或者在 purrr 0.3.2

中使用 map_if

library(purrr)
rowMeans(do.call(cbind,map_if(mylist_new, 
                              function(x) 'C' %in% names(x), 
                              'C', .else=~return(NA))),na.rm = TRUE)
[1] 2.0 6.5

【参考方案3】：

一种方法是使用purrr::safely，它将为每次迭代返回一个包含result 和error 元素的列表，然后我们可以转置、提取result 并使用@987654326 删除NULL 结果@：

library(tidyverse)
rowMeans(do.call(cbind, transpose(
  lapply(mylist_new, safely(`[`), "C"))$result %>% compact()))
# [1] 2.0 6.5

我们还可以使用otherwise 参数来获得NA 结果而不是NULL，我们可以在rowMeans 中将na.rm 设置为TRUE。

rowMeans(na.rm = TRUE, do.call(cbind, transpose(
  lapply(mylist_new, safely(`[`, otherwise= NA), "C"))$result))
# [1] 2.0 6.5

---

这是为了以最少的修改解决您的问题。如果我必须解决这个精确的问题，我会这样做：

map(mylist_new,  "C") %>% compact() %>% pmap_dbl(~mean(c(...)))
# [1] 2.0 6.5

我们提取 C 元素，当它是 NULL 时将其删除，然后按元素计算平均值。

这可能更有效（不确定）：

map(set_names(mylist_new),  "C") %>% compact() %>% as_tibble() %>% rowMeans()
# [1] 2.0 6.5

---

还有一个，这次使用重塑：

map_dfr(mylist_new, ~gather(.,,,-1)) %>% 
  group_by(X) %>%
  filter(key == "C") %>%
  summarize_at("value", mean)

# # A tibble: 2 x 2
# X     value
# <fct> <dbl>
# 1 name1   2  
# 2 name2   6.5

---

还有一个基本版本，可读性很强，有一个有点尴尬的步骤，其中几个列具有相同的名称，但它位于一个临时对象上，所以这还不错：

wide <- do.call(cbind, mylist_new)
rowMeans(wide[names(wide) == "C"])
# [1] 2.0 6.5