Пересчитайте новое взвешенное среднее при объединении двух факторов по группам и сохраните исходные данные

Question

Я работаю над фреймом данных, который содержит:

• подсчетов на кластер (данные проточной цитометрии)

• нескольких файлов

• и среднее значение, max, min, всего для множества переменных, записанных машиной.

В случае, если я хочу уменьшить количество групп (объединить похожие кластеры вместе), я бы хотел объединить всю информацию в файле для группы 'a' и 'b' по файлу

Пока что, следуя этому SO Вопрос Я уже определил min, max и total, но застрял на том, как заставить следующий расчет работать в этой структуре (mutate_at)используя пользовательскую функцию, которая будет делать:

(число «a» * среднее значение «a» + число «b» * среднее значение «b») / сумма (число «a»), число «b»)

для пересчета нового mean для каждого из столбцов mean_i, где «среднее» в уравнении относится к 1 из столбцов, содержащих средние значения I 'м звонит с vars(mean_cols)

Код пока:

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())