Я пытаюсь рассчитать средневзвешенное значение для нескольких столбцов, используя dplyr. на данный момент я застрял с SumMurise_each, который мне кажется частью решения. вот пример кода:

library(dplyr)
f2a <- c(1,0,0,1)
f2b <- c(0,0,0,1)
f2c <- c(1,1,1,1)
clustervar <- c("A","B","B","A")
weight <- c(10,20,30,40)

df <- data.frame (f2a, f2b, f2c, clustervar, weight, stringsAsFactors=FALSE)
df

То, что я ищу, это что-то вроде

df %>%
  group_by (clustervar) %>%
  summarise_each(funs(weighted.mean(weight)), select=cbind(clustervar, f2a:f2c))

Результатом этого является только:

# A tibble: 2 × 4
  clustervar select4 select5 select6
       <chr>   <dbl>   <dbl>   <dbl>
1          A      25      25      25
2          B      25      25      25

Чего мне здесь не хватает?

9
Jan 25 Апр 2017 в 09:11

2 ответа

Лучший ответ

Вы можете использовать summarise_at, чтобы указать, над какими столбцами вы хотите работать:

df %>% group_by(clustervar) %>% 
    summarise_at(vars(starts_with('f2')), 
                 funs(weighted.mean(., weight)))
#> # A tibble: 2 × 4
#>   clustervar   f2a   f2b   f2c
#>        <chr> <dbl> <dbl> <dbl>
#> 1          A     1   0.8     1
#> 2          B     0   0.0     1
18
alistaire 25 Апр 2017 в 06:46

Мы можем изменить его в «длинный» формат, а затем сделать это

library(tidyverse)
gather(df, Var, Val, f2a:f2c) %>% 
        group_by(clustervar, Var) %>% 
        summarise(wt =weighted.mean(Val, weight)) %>%
        spread(Var, wt)

Или другой вариант

df %>%
    group_by(clustervar) %>% 
    summarise_each(funs(weighted.mean(., weight)), matches("^f"))
# A tibble: 2 × 4     
#    clustervar   f2a   f2b   f2c
#         <chr> <dbl> <dbl> <dbl>
# 1          A     1   0.8     1
# 2          B     0   0.0     1

Или с summarise_at и matches (другой вариант другого сообщения - другой пост не был виден во время публикации)

df %>% 
   group_by(clustervar) %>% 
   summarise_at(vars(matches('f2')), funs(weighted.mean(., weight)))
# A tibble: 2 × 4
#   clustervar   f2a   f2b   f2c
#        <chr> <dbl> <dbl> <dbl>
#1          A     1   0.8     1
#2          B     0   0.0     1

Или другой вариант: data.table

library(data.table)
setDT(df)[, lapply(.SD, function(x) weighted.mean(x, weight)),
                       by = clustervar, .SDcols  = f2a:f2c]
#    clustervar f2a f2b f2c
#1:          A   1 0.8   1
#2:          B   0 0.0   1

ПРИМЕЧАНИЕ. Все четыре ответа основаны на допустимом синтаксисе tidyverse/data.table и будут давать ожидаемый результат

Мы также можем создать функцию, которая использует синтаксис из версии dplyr devel (скоро выйдет 0.6.0). Enquo выполняет аналогичную работу по замене, беря входные аргументы и преобразовывая их в выражения. Внутри group_by / sumrize / mutate мы оцениваем условие, удаляя его (UQ или !!)

wtFun <- function(dat, pat, wtcol, grpcol){
       wtcol <- enquo(wtcol)
       grpcol <- enquo(grpcol)
       dat %>%
           group_by(!!grpcol) %>%
           summarise_at(vars(matches(pat)), funs(weighted.mean(., !!wtcol)))
 }

wtFun(df, "f2", weight, clustervar)
# A tibble: 2 × 4
#   clustervar   f2a   f2b   f2c
#       <chr> <dbl> <dbl> <dbl>
#1          A     1   0.8     1
#2          B     0   0.0     1
0
akrun 25 Апр 2017 в 18:12