按组合并两个因子时重新计算新的加权平均值，并保留原始数据

Question

我正在处理包含以下内容的数据框：

• 每个簇的计数（流式细胞术数据）

• 几个文件

• 以及机器记录的大量变量的平均值、最大值、最小值和总数。

如果我想减少组的数量（将相似的集群汇集在一起​​），我想按文件将组“a”和“b”的所有信息合并到一个文件中

到目前为止，按照SO Question，我已经计算出了最小值、最大值和总数，但是我一直坚持如何使用自定义函数在这个结构 (mutate_at) 中进行以下计算：

('a' 的计数 * 'a' 的平均值 + 'b' 的计数 * 'b' 的平均值) / 总和（'a' 的计数，'b' 的计数）

为了重新计算每个 mean_i 列的新 mean，其中等式中的“均值”是指包含我用 vars(mean_cols) 调用的平均值的列中的 1 个

目前的代码：

library(dplyr)

set.seed(123)
df <- data.frame(ID = 1:20, 
                 total_X = runif(20), 
                 min_X = runif(20),
                 max_X = runif(20),
                 mean_X = runif(20),
                 total_Y = runif(20), 
                 min_Y = runif(20),
                 max_Y = runif(20),
                 mean_Y = runif(20),
                 Counts = runif(20)*1000,
                 category = rep(letters[1:5], 4), 
                 file = as.factor(sort(rep(1:4, 5)))) 



total_cols = names(df)[which(grepl('total', names(df)))]
min_cols = names(df)[which(grepl('min', names(df)))]
max_cols = names(df)[which(grepl('max', names(df)))]
mean_cols = names(df)[which(grepl('total', names(df)))]

recalmean <- function() { sum(Counts * vars)/sum(Counts)}
  #counts of 'a'  * mean of 'a'  + counts of 'b'  * mean of 'b'  / sum(counts for 'a', counts of 'b' )

x <- df %>% bind_rows(
  df %>% 
    filter(category %in% c('a' , 'b')) %>%
    group_by(file) %>% 
    mutate_at(vars(total_cols), sum) %>%
    mutate_at(vars(min_cols), min) %>%
    mutate_at(vars(max_cols), max) %>%
    # mutate_at(vars(mean_cols), recalmean) %>%  ## this line needs to do the custom weighed mean calculation
    mutate(category = paste0(category,collapse='')) %>% 
    filter(row_number() == 1 & n() > 1)
) %>% mutate(ID = row_number())

Answer 1

不得不承认这很有挑战性......你应该重新考虑数据结构

library(tidyverse)

set.seed(123)
df <- data.frame(ID = 1:20, 
                 total_X = runif(20), 
                 min_X = runif(20),
                 max_X = runif(20),
                 mean_X = runif(20),
                 total_Y = runif(20), 
                 min_Y = runif(20),
                 max_Y = runif(20),
                 mean_Y = runif(20),
                 Counts = runif(20)*1000,
                 category = rep(letters[1:5], 4), 
                 file = as.factor(sort(rep(1:4, 5)))) 


x <- df %>% bind_rows(
  gather(df,metric,value,-ID,-file,-category,-Counts) %>% 
    mutate(group=str_extract(metric,"[A-Z]$"),metric = str_replace(metric,"_.$","")) %>% 
    filter(category %in% c('a' , 'b')) %>% 
    spread(metric,value) %>% 
    group_by(file,group) %>% 
    summarise(Counts = mean(Counts),
              category = paste0(category,collapse = ''),
              max = max(max),
              min = min(min),
              total = sum(total),
              mean = sum(Counts * mean)/sum(Counts)) %>% 
    ungroup() %>% 
    gather(metric,value,-file,-group,-category,-Counts) %>% 
    mutate(metric = paste(metric,group,sep='_'),group=NULL) %>% 
    spread(metric,value) %>% 
    mutate(ID=0)
) %>% mutate(ID = row_number())