R - используйте group_by () и mutate () в dplyr, чтобы применить функцию, которая возвращает вектор длины групп

Question

Возьмем следующие примеры данных:

set.seed(1)

foo <- data.frame(x=rnorm(10, 0, 10), y=rnorm(10, 0, 10), fac = c(rep("A", 5), rep("B", 5)))

Я хочу разделить фрейм данных "foo" с помощью переменной "fac" на A и B, применить функцию (расстояние Махаланобиса), которая возвращает вектордлина каждой подгруппы, а затем измените выход обратно на исходный кадр данных.Например:

auto.mahalanobis <- function(x) {
  temp <- x[, c("x", "y")]
  return(mahalanobis(temp, center = colMeans(temp, na.rm=T), cov = cov(temp, 
use="pairwise.complete.obs")))
}

foo %>% group_by(fac) %>%
  mutate(mahal = auto.mahalanobis(.))

Что выдает ошибку.Очевидно, что эту процедуру можно выполнить вручную, разделив набор данных, применив функцию и добавив выходные данные в виде столбца, прежде чем снова собрать все вместе.Но должен быть более эффективный способ сделать это (возможно, это неправильное использование dplyr?).

Answer 1

Как насчет использования nest вместо:

foo %>%
    group_by(fac) %>%
    nest() %>%
    mutate(mahal = map(data, ~mahalanobis(
        .x,
        center = colMeans(.x, na.rm = T),
        cov = cov(.x, use = "pairwise.complete.obs")))) %>%
    unnest()
## A tibble: 10 x 4
#   fac   mahal      x       y
#   <fct> <dbl>  <dbl>   <dbl>
# 1 A     1.02   -6.26  15.1
# 2 A     0.120   1.84   3.90
# 3 A     2.81   -8.36  -6.21
# 4 A     2.84   16.0  -22.1
# 5 A     1.21    3.30  11.2
# 6 B     2.15   -8.20  -0.449
# 7 B     2.86    4.87  -0.162
# 8 B     1.23    7.38   9.44
# 9 B     0.675   5.76   8.21
#10 B     1.08   -3.05   5.94

Здесь вы избегаете явного "x", "y" фильтра формы temp <- x[, c("x", "y")], так как вы nest релевантные столбцы послегруппировка по fac.Применение mahalanobis тогда просто.

---

Обновление

Чтобы ответить на ваш комментарий, вот вариант purrr.Поскольку легко потерять представление о происходящем, давайте пошагово:

1. Создание примеров данных с одним дополнительным столбцом.

   set.seed(1)
   foo <- data.frame(
       x = rnorm(10, 0, 10),
       y = rnorm(10, 0, 10),
       z = rnorm(10, 0, 10),
       fac = c(rep("A", 5), rep("B", 5)))
   

2. Теперь мы храним столбцы, которые определяют подмножество данных, которые будут использоваться для расчета расстояния Махаланобиса в list

   cols <- list(cols1 = c("x", "y"), cols2 = c("y", "z"))
   

   Таким образом, мы рассчитаем расстояние Махаланобиса (для fac) для подмножества данных в столбцах x + y, а затем отдельно для y + z.Имена cols будут использоваться в качестве имен столбцов двух векторов расстояния.

3. Теперь для актуальной команды purrr:

   imap_dfc(cols, ~nest(foo %>% group_by(fac), .x, .key = !!.y) %>% select(!!.y)) %>%
       mutate_all(function(lst) map(lst, ~mahalanobis(
           .x,
           center = colMeans(.x, na.rm = T),
           cov = cov(., use = "pairwise.complete.obs")))) %>%
       unnest() %>%
       bind_cols(foo, .)
   #           x           y           z fac     cols1     cols2
   #1  -6.264538  15.1178117   9.1897737   A 1.0197542 1.3608052
   #2   1.836433   3.8984324   7.8213630   A 0.1199607 1.1141352
   #3  -8.356286  -6.2124058   0.7456498   A 2.8059562 1.5099574
   #4  15.952808 -22.1469989 -19.8935170   A 2.8401953 3.0675228
   #5   3.295078  11.2493092   6.1982575   A 1.2141337 0.9475794
   #6  -8.204684  -0.4493361  -0.5612874   B 2.1517055 1.2284793
   #7   4.874291  -0.1619026  -1.5579551   B 2.8626501 1.1724828
   #8   7.383247   9.4383621 -14.7075238   B 1.2271316 2.5723023
   #9   5.757814   8.2122120  -4.7815006   B 0.6746788 0.6939081
   #10 -3.053884   5.9390132   4.1794156   B 1.0838341 2.3328276
   

   Короче, мы

   1. перебираем записи в cols,
   2. nest данные в foo на fac на основе столбцов, определенных в cols,
   3. , применяются mahalanobis к вложенным и сгруппированным данным, генерирующим столько столбцов расстояния свложенные данные, поскольку у нас есть записи в cols (то есть в подмножествах), и
   4. наконец unnest данные о расстоянии и привязка столбцов к исходным foo данным.

Answer 2

Вы можете просто сделать -

foo %>% group_by(fac) %>%
  mutate(mahal = auto.mahalanobis(data.frame(x, y)))

# A tibble: 10 x 4
# Groups:   fac [2]
        x       y fac   mahal
    <dbl>   <dbl> <fct> <dbl>
 1 - 6.26  15.1   A     1.02 
 2   1.84   3.90  A     0.120
 3 - 8.36 - 6.21  A     2.81 
 4  16.0  -22.1   A     2.84 
 5   3.30  11.2   A     1.21 
 6 - 8.20 - 0.449 B     2.15 
 7   4.87 - 0.162 B     2.86 
 8   7.38   9.44  B     1.23 
 9   5.76   8.21  B     0.675
10 - 3.05   5.94  B     1.08

Вы можете удалить temp <- x[, c("x", "y")] из своей функции и просто использовать temp вместо x в качестве аргумента функции.

Очисткафункция -

auto.mahalanobis <- function(temp) {
  mahalanobis(temp,
              center = colMeans(temp, na.rm=T),
              cov = cov(temp, use="pairwise.complete.obs")
              )
}

Кстати, отличная работа на вашем первом посте!