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

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

我在评论中被要求解释这里的想法，所以我想我会扩展原始答案，它显示在下面的水平线下方。

主要问题是如何对未知数量的组进行一些操作。有很多不同的方法可以做到这一点。在任何一种方式中，您都需要函数能够识别组的数量并适应该数量。例如，您可以执行类似以下代码的操作。在那里，我识别数据中的唯一组，初始化所需的结果，然后遍历所有组。我没有使用这个策略，因为与 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 可以 return 多个结果。例如，考虑：

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

在上面的函数中，我有函数 return 一个包含几个不同变量的数据框。一次调用 summarise returns 即可为每个组的变量获得所有这些结果。这当然可以使用 for 循环或类似 sapply() 的东西，但我喜欢 dplyr 代码的读起来更好一点。而且，根据你有多少组，dplyr 代码比一些基本的 R 东西更好。

我真的很喜欢尝试在输出中反映输入（即输入变量名称）——所以我想找到一种方法来绕过在数据。 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)

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

Custom function: allow unknown number of groups for operations

loops

r

dry

function

ggplot2

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