Суммирование сбрасываемых изменений в data.frame с dplyr

dan спросил: 13 июня 2018 в 07:10 в: r

У меня есть data.frame со значениями для 100 идентификаторов (например, генов), измеренных от 10 group s (например, типы ячеек), где каждый из этих group s поступает из 10 family s (например, тканей), по 3 образца на каждый такой id - group - family, т.е. всего 30000 строк:

set.seed(1)
df <- data.frame(id = rep(paste0("i",1:100),300),
                 group = rep(unlist(lapply(1:10,function(g) rep(paste0("g",g),100))),30),
                 family = unlist(lapply(1:10,function(f) rep(paste0("f",f),3000))),
                 val = rnorm(30000))

Я хочу создать data.frame что для каждого id в каждом group в каждом family вычисляется сбрасывание смены между его средним val и средним val s из всех остальных id s из этого group и family.

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

ids <- paste0("i",1:100)
groups <- paste0("g",1:10)
families <- paste0("f",1:10)res.df <- do.call(rbind,lapply(ids,function(i){
  do.call(rbind,lapply(families,function(f){
    do.call(rbind,lapply(groups,function(g){
      data.frame(id=i,group=g,family=f,fc=mean(dplyr::filter(df,id == i,group == g,family == f)$val)/mean(dplyr::filter(df,id != i,group == g,family == f)$val))
    }))
  }))
}))

Любая идея?


3 ответа

Есть решение
Ozan147 ответил: 13 июня 2018 в 10:17

Я согласен с @PoGibas в отношении отсутствия ясности вашего вопроса и просто предполагаю, что вы пытаетесь воспроизвести окончательный кадр данных res.df эффективным способом. На данный момент я считаю, что ответ @PoGibas не дает желаемого формата, и некоторые люди могут найти синтаксис data.table менее доступным по сравнению с dplyr (я не имею в виду для их сравнения оба пакета имеют свои преимущества). Ниже приведено одно возможное решение dplyr:

library(dplyr)
# assuming that df and res.df are already loaded as given in the questionby_id_group_family <- df %>%
  # group by id, group and family 
  group_by(id, group, family) %>%
  # calculate some useful features of the grouped data 
  summarise(
    count = n(),
    total_val = sum(val), 
    avg_val = mean(val)  
  )by_group_family <- df %>% 
  # group by group and family
  group_by(group, family) %>% 
  # calculate some useful features of the grouped data 
  summarise(
    count = n(),
    total_val = sum(val), 
    avg_val = mean(val) 
  )# store mean vals for each id samples in each group in each family
mean_ids <- by_id_group_family$avg_val# compute mean vals of all other ids in each group in each family
# note that shorter list will recycle here 
# and we have a minus at the beginning as we are subtracting bigger sum from smaller one
mean_other_ids <- -(by_id_group_family$total_val - by_group_family$total_val) / 297# computing the ratio of means
ratio <- mean_ids / mean_other_ids# combining the ratio with the grouped data
result <- by_id_group_family %>%
  # choose only the first three columns
  select(1:3) %>%
  ungroup() %>%
  # add a new column to store ratio
  mutate(fc = ratio)# note that result has the same info as your res.df but family column is sorted differently
head(result)
# # A tibble: 6 x 4
#   id    group family      fc
#   <fct> <fct> <fct>    <dbl>
# 1 i1    g1    f1        9.48
# 2 i1    g1    f10      -4.86
# 3 i1    g1    f2      -50.4 
# 4 i1    g1    f3       17.2 
# 5 i1    g1    f4      131.  
# 6 i1    g1    f5        4.03

Можно сделать код более кратким, объединив некоторые шаги и удалив дополнительные вычисления, но я думаю, что этот способ проще следить, а лишние статистические данные помогают мне понять природу ваших данных.

dan ответил: 14 июня 2018 в 10:07
PoGibas, код cbind(dfM[, outer(V1, V1, "/"), .(group, family)], dfM[, expand.grid(id, id), .(group, family)][, .(Var1, Var2)]) дает эту ошибку для моих реальных данных: negative length vectors are not allowed. Я предполагаю, что это связано с тем, что в моих реальных данных не все id s отображаются во всех group s и family. Можете ли вы изменить это решение, чтобы это можно было сделать?
PoGibas ответил: 13 июня 2018 в 08:14

Короткий ответ:

library(data.table)
dfM <- setDT(df)[, mean(val), .(id, group, family)]
cbind(dfM[, outer(V1, V1, "/"), .(group, family)],
      dfM[, expand.grid(id, id), .(group, family)][, .(Var1, Var2)])

Объяснение:

Я бы решил эту задачу по-другому (без итерации). Прежде всего, мы должны прояснить ваши проблемы:

  1. Рассчитать среднее значение val для каждого id, group и family
  2. Разделите каждый средний продукт на другие средние продукты для каждой комбинации group и family

Чтобы вычислить среднее, я буду использовать data.table (я использую data.table для последующих вычислений для каждой группы), идея not для повторного вычисления означает несколько раз.

library(data.table)
dfM <- setDT(df)[, mean(val), .(id, group, family)]
# Result
# head(dfM)
#    id group family          V1
# 1: i1    g1     f1 -0.12587944
# 2: i2    g1     f1 -0.20889324
# 3: i3    g1     f1 -0.02890183
# 4: i4    g1     f1  0.77509410
# 5: i5    g1     f1  0.11435116
# 6: i6    g1     f1 -0.59556654

Чтобы вычислить изменение смены (т. е. разделите вектор на вектор), мы можем использовать функцию outer. Здесь мы просим разделить вектор V1 на вектор V1 внутри data.table dfM каждым group и family.

 foo <- dfM[, outer(V1, V1, "/"), .(group, family)]
 # nrow(foo)
 # 1000000
 #    group family         V1
 # 1:    g1     f1  1.0000000
 # 2:    g1     f1  1.6594708
 # 3:    g1     f1  0.2295993
 # 4:    g1     f1 -6.1574322
 # 5:    g1     f1 -0.9084181
 # 6:    g1     f1  4.7312457

outer не дает нам информации о id, потому что мы используем другую base R function expand.grid.

bar <- dfM[, expand.grid(id, id), .(group, family)][, .(id1 = Var1, id2 = Var2)]

И для конечного результата используйте cbind:

head(cbind(foo, bar))head(cbind(foo, bar))
#    group family         V1 id1 id2
# 1:    g1     f1  1.0000000  i1  i1
# 2:    g1     f1  1.6594708  i2  i1
# 3:    g1     f1  0.2295993  i3  i1
# 4:    g1     f1 -6.1574322  i4  i1
# 5:    g1     f1 -0.9084181  i5  i1
# 6:    g1     f1  4.7312457  i6  i1

Это решение занимает несколько секунд с данными OP.

Данные:

set.seed(1)
df <- data.frame(id = rep(paste0("i",1:100),300),
                 group = rep(unlist(lapply(1:10,function(g) rep(paste0("g",g),100))),30),
                 family = unlist(lapply(1:10,function(f) rep(paste0("f",f),3000))),
                 val = rnorm(30000))