Syz*_*orr 9 group-by r summarization dplyr purrr
我的情况是我的数据框包含图像分析的结果,其中列是图像中存在的特定类的比例,因此示例数据框class_df看起来像:
id    A    B    C    D    E    F
 1 0.20 0.30 0.10 0.15 0.25 0.00 
 2 0.05 0.10 0.05 0.30 0.10 0.40
 3 0.10 0.10 0.10 0.20 0.20 0.30
这些类中的每一个属于一个功能组,我想创建新的列,其中每个功能组的比例是从类计算的.示例映射class_fg
class         fg
    A          Z
    B          Z
    C          Z
    D          Y
    E          Y
    F          X
并且所需的结果将是(添加行以显示所需的新列):
id    A    B    C    D    E    F |    X    Y    Z
 1 0.20 0.30 0.10 0.15 0.25 0.00 | 0.00 0.40 0.60
 2 0.05 0.10 0.05 0.30 0.10 0.40 | 0.40 0.40 0.20
 3 0.10 0.10 0.10 0.20 0.20 0.30 | 0.30 0.40 0.30
我可以一次使用一个功能组
first_fg <- class_fg %>%
  filter(fg == "Z") %>%
  select(class) %>%
  unlist()
class_df <- class_df %>%
  mutate(Z = rowSums(select(., one_of(first_fg))))
当然有一个更好的方法来做到这一点,我可以计算每个功能组的行总和,而不必只为每个组重复此代码?也许用purrr?
我们可以split在"class_df"由"类",遍历list的元素map,select的"class_df"列,并获得rowSums
library(tidyverse)
class_fg %>%
    split(.$fg) %>% 
    map_df(~ class_df %>%
                select(one_of(.x$class)) %>% 
                rowSums) %>%
    bind_cols(class_df, .)
#  id    A   B    C    D    E   F   X   Y   Z
#1  1 0.20 0.3 0.10 0.15 0.25 0.0 0.0 0.4 0.6
#2  2 0.05 0.1 0.05 0.30 0.10 0.4 0.4 0.4 0.2
#3  3 0.10 0.1 0.10 0.20 0.20 0.3 0.3 0.4 0.3
或做一组nest荷兰国际集团,然后执行rowSums由map平在list元素
class_fg %>% 
   group_by(fg) %>%
   nest %>%
   mutate(out = map(data, ~  class_df %>%
                               select(one_of(.x$class)) %>% 
                               rowSums)) %>% 
   select(-data)  %>%
   unnest %>% 
   unstack(., out ~ fg) %>% 
   bind_cols(class_df, .)
始终以长格式处理数据更容易.因此,class_df使用tidyr:gather和加入更改为长格式class_fg.以长格式对数据执行分析.最后,以宽格式传播以匹配预期结果.
library(tidyverse)
class_df %>% gather(key, value, -id) %>% 
  inner_join(class_fg, by=c("key" = "class")) %>%
  group_by(id, fg) %>%
  summarise(value = sum(value)) %>%
  spread(fg, value) %>%
  inner_join(class_df, by="id") %>% as.data.frame()
#   id   X   Y   Z    A   B    C    D    E   F
# 1  1 0.0 0.4 0.6 0.20 0.3 0.10 0.15 0.25 0.0
# 2  2 0.4 0.4 0.2 0.05 0.1 0.05 0.30 0.10 0.4
# 3  3 0.3 0.4 0.3 0.10 0.1 0.10 0.20 0.20 0.3
数据:
class_fg <- read.table(text = 
"class         fg
                 A          Z
                 B          Z
                 C          Z
                 D          Y
                 E          Y
                 F          X",
header = TRUE, stringsAsFactors = FALSE)
class_df  <- read.table(text = 
"id    A    B    C    D    E    F
1 0.20 0.30 0.10 0.15 0.25 0.00 
2 0.05 0.10 0.05 0.30 0.10 0.40
3 0.10 0.10 0.10 0.20 0.20 0.30",
header = TRUE, stringsAsFactors = FALSE)
另一种选择,与已经贡献了工作的解决方案一起,是使用quasiquotation 
与rlang包构建表达式计算每个组中的款项.
library(tidyverse)
首先,定义一个辅助函数,用于执行向量的元素和:
psum <- function(...) reduce(list(...), `+`)
从class_fg我们可以将分组提取到列表中然后可以构造表达式列表来计算每个组中的总和:
sum_exprs <- with(class_fg, split(class, fg)) %>% 
  map(~ rlang::expr(psum(!!!rlang::syms(.x))))
sum_exprs
#> $X
#> psum(F)
#> 
#> $Y
#> psum(D, E)
#> 
#> $Z
#> psum(A, B, C)
随着表达式列表的准备,我们可以将"bang-bang-bang"(!!!)它们放入数据中mutate:
class_df %>%
  mutate(!!!sum_exprs)
#>   id    A   B    C    D    E   F   X   Y   Z
#> 1  1 0.20 0.3 0.10 0.15 0.25 0.0 0.0 0.4 0.6
#> 2  2 0.05 0.1 0.05 0.30 0.10 0.4 0.4 0.4 0.2
#> 3  3 0.10 0.1 0.10 0.20 0.20 0.3 0.3 0.4 0.3
(我在他的答案中使用了@MKR提供的代码来创建数据).
由reprex包(v0.2.0)于2018-05-22创建.