вернуть отображенный объект, если выражение внутри purrr: возможен сбой ()

Question

У меня есть фрейм данных, один столбец которого содержит больше фреймов данных.В одном из этих фреймов данных отсутствует столбец.Я хотел бы удалить этот столбец из двух других фреймов данных, если он существует.

Вот пример:

library(tidyverse)

mtcars %>%
group_by(cyl) %>%
nest -> tmp
tmp[3,'data'][[1]][[1]] <- dplyr::select(tmp[3,'data'][[1]][[1]], -mpg)

print(tmp)

# A tibble: 3 x 2
    cyl data              
  <dbl> <list>            
1    6. <tibble [7 × 10]> 
2    4. <tibble [11 × 10]>
3    8. <tibble [14 × 9]>

Итак, здесьСтолбец data содержит три столбца, последний из которых не содержит столбец mpg.Я могу отобразить dplyr :: select по столбцу данных и отловить ошибки, возвращая NA следующим образом:

 tmp %>% mutate(data2 = map(data, possibly(~dplyr::select(.,-mpg), otherwise = NA)))

# A tibble: 3 x 3
    cyl data               data2            
  <dbl> <list>             <list>           
1    6. <tibble [7 × 10]>  <tibble [7 × 9]> 
2    4. <tibble [11 × 10]> <tibble [11 × 9]>
3    8. <tibble [14 × 9]>  <lgl [1]>

Но я бы действительно предпочел сделать следующее:вернуть входные данные.Что-то вроде:

 tmp %>% mutate(data2 = map(data, possibly(~dplyr::select(.,-mpg), otherwise = function(x){x})))

# A tibble: 3 x 3
    cyl data               data2            
  <dbl> <list>             <list>           
1    6. <tibble [7 × 10]>  <tibble [7 × 9]> 
2    4. <tibble [11 × 10]> <tibble [11 × 9]>
3    8. <tibble [14 × 9]>  <fn>

Но, конечно, это просто возвращает function(x){x} как последний ряд data2.

Есть какие-нибудь умные идеи?Или это такая ситуация, когда мне просто нужно использовать tryCatch или иначе обрабатывать ошибки более явно?

Answer 1

Аргумент otherwise в possibly является константой, поэтому он не может изменяться при вводе упакованной функции; Что вы можете сделать, это обернуть possibly в другую функцию, которая может получить доступ к элементу из data, установите элемент как otherwise:

my_select <- function(x) {
    f = possibly(function() select(x, -mpg), otherwise = x)
    f()
}

tmp %>% mutate(data2 = map(data, my_select))
# A tibble: 3 x 3
#    cyl data               data2            
#  <dbl> <list>             <list>           
#1  6.00 <tibble [7 x 10]>  <tibble [7 x 9]> 
#2  4.00 <tibble [11 x 10]> <tibble [11 x 9]>
#3  8.00 <tibble [14 x 9]>  <tibble [14 x 9]>

Или примите формулу:

tmp %>% 
    mutate(data2 = map(data, ~ (invoke(possibly(function() select(.,-mpg), otherwise = .)))))

# A tibble: 3 x 3
#    cyl data               data2            
#  <dbl> <list>             <list>           
#1     6 <tibble [7 × 10]>  <tibble [7 × 9]> 
#2     4 <tibble [11 × 10]> <tibble [11 × 9]>
#3     8 <tibble [14 × 9]>  <tibble [14 × 9]>