自定义功能：允许未知数量的组进行操作

Question

在自定义函数中，如何避免为每个组重复相同的代码，同时允许未知数量的组？

这是一个更简单的示例，但假设该函数有大量操作，例如为每个组计算不同的统计数据并将它们粘贴到每个 ggplot 方面。抱歉，我发现很难创建一个更简单的函数来演示这个特定的挑战。

test.function <- function(variable, group, data) {
  if(!require(dplyr)){install.packages("dplyr")}
  if(!require(ggplot2)){install.packages("ggplot2")}
  if(!require(ggrepel)){install.packages("ggrepel")}
  library(dplyr)
  library(ggplot2)
  require(ggrepel)
  data$variable <- data[,variable]
  data$group <- factor(data[,group])

  # Compute individual group stats
  data %>%
    filter(data$group==levels(data$group)[1]) %>%
    select(variable) %>%
    unlist %>%
    shapiro.test() -> shap
  shapiro.1 <- round(shap$p.value,3)
  data %>%
    filter(data$group==levels(data$group)[2]) %>%
    select(variable) %>%
    unlist %>%
    shapiro.test() -> shap
  shapiro.2 <- round(shap$p.value,3)
  data %>%
    filter(data$group==levels(data$group)[3]) %>%
    select(variable) %>%
    unlist %>%
    shapiro.test() -> shap
  shapiro.3 <- round(shap$p.value,3)

  # Make the stats dataframe for ggplot
  dat_text <- data.frame(
    group = levels(data$group),
    text = c(shapiro.1, shapiro.2, shapiro.3))

  # Make the plot
  ggplot(data, aes(x=variable, fill=group)) +
    geom_density() +
    facet_grid(group ~ .) +
    geom_text_repel(data = dat_text,
                    mapping = aes(x = Inf, 
                                  y = Inf, 
                                  label = text))
}

如果有三个组则有效

test.function("mpg", "cyl", mtcars)

如果有两个组则不起作用

test.function("mpg", "vs", mtcars)

 Error in shapiro.test(.) : sample size must be between 3 and 5000 

三组以上无效

test <- mtcars %>% mutate(new = rep(1:4, 8))
test.function("mpg", "new", test)

 Error in data.frame(group = levels(data$group), text = c(shapiro.1, shapiro.2,  : 
  arguments imply differing number of rows: 4, 3 

程序员通常使用什么技巧来容纳此类函数中的任意数量的组？

Answer 1

我在 cmets 中被要求解释这里的想法，所以我想我会扩展原来的答案，它显示在下面的水平规则下方。

主要问题是如何对未知数量的组进行一些操作。有很多不同的方法可以做到这一点。在任何一种方式中，您都需要该函数能够识别组的数量并适应该数量。例如，您可以执行以下代码。在那里，我识别数据中的唯一组，初始化所需的结果，然后遍历所有组。我没有使用这种策略，因为与dplyr 代码相比，for 循环感觉有点笨拙。

un_group <- na.omit(unique(data[[group]]))
dat_text <- data.frame(group = un_group, 
                     text = NA)
for(i in 1:length(un_group)){
  tmp <- data[which(data[[group]] == ungroup[i]), ]
  dat_text$text[i] <- as.character(round(shaprio.test(tmp[[variable]])$p.value, 3))
}

要记住的另一件事是可以很好地扩展。你提到你有很多操作代码最终会做。在下面的内容中，我只是让summarise 打印了一个数字。但是，您可以编写一个生成数据集的小函数，然后summarise 可以返回多个结果。例如，考虑：

myfun <- function(x){
  s = shapiro.test(x)
  data.frame(p = s$p.value, stat=s$statistic, 
             mean = mean(x, na.rm=TRUE), 
             sd = sd(x, na.rm=TRUE), 
             skew = DescTools::Skew(x, na.rm=TRUE), 
             kurtosis = DescTools::Kurt(x, na.rm=TRUE))
  
}
mtcars %>% group_by(cyl) %>% summarise(myfun(mpg))
# # A tibble: 3 x 7
#     cyl     p  stat  mean    sd   skew kurtosis
# * <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>    <dbl>
# 1     4 0.261 0.912  26.7  4.51  0.259   -1.65 
# 2     6 0.325 0.899  19.7  1.45 -0.158   -1.91 
# 3     8 0.323 0.932  15.1  2.56 -0.363   -0.566

在上面的函数中，我让函数返回一个包含多个不同变量的数据框。对summarise 的一次调用将返回每个组的变量的所有结果。这当然可以使用 for 循环或类似 sapply() 的东西，但我喜欢 dplyr 代码读起来更好一些。而且，根据您拥有的组数，dplyr 代码的扩展性比一些基本的 R 代码要好一些。

我真的很喜欢在输出中反映输入（即输入变量名称） - 所以我想找到一种方法来避免在数据中生成名为 group 和 variable 的变量。 aes_string() 规范是这样做的一种方法，然后使用变量名构建公式是另一种方法。我最近刚刚遇到了reformulate() 函数，这是一种比我之前使用的paste() 和as.formula() 组合更强大的公式构建方式。

这些是我在回答问题时正在考虑的事情。

---

test.function <- function(variable, group, data) {
  if(!require(dplyr)){install.packages("dplyr")}
  if(!require(ggplot2)){install.packages("ggplot2")}
  if(!require(ggrepel)){install.packages("ggrepel")}
  library(dplyr)
  library(ggplot2)
  require(ggrepel)

  # Compute individual group stats
  
  data[[group]] <- as.factor(data[[group]])
  
  dat_text <- data %>% group_by(.data[[group]]) %>% 
    summarise(text=shapiro.test(.data[[variable]])$p.value) %>% 
    mutate(text=as.character(round(text, 3)))
  
  gform <- reformulate(".", response=group)
  # Make the plot
  ggplot(data, aes_string(x=variable, fill=group)) +
    geom_density() +
    facet_grid(gform) +
    geom_text_repel(data = dat_text,
                    mapping = aes(x = Inf, 
                                  y = Inf, 
                                  label = text))
}
test.function("mpg", "vs", mtcars)

test.function("mpg", "cyl", mtcars)