r-跨多个变量复制分组函数以生成许多新变量

Question

我有一个包含10个变量的大数据帧，每个变量都被分配了一个组。下面是一个示例数据帧。

test <- data.frame(1:10)
test$ID <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
test$Zone1 <- c(1,1,1,2,3,2,5,6,4,1)
test$Zone2 <- c(1,2,1,2,2,2,4,8,6,1)
test$Zone3 <- c(1,1,1,2,2,2,3,3,3,1)
test$Zone1_group<- c(1,1,1,2,2,2,3,3,3,4)
test$Zone2_group<- c(1,1,1,2,2,2,3,3,3,4)
test$Zone3_group<- c(1,1,1,2,2,2,3,3,3,4)

我想确定一个给定变量的组是否有任何方差。如果一个组没有任何方差，我会用NA替换它的值。下面是我使用以下方法为dplyr中的一个变量(如果我排除Zone1_group==4(实现的期望输出：

test2 <- test %>% group_by(Zone1_group) %>% summarise(Zone1_variance = SD(Zone1)) 
test3 <- left_join(test, test2, by = "Zone1_group")
test3 %>% mutate(Zone1_new = if_else(Zone1_variance == 0, NA_real_, Zone1))
X1.9 ID Zone1 Zone2 Zone3 Zone1_group Zone2_group Zone3_group Zone1_variance Zone1_new
1    1  A     1     1     1           1           1           1      0.0000000        NA
2    2  B     1     2     1           1           1           1      0.0000000        NA
3    3  C     1     1     1           1           1           1      0.0000000        NA
4    4  D     2     2     2           2           2           2      0.5773503         2
5    5  E     3     2     2           2           2           2      0.5773503         3
6    6  F     2     2     2           2           2           2      0.5773503         2
7    7  G     5     4     3           3           3           3      1.0000000         5
8    8  H     6     8     3           3           3           3      1.0000000         6
9    9  I     4     6     3           3           3           3      1.0000000         4

由于我需要为10个变量复制这个过程(以及其他类似的过程(，我想知道是否有一种方法可以比为每个变量名复制、粘贴和更新更优雅地做到这一点？

Answer 1

这里有一种方法：

library(dplyr)
library(purrr)
library(rlang)
add_new_var_cols <- function(data, col) {
group_col <- paste0(col, '_group')
col1 <- sym(col)
data %>% 
group_by(!!sym(group_col)) %>% 
transmute(!!paste0(col, '_new') := if(length(!!col1) > 1 && 
sd(!!col1) != 0) !!col1 else NA_real_) %>%
ungroup %>%
select(-group_col)
}

现在将此函数应用于每个'Zone'列：

cols <- paste0('Zone', 1:3)
bind_cols(test, map_dfc(cols, add_new_var_cols, data = test))

#  X1.9 ID Zone1 Zone2 Zone3 Zone1_group Zone2_group Zone3_group Zone1_new Zone2_new Zone3_new
#1    1  A     1     1     1           1           1           1        NA         1        NA
#2    2  B     1     2     1           1           1           1        NA         2        NA
#3    3  C     1     1     1           1           1           1        NA         1        NA
#4    4  D     2     2     2           2           2           2         2        NA        NA
#5    5  E     3     2     2           2           2           2         3        NA        NA
#6    6  F     2     2     2           2           2           2         2        NA        NA
#7    7  G     5     4     3           3           3           3         5         4        NA
#8    8  H     6     8     3           3           3           3         6         8        NA
#9    9  I     4     6     3           3           3           3         4         6        NA

我们在cols中传递字符变量，使用sym和!!将它们计算为列值，以便在函数中使用。