Есть ли способ создать функцию collect_at или collect_if, аналогичную mutate_at или mutate_if?

Question

Я думаю, что название довольно простое.Но просто для того, чтобы предоставить некоторые данные и пример:

test <- tibble(
ID1 = letters,
ID2 = LETTERS,
A1 = runif(26),
B1 = runif(26),
A2 = runif(26),
B2 = runif(26)
)

Есть ли способ собрать только, например, числовые столбцы с помощью команды simple, например:

test %>% gather_if(is.numeric, 'key', 'value')

?Который дал бы тот же результат, что и следующий:

> test %>% gather('key', 'value', -ID1, -ID2)
# A tibble: 104 x 4
   ID1   ID2   key    value
   <chr> <chr> <chr>  <dbl>
 1 a     A     A1    0.558 
 2 b     B     A1    0.0614
 3 c     C     A1    0.999 
 4 d     D     A1    0.854 
 5 e     E     A1    0.463 
 6 f     F     A1    0.875 
 7 g     G     A1    0.796 
 8 h     H     A1    0.484 
 9 i     I     A1    0.336 
10 j     J     A1    0.191 
# ... with 94 more rows

Глядя на функцию сбора:

> gather
function (data, key = "key", value = "value", ..., na.rm = FALSE, 
    convert = FALSE, factor_key = FALSE) 
{
    UseMethod("gather")
}
<bytecode: 0x000000001b71ff18>
<environment: namespace:tidyr>

Не похоже, что прямо изменить его (по крайней мере, не для меня)который является полу-новым пользователем R).

Редактировать:

Мой словарный выбор в dplyr может быть не совсем точным.Но я думаю, что MWE довольно хорошо объясняет, какой тип функции я собираюсь использовать.

Edit2:

Использование ответа bschneidr, специальной версииэто можно сделать следующим образом.

gather_if <- function(data, fun, key, value, ..., na.rm = FALSE, convert = 
FALSE, factor_key = FALSE){
    data %>%
        gather(!!key, !!value, select_if(., fun) %>% colnames(), ...,
               na.rm = FALSE, convert = FALSE, factor_key = FALSE)
}

Что дает:

> test %>% gather_if(is.numeric, 'key', 'value')
# A tibble: 104 x 4
   ID1   ID2   key    value
   <chr> <chr> <chr>  <dbl>
 1 a     A     A1    0.558 
 2 b     B     A1    0.0614
 3 c     C     A1    0.999 
 4 d     D     A1    0.854 
 5 e     E     A1    0.463 
 6 f     F     A1    0.875 
 7 g     G     A1    0.796 
 8 h     H     A1    0.484 
 9 i     I     A1    0.336 
10 j     J     A1    0.191 
# ... with 94 more rows

Answer 1

Если вы думаете, что хотите это:

gather_if <- function(data, FUN, key = "key", value = "value", na.rm = FALSE, convert = FALSE, factor_key = FALSE) {
    data %>% {gather(., key = key, value = value , names(.)[sapply(., FUN = FUN)], na.rm = na.rm, convert = convert, factor_key = factor_key )}
} 

вызовите вашу новую классную функцию:

test %>% gather_if(is.numeric, 'key', 'value')

результат:

# A tibble: 104 x 4
#   ID1   ID2   key   value
#   <chr> <chr> <chr> <dbl>
# 1 a     A     A1    0.693
# 2 b     B     A1    0.356
# 3 c     C     A1    0.650
# 4 d     D     A1    0.358
# 5 e     E     A1    0.650
# 6 f     F     A1    0.461
# 7 g     G     A1    0.222
# 8 h     H     A1    0.993
# 9 i     I     A1    0.679
#10 j     J     A1    0.331
# ... with 94 more rows

Answer 2

Я думаю, что функция gather_if находится в стадии разработки для tidyr (см. этот запрос на извлечение на репозитории Tidyr Github).

На данный момент, я думаю, самый простой способ - этоиспользовать функцию dplyr select_if внутри вызова к gather.

test %>% 
    gather('key', 'value',
           colnames(select_if(., is.numeric)))

Answer 3

Один из способов сделать это - negate() числовое условие и извлечь имена.Это выглядит немного громоздко, но вот оно,

library(tidyverse)

gather(test, key, value, -c(test %>% select_if(negate(is.numeric)) %>% names()))

, которое дает,

# A tibble: 104 x 4
   ID1   ID2   key    value
   <chr> <chr> <chr>  <dbl>
 1 a     A     A1    0.624 
 2 b     B     A1    0.0740
 3 c     C     A1    0.790 
 4 d     D     A1    0.312 
 5 e     E     A1    0.323 
 6 f     F     A1    0.826 
 7 g     G     A1    0.0533
 8 h     H     A1    0.0828
 9 i     I     A1    0.979 
10 j     J     A1    0.453 
# ... with 94 more rows