Custom function: allow unknown number of groups for operations - r

Question

Within a custom function, how can I avoid repeating the same code for each group while allowing an unknown number of groups?
Here's a simpler example but assume the function has tons of operations, like calculating different statistics for each group and sticking them on each ggplot facet. Sorry, I find it difficult to make a simpler function to demonstrate this specific challenge.
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))
}
Works if there's three groups
test.function("mpg", "cyl", mtcars)
Doesn't work if there's two groups
test.function("mpg", "vs", mtcars)
Error in shapiro.test(.) : sample size must be between 3 and 5000
Doesn't work if there's more than three groups
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
What is the trick programmers usually use to accommodate any number of groups in such functions?

Answer 1

I was asked in the comments to explain the thinking here, so I thought I would expand on the original answer, which shows up below the horizontal rule below.
The main question is how to do some operation on an unknown number of groups. There are lots of different ways to do that. In any of the ways, you need the function to be able to identify the number of groups and adapt to that number. For example, you could do something like the code below. There, I identify the unique groups in the data, initialize the required result and then loop over all of the groups. I didn't use this strategy because the for loop feels a bit clunky compared to the dplyr code.
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))
}
The other thing to keep in mind is what's going to scale well. You mentioned that you've got lots of operations the code will ultimately do. In what's below, I just had summarise print a single number. However, you could write a little function that would produce a dataset and then summarise can return a number of results. For example, consider:
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
In the function above, I had the function return a data frame with several different variables. A single call to summarise returns all of those results for the variable for each group. This would certainly have been possible using a for loop or something like sapply(), but I like how the dplyr code reads a bit better. And, depending on how many groups you have, the dplyr code scales a bit better than some of the base R stuff.
I really like trying to reflect the inputs (i.e., input variable names) in the outputs - so I wanted to find a way to get around making variables called group and variable in the data. The aes_string() specification is one way of doing that and then building a formula using the variable names is another. I recently just encountered the reformulate() function, which is a more robust way of building formulae than the combination of paste() and as.formula() I was using before.
Those were the things I was thinking about when I was answering the question.
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)