Этот вопрос связан с Создайте собственную геометрию для вычисления сводной статистики и отображения их * вне * области построения графика (ПРИМЕЧАНИЕ. Все функции упрощены, ошибки проверки правильности типов объектов, 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).
Виньетка "Расширение ggplot2" (http://docs.ggplot2.org/dev/vignettes/extending-ggplot2.html) показывает вам, как создать свою собственную функцию stat, которая позволяет вам напрямую перейти на данные, но проблема в том, что вам всегда нужно определить геометрию, чтобы перейти с вашей функцией stat (т.е. ggplot считает, что вы хотите построить эту информацию в сюжете, а не на полях); насколько я могу судить, вы не можете взять информацию, которую вы вычисляете в своей пользовательской функции stat, а не рисовать что-либо в области графика, а вместо этого передавать информацию функции масштабирования, например scale_x_discrete(). Вот моя попытка сделать это таким образом; самое лучшее, что я мог сделать, - разместить информацию о размере выборки при минимальном значении y для каждой группы:
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.
Если у кого-нибудь будет понимание этой проблемы, я был бы благодарен. Большое спасибо за ваше время!
