Применить к списку кадров данных, только если столбец существует - PullRequest
Новая
       30

Применить к списку кадров данных, только если столбец существует

5 голосов
/ 27 апреля 2019

У меня есть список фреймов данных, для которых я хочу получить (в отдельном фрейме данных) среднее значение строки указанного столбца, которое может существовать или не существовать во всех фреймах данных списка.Моя проблема возникает, когда указанный столбец не существует хотя бы в одном из фреймов данных списка.

Предположим, следующий список фреймов данных приведен в следующем примере: 

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 column 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 кадрами данных я не могу обращаться к каждому «вручную», и мне нужна автоматизированная процедура.

Ответы [ 3 ]

6 голосов
/ 27 апреля 2019

Вот один вариант для 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 без Filter ing, но использование 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
3 голосов
/ 27 апреля 2019

Мы можем использовать , если , чтобы проверить имена, прежде чем мы сделаем подмножество 

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

Или использовать map_if в purrr 0.3.2 

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
0 голосов
/ 02 мая 2019

Один из способов - использовать 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
...