Свернуть фрейм данных по группам, используя списки переменных для средневзвешенного значения И суммы

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

У меня есть следующий фрейм данных

group_id = c(1,1,1,2,2,3,3,3,3,3)
var_1 = sample.int(20, 10)
var_2 = sample.int(20, 10)
var_percent_1 =rnorm(10,.5,.4)
var_percent_2 =rnorm(10,.5,.4)
weighting =sample.int(50, 10)

df_to_collapse = data.frame(group_id,var_1,var_2,var_percent_1,var_percent_2,weighting)

Я хочу свернуть свои данные по группам, указанным group_id. Однако в моих данных у меня есть переменные на абсолютных уровнях (var_1, var_2) и в процентах (var_percent_1, var_percent_2).

Я создаю два списка для каждого типа переменных (мои реальные данные намного больше, поэтому это необходимо). Еще у меня есть весовая переменная (weighting).

to_be_weighted =df_to_collapse[, 4:5]
to_be_summed = df_to_collapse[,2:3]

to_be_weighted_2=colnames(to_be_weighted)
to_be_summed_2=colnames(to_be_summed) 

И моя цель - одновременно свернуть мои данные, используя сумму eiter или средневзвешенное значение, в зависимости от типа переменной (то есть, если это в процентах, я использую средневзвешенное значение).

Вот моя лучшая попытка:

 df_to_collapse %>% group_by(group_id) %>% summarise_at(.vars = c(to_be_summed_2,to_be_weighted_2), .funs=c(sum, mean))

Но, как видите, это не средневзвешенное

Я пробовал много разных способов использования weighted.mean функции, но безуспешно. Вот пример одной такой попытки;

df_to_collapse %>% group_by(group_id) %>% summarise_at(.vars = c(to_be_weighted_2,to_be_summed_2), .funs=c(weighted.mean(to_be_weighted_2, weighting), sum))

И соответствующая ошибка:

Error in weighted.mean.default(to_be_weighted_2, weighting) : 
'x' and 'w' must have the same length

person SeánMcK    schedule 04.05.2018    source источник
comment
Вы должны использовать set.seed перед созданием случайных данных примера, чтобы мы все смотрели на одно и то же и могли проверить возможные ответы.   -  person Frank    schedule 04.05.2018
comment
В любом случае, если вы хотите использовать data.table, это похоже на то, что вам нужно DT[, c(lapply(.SD[, ..to_be_weighted_2], weighted.mean, w = weighting), lapply(.SD[, ..to_be_summed_2], sum)), by=group_id]   -  person Frank    schedule 04.05.2018


Ответы (1)


Вот способ сделать это, преобразовав данные в длинные, добавив фиктивную переменную с именем type, указывающую, является ли это процентное значение (необязательно, но удобно), применив функцию в summarise в зависимости от того, является ли это процентное значение, а затем расширив его до широкой формы. Если вы можете изменить имена столбцов, вы могли бы придумать более элегантный способ создания столбца type, но это действительно больше для удобства.

Уловкой для меня был type[1] == "percent"; Мне пришлось использовать [1], потому что все в каждой группе имеет один и тот же тип, но в противном случае == работает с каждым значением в векторе и дает несколько логических значений, когда вам действительно просто нужно 1.

library(tidyverse)

set.seed(1234)
group_id = c(1,1,1,2,2,3,3,3,3,3)
var_1 = sample.int(20, 10)
var_2 = sample.int(20, 10)
var_percent_1 =rnorm(10,.5,.4)
var_percent_2 =rnorm(10,.5,.4)
weighting =sample.int(50, 10)

df_to_collapse <- data.frame(group_id,var_1,var_2,var_percent_1,var_percent_2,weighting)

df_to_collapse %>%
    gather(key = var, value = value, -group_id, -weighting) %>%
    mutate(type = ifelse(str_detect(var, "percent"), "percent", "int")) %>%
    group_by(group_id, var) %>%
    summarise(sum_or_avg = ifelse(type[1] == "percent", weighted.mean(value, weighting), sum(value))) %>%
    ungroup() %>%
    spread(key = var, value = sum_or_avg)
#> # A tibble: 3 x 5
#>   group_id var_1 var_2 var_percent_1 var_percent_2
#>      <dbl> <dbl> <dbl>         <dbl>         <dbl>
#> 1        1    26    31         0.269         0.483
#> 2        2    32    21         0.854         0.261
#> 3        3    29    49         0.461         0.262

Создано 4 мая 2018 г. пакетом REPEX (v0.2.0).

person camille    schedule 04.05.2018
comment
Идеально! Большое спасибо за вашу помощь (и извините за то, что вам потребовалось много времени, чтобы пометить как ответ!) - person SeánMcK; 02.06.2018