Выполнение 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)
