Этот вопрос связан с Создание настраиваемой геометрии для вычисления сводной статистики и ее отображения * вне * области построения (ПРИМЕЧАНИЕ: все функции были упрощены; никаких проверок ошибок для правильных типов объектов, NA и т. д.)
В базовом R довольно легко создать функцию, которая создает ленточную диаграмму с размером выборки, указанным под каждым уровнем группирующей переменной: вы можете добавить информацию о размере выборки, используя функцию mtext():
stripchart_w_n_ver1 <- function(data, x.var, y.var) {
x <- factor(data[, x.var])
y <- data[, y.var]
# Need to call plot.default() instead of plot because
# plot() produces boxplots when x is a factor.
plot.default(x, y, xaxt = "n", xlab = x.var, ylab = y.var)
levels.x <- levels(x)
x.ticks <- 1:length(levels(x))
axis(1, at = x.ticks, labels = levels.x)
n <- sapply(split(y, x), length)
mtext(paste0("N=", n), side = 1, line = 2, at = x.ticks)
}
stripchart_w_n_ver1(mtcars, "cyl", "mpg")
или вы можете добавить информацию о размере выборки в метки деления оси x с помощью функции axis():
stripchart_w_n_ver2 <- function(data, x.var, y.var) {
x <- factor(data[, x.var])
y <- data[, y.var]
# Need to set the second element of mgp to 1.5
# to allow room for two lines for the x-axis tick labels.
o.par <- par(mgp = c(3, 1.5, 0))
on.exit(par(o.par))
# Need to call plot.default() instead of plot because
# plot() produces boxplots when x is a factor.
plot.default(x, y, xaxt = "n", xlab = x.var, ylab = y.var)
n <- sapply(split(y, x), length)
levels.x <- levels(x)
axis(1, at = 1:length(levels.x), labels = paste0(levels.x, "\nN=", n))
}
stripchart_w_n_ver2(mtcars, "cyl", "mpg")
Хотя это очень простая задача в базе R, она безумно сложна в ggplot2, потому что очень сложно получить данные, используемые для генерации графика, и хотя есть функции, эквивалентные axis() (например, scale_x_discrete и т. Д.) нет эквивалента mtext(), который позволяет легко размещать текст с указанными координатами внутри полей.
Я попытался использовать встроенную функцию stat_summary() для вычисления размеров выборки (то есть fun.y = "length"), а затем поместить эту информацию на метки на оси X, но, насколько я могу судить, вы не можете извлечь размеры выборки, а затем каким-то образом добавьте их к отметкам на оси X с помощью функции scale_x_discrete(), вы должны указать stat_summary(), какой геометрию вы хотите использовать. Вы можете установить geom="text", но тогда вы должны предоставить метки, и дело в том, что метки должны быть значениями размеров выборки, что stat_summary() вычисляет, но вы не можете получить (и у вас также будет чтобы указать, где вы хотите разместить текст, и, опять же, трудно понять, где его разместить, чтобы он лежал непосредственно под метками с отметками оси x).
StatN <- ggproto("StatN", Stat,
required_aes = c("x", "y"),
compute_group = function(data, scales) {
y <- data$y
y <- y[!is.na(y)]
n <- length(y)
data.frame(x = data$x[1], y = min(y), label = paste0("n=", n))
}
)
stat_n <- function(mapping = NULL, data = NULL, geom = "text",
position = "identity", inherit.aes = TRUE, show.legend = NA,
na.rm = FALSE, ...) {
ggplot2::layer(stat = StatN, mapping = mapping, data = data, geom = geom,
position = position, inherit.aes = inherit.aes, show.legend = show.legend,
params = list(na.rm = na.rm, ...))
}
ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + geom_point() + stat_n()
Я думал, что решил проблему, просто создав функцию-оболочку для ggplot:
ggstripchart <- function(data, x.name, y.name,
point.params = list(),
x.axis.params = list(labels = levels(x)),
y.axis.params = list(), ...) {
if(!is.factor(data[, x.name]))
data[, x.name] <- factor(data[, x.name])
x <- data[, x.name]
y <- data[, y.name]
params <- list(...)
point.params <- modifyList(params, point.params)
x.axis.params <- modifyList(params, x.axis.params)
y.axis.params <- modifyList(params, y.axis.params)
point <- do.call("geom_point", point.params)
stripchart.list <- list(
point,
theme(legend.position = "none")
)
n <- sapply(split(y, x), length)
x.axis.params$labels <- paste0(x.axis.params$labels, "\nN=", n)
x.axis <- do.call("scale_x_discrete", x.axis.params)
y.axis <- do.call("scale_y_continuous", y.axis.params)
stripchart.list <- c(stripchart.list, x.axis, y.axis)
ggplot(data = data, mapping = aes_string(x = x.name, y = y.name)) + stripchart.list
}
ggstripchart(mtcars, "cyl", "mpg")
Однако эта функция некорректно работает с фасетированием. Например:
ggstripchart(mtcars, "cyl", "mpg") + facet_wrap(~am)
показывает размеры выборки для обоих фасетов, объединенных для каждого фасета. Мне пришлось бы встроить фасетирование в функцию-оболочку, что лишает смысла пытаться использовать все, что ggplot может предложить.
Если у кого-то есть понимание этой проблемы, я был бы признателен. Большое спасибо за ваше время!
