Выполнение dplyr mutate на подмножестве столбцов

У меня есть data.frame, такой как это (у реального набора данных есть много больше строк и столбцов)

set.seed(15)
dd <- data.frame(id=letters[1:4], matrix(runif(5*4), nrow=4))

#   id        X1        X2        X3        X4        X5
# 1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437
# 2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670
# 3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871
# 4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125

Я хотел бы иметь возможность написать инструкцию dplyr, где я могу выбрать подмножество столбцов и мутировать их. (Я пытаюсь сделать что-то похожее на использование .SDcols в data.table).

Для упрощенного примера здесь функция, которую я хотел бы написать, чтобы добавлять столбцы для сумм и средств четных столбцов "X", сохраняя при этом все остальные столбцы. Желаемый выход с использованием базы R равен

(cols<-paste0("X", c(2,4)))
# [1] "X2" "X4"
cbind(dd,evensum=rowSums(dd[,cols]),evenmean=rowMeans(dd[,cols]))

#   id        X1        X2        X3        X4        X5   evensum  evenmean
# 1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437 0.8761623 0.4380811
# 2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670 1.6954878 0.8477439
# 3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871 1.6775071 0.8387535
# 4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125 1.0957535 0.5478768

но я хотел использовать цепочку типа dplyr, чтобы сделать то же самое. В общем случае я хотел бы использовать любую вспомогательную функцию select(), такую как starts_with, ends_with, matches и т.д. И любую функцию. Вот что я пробовал

library(dplyr)
partial_mutate1 <- function(x, colspec, ...) {
    select_(x, .dots=list(lazyeval::lazy(colspec))) %>% 
    transmute_(.dots=lazyeval::lazy_dots(...)) %>% 
    cbind(x,.)
}

dd %>% partial_mutate1(num_range("X", c(2,4)), 
    evensum=rowSums(.), evenmean=rowMeans(.))

Однако это выдает сообщение об ошибке

Error in rowSums(.) : 'x' must be numeric

Это похоже на то, что . похоже ссылается на весь файл date.frame, а не на выбранное подмножество. (такая же ошибка, как rowSums(dd)). Однако обратите внимание, что это дает желаемый результат

partial_mutate2 <- function(x, colspec) {
    select_(x, .dots=list(lazyeval::lazy(colspec))) %>% 
    transmute(evensum=rowSums(.), evenmean=rowMeans(.)) %>% 
    cbind(x,.)
}
dd %>% partial_mutate2(seq(2,ncol(dd),2))

Я предполагаю, что это какая-то проблема с окружающей средой? Любые предложения о том, как передать аргументы partial_mutate1, чтобы . правильно принял значения из набора данных select() - ed?

Ответ 1

Я что-то упустил или будет работать так, как ожидалось:

cols <- paste0("X", c(2,4))
dd %>% mutate(evensum = rowSums(.[cols]), evenmean = rowMeans(.[cols]))
#  id        X1        X2        X3        X4        X5   evensum  evenmean
#1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437 0.8761623 0.4380811
#2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670 1.6954878 0.8477439
#3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871 1.6775071 0.8387535
#4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125 1.0957535 0.5478768

Или вы специально ищете пользовательскую функцию для этого?

Не то, что вы ищете, но если вы хотите сделать это внутри трубы, вы можете явно использовать select внутри mutate следующим образом:

dd %>% mutate(xy = select(., num_range("X", c(2,4))) %>% rowSums)
#  id        X1        X2        X3        X4        X5        xy
#1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437 0.8761623
#2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670 1.6954878
#3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871 1.6775071
#4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125 1.0957535

Однако, это немного сложнее, если вы хотите применить несколько функций. Вы можете использовать вспомогательную функцию по строкам (..не тщательно проверены..):

f <- function(x, ...) {
  n <- nrow(x)
  x <- lapply(list(...), function(y) if (length(y) == 1L) rep(y, n) else y)
  matrix(unlist(x), nrow = n, byrow = FALSE)
}

И затем примените его следующим образом:

dd %>% mutate(xy = select(., num_range("X", c(2,4))) %>% f(., rowSums(.), max(.)))
#  id        X1        X2        X3        X4        X5      xy.1      xy.2
#1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437 0.8761623 0.9888592
#2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670 1.6954878 0.9888592
#3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871 1.6775071 0.9888592
#4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125 1.0957535 0.9888592

Ответ 2

Агностический подход с числом столбцов с использованием dplyr:

dd %>% 
  select(-id) %>% 
  mutate(evensum = rowSums(.[,1:length(.[1,])%%2==0]), 
         evenmean = rowMeans(.[,1:length(.[1,])%%2==0])) %>% 
  cbind(id=dd[,1],.)

  id        X1        X2        X3        X4        X5   evensum  evenmean
1  a 0.6021140 0.3670719 0.6872308 0.5090904 0.4474437 0.8761623 0.4380812
2  b 0.1950439 0.9888592 0.8314290 0.7066286 0.9646670 1.6954878 0.8477439
3  c 0.9664587 0.8151934 0.1046694 0.8623137 0.1411871 1.6775071 0.8387535
4  d 0.6509055 0.2539684 0.6461509 0.8417851 0.7767125 1.0957535 0.5478767

Ответ 3

tidyr::nest() понимает тот же синтаксис селектора, что и dplyr::select(), поэтому один из подходов состоит в том, чтобы объединить интересующие столбцы в один столбец данных и выполнить необходимые операции над этим столбцом данных. и, чтобы вернуть плоский фрейм данных:

library( tidyverse )
dd %>% nest( X2, X4, .key="Slice" ) %>%
    mutate( evensum = map(Slice, rowSums),
           evenmean = map(Slice, rowMeans),
           evensd = map(Slice, pmap_dbl, lift_vd(sd)) ) %>%
    unnest
#   id       X1    X3    X5 evensum evenmean evensd    X2    X4
# 1 a     0.602 0.687 0.447   0.876    0.438 0.100  0.367 0.509
# 2 b     0.195 0.831 0.965   1.70     0.848 0.200  0.989 0.707
# 3 c     0.966 0.105 0.141   1.68     0.839 0.0333 0.815 0.862
# 4 d     0.651 0.646 0.777   1.10     0.548 0.416  0.254 0.842

Поскольку фреймы данных в основном являются списками, этот подход естественно подходит для применения произвольных функций (таких как sd выше) к произвольному набору столбцов с использованием семейства функций purrr::pmap().

Примечание: поскольку sd работает с векторами, мы используем purrr::lift_vd чтобы преобразовать его интерфейс в pmap:

sd( c(0.367, 0.509) )        # 0.100
lift_vd(sd)( 0.367, .509 )   # 0.100

Ответ 4

В новых версиях dplyr вы можете использовать новый mutate_at()

функция

mutate_at(dd, vars(starts_with("X")), somefunction)