仅在列存在时才提供数据框列表

Posted 2021-04-04

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

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

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)

当列表由至少一个不存在列C的数据帧组成时会出现问题，在我的示例中是df3的情况，即列表mylist_new：

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

导致：“[.data.frame中的错误（X [[i]]，...）：选择了未定义的列

解决这个问题的一种方法是从df3中排除mylist_new。但是，我的真实程序有一个包含64个数据帧的列表，我不知道列C是否存在。只有当lapply列被检测为存在时，我才想C我的代码片段，即将命令应用于数据帧列表，但仅适用于列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个数据帧，我无法“手动”引用每个数据帧并需要自动化过程。

答案

这是Filter list元素的一个选项，然后在过滤的lapply上应用list

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

---

或使用没有tidyverseing的Filter，但使用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

另一答案

我们可以使用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

另一答案

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

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

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

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