将数据与R中的加权平均值和多个权重相结合

Question

所以我有this question，但范围变得更大/更复杂。

基本上我想组合两个表并计算任何重复ID的加权平均值。问题是我将有多组列需要使用不同的权重。这是我的两个数据集（RMS1和RMS2）和期望的结果（已加入）：

RMS1:
id,freq1,sev1,count1,freq2,sev2,count2
111 0    2    50     1     2    25
222 1    3    75     2     4    50

RMS2:               
id,freq1,sev1,count1,freq2,sev2,count2
222 2    4    25     6     6    200
333 4    5    60     3     2    20

Joined:                         
id  freq1   sev1    freq2   sev2        
111 0       2       1       2       
222 1.25*   3.25*   5**     5.5**       
333 4       5       3       2

所以*值是基于count1的加权平均值，但**值是基于count2的加权平均值（至少它们应该是，我试图快速进行数学运算）。我的整个数据集有13个组，它们使用单​​独的权重计数。我有这个代码，但显然需要扩展以获取多个权重：

Joined <- bind_rows(RMS1, RMS2) %>%
  group_by(id) %>%
  summarise_at(vars(-count1), funs(weighted.mean(., count1))) %>%
  as.data.frame()

作为R的新手，我不知道从哪里开始。我发现了一个possibly related question，但它已经过了我的脑袋。提前致谢。

Answer 1

使用tidyr和dplyr的解决方案。我们的想法是转换数据框，进行计算，然后转换回原始格式。

library(dplyr)
library(tidyr)

Joined <- bind_rows(RMS1, RMS2) %>%
  mutate(rowid = 1:n()) %>%
  gather(Column, Value, -id, -rowid) %>%
  extract(Column, into = c("Type", "Number"), 
          regex = "([A-Za-z]*)([0-9]*)", convert = TRUE) %>%
  spread(Type, Value) %>%
  group_by(id, Number) %>%
  summarise_at(vars(-rowid, -count), funs(weighted.mean(., count))) %>%
  gather(Type, Value, -id, -Number) %>%
  unite(Column, Type, Number, sep = "") %>%
  spread(Column, Value) %>%
  ungroup() %>%
  as.data.frame()
Joined
#    id freq1 freq2 sev1 sev2
# 1 111  0.00   1.0 2.00  2.0
# 2 222  1.25   5.2 3.25  5.6
# 3 333  4.00   3.0 5.00  2.0

数据

RMS1 <- read.table(text = "id freq1 sev1 count1 freq2 sev2 count2
111 0    2    50     1     2    25
222 1    3    75     2     4    50
", header = TRUE)

RMS2 <- read.table(text = "id freq1 sev1 count1 freq2 sev2 count2
222 2    4    25     6     6    200
                   333 4    5    60     3     2    20
                   ", header = TRUE)

Answer 2

1）dplyr rbind将两个输入数据帧放在一起，然后按id分组，对每个必需列执行加权平均值：

library(dplyr)

RMS1 %>%
     rbind(RMS2) %>%
     group_by(id) %>%
     summarize(freq1 = weighted.mean(freq1, count1),
               sev1 = weighted.mean(sev1, count1),
               freq2 = weighted.mean(freq2, count2),
               sev2 = weighted.mean(sev2, count2)) %>%
     ungroup

赠送：

# A tibble: 3 x 5
     id freq1  sev1 freq2  sev2
  <int> <dbl> <dbl> <dbl> <dbl>
1   111  0     2.00  1.00  2.00
2   222  1.25  3.25  5.20  5.60
3   333  4.00  5.00  3.00  2.00

2）sqldf使用sql的替代方法是：

library(sqldf)
sqldf("select id, 
              sum(count1 * freq1 + 0.0) / sum(count1) freq1,
              sum(count1 * sev1 + 0.0)  / sum(count1) sev1,
              sum(count2 * freq2 + 0.0) / sum(count2) freq2,
              sum(count2 * sev2 + 0.0)  / sum(count2) sev2
       from (select * from RMS1 union select * from RMS2)
       group by id", method = "raw")

赠送：

   id freq1 sev1 freq2 sev2
1 111  0.00 2.00   1.0  2.0
2 222  1.25 3.25   5.2  5.6
3 333  4.00 5.00   3.0  2.0

注意

可重复形式的输入是：

Lines1 <- "
id freq1 sev1 count1 freq2 sev2 count2
111 0    2    50     1     2    25
222 1    3    75     2     4    50"
RMS1 <- read.table(text = Lines1, header = TRUE)

Lines2 <- "
id freq1 sev1 count1 freq2 sev2 count2
222 2    4    25     6     6    200
333 4    5    60     3     2    20"
RMS2 <- read.table(text = Lines2, header = TRUE)75 + 25)