мурлыкать над несколькими группами переменных в R - PullRequest
Новая
       51

мурлыкать над несколькими группами переменных в R

1 голос
/ 28 апреля 2020

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

Вот пример данных: 

library(tidyverse)
df <- tibble(tep_1 = sample(c(0,1), 5, replace = TRUE),
             tep_2 = sample(c(0,1), 5, replace = TRUE),
             adarta_1 = sample(c(0,1), 5, replace = TRUE),
             adarta_2 = sample(c(0,1), 5, replace = TRUE),
             adarta_3 = sample(c(0,1), 5, replace = TRUE),
             adarta_4 = sample(c(0,1), 5, replace = TRUE),
             adarta_5 = sample(c(0,1), 5, replace = TRUE),
             adarta_6 = sample(c(0,1), 5, replace = TRUE))

Вот моя функция, которая не работает. Примечание: эта функция только пытается получить сумму строки, но мне также нужны среднее, среднее значение и стандартное отклонение строки: 

column_prefix <- c("tep", "adarta")

my_fun <- function(x, y) {
  x %>%
  select(starts_with(y)) %>%
    rowSums(x, na.rm = TRUE)
}

map2_dbl(.x = df, .y = column_prefix, .f = my_fun)

Error: Mapped vectors must have consistent lengths:
* `.x` has length 8
* `.y` has length 2

И я хочу сделать так, чтобы я мог получить этот вывод с этой функцией : 

library(tidyverse)
df <- df %>%
  mutate(tep_grand_mean = mean(c(tep_1, tep_2)),
         tep_sd = sd(tep_grand_mean),
         adarta_grand_mean = mean(c(adarta_1, adarta_1, adarta_2, adarta_3, adarta_4, adarta_5, adarta_6)),
         adarta_sd = sd(adarta_grand_mean),
         tep_sum = pmap_dbl(select(., starts_with("tep")), sum),
         tep_mean = rowMeans(select(., contains("tep")), na.rm = TRUE),
         adarta_sum = pmap_dbl(select(., starts_with("adarta")), sum),
         adarta_mean = rowMeans(select(., contains("adarta")), na.rm = TRUE))
~~~~~

1 Ответ

2 голосов
/ 28 апреля 2020

Здесь нам может потребоваться только map после внесения некоторых изменений в функцию 

map(column_prefix, my_fun, x = df)
#[[1]]
#[1] 0 0 2 2 1

#[[2]]
#[1] 4 2 0 1 4

my_fun <- function(x, y) {
  x %>%
   select(starts_with(y)) %>%
    rowSums(na.rm = TRUE)
}

map2 используется, когда два объекта имеют одинаковую длину или если один объект имеет один элемент, оберните его с помощью list и перезапустите

Если нам понадобится mean для каждого аналогичного префиксного имени. Один из вариантов: split.default

library(stringr)
df %>% 
    split.default(str_remove(names(.), "_\\d+$")) %>% 
    map_df(rowMeans)%>% 
    rename_all(~ str_c(., '_mean')) %>% 
    bind_cols(df, .)
# A tibble: 5 x 10
#  tep_1 tep_2 adarta_1 adarta_2 adarta_3 adarta_4 adarta_5 adarta_6 adarta_mean tep_mean
#* <dbl> <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>       <dbl>    <dbl>
#1     0     1        0        0        0        0        0        1       0.167      0.5
#2     0     0        1        1        0        1        0        0       0.5        0  
#3     1     1        0        0        1        1        1        0       0.5        1  
#4     1     0        0        1        1        0        0        0       0.333      0.5
#5     1     0        1        1        1        1        0        0       0.667      0.5

Или мы можем использовать преобразование в «длинный» формат с помощью pivot_longer

library(tidyr)
df %>%
   mutate(rn = row_number()) %>% 
   pivot_longer(cols = -rn, names_to = c('.value', 'group'), names_sep="_") %>% 
   group_by(rn) %>% 
   summarise_at(vars(tep, adarta), list(mean = ~mean(., na.rm = TRUE))) %>%
   select(-rn) %>%
   bind_cols(df, .)
# A tibble: 5 x 10
#  tep_1 tep_2 adarta_1 adarta_2 adarta_3 adarta_4 adarta_5 adarta_6 tep_mean adarta_mean
#* <dbl> <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>       <dbl>
#1     0     1        0        0        0        0        0        1      0.5       0.167
#2     0     0        1        1        0        1        0        0      0         0.5  
#3     1     1        0        0        1        1        1        0      1         0.5  
#4     1     0        0        1        1        0        0        0      0.5       0.333
#5     1     0        1        1        1        1        0        0      0.5       0.667

В более новой версии dplyr мы также можем использовать across с summarise 

df %>%
    mutate(rn = row_number()) %>% 
    pivot_longer(cols = -rn, names_to = c('.value', 'group'), names_sep="_") %>% 
    group_by(rn) %>% 
    summarise(across(c(tep, adarta),  ~mean(., na.rm = TRUE), names = "{col}_mean" )) %>%
    select(-rn) %>%
    bind_cols(df, .)
# A tibble: 5 x 10
#  tep_1 tep_2 adarta_1 adarta_2 adarta_3 adarta_4 adarta_5 adarta_6 tep_mean adarta_mean
#* <dbl> <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>       <dbl>
#1     0     1        0        0        0        0        0        1      0.5       0.167
#2     0     0        1        1        0        1        0        0      0         0.5  
#3     1     1        0        0        1        1        1        0      1         0.5  
#4     1     0        0        1        1        0        0        0      0.5       0.333
#5     1     0        1        1        1        1        0        0      0.5       0.667
...