В настоящее время я учусь писать geoms самостоятельно, так что это будет довольно длинный и бессвязный пост, поскольку я прохожу свои мыслительные процессы, распутывая аспекты Geom (создавая многоугольники и отрезки линий) из аспектов Stats (вычисляягде должны быть эти полигоны и сегменты) geom.
Отказ от ответственности: я не знаком с этим видом сюжета, и Google не выдает много авторитетных руководств.Мое понимание того, как доверительный интервал рассчитывается / используется здесь, может быть неверным.
Шаг 0. Понять взаимосвязь между geom / stat и функцией слоя.
geom_boxplot и stat_boxplot являются примерами функций слоя.Если вы введете их в консоль R, вы увидите, что они (относительно) короткие и не содержат фактического кода для расчета коробок / усов коробчатого графика.Вместо этого geom_boxplot содержит строку, которая говорит geom = GeomBoxplot, тогда как stat_boxplot содержит строку, которая говорит stat = StatBoxplot (воспроизведено ниже).
> stat_boxplot
function (mapping = NULL, data = NULL, geom = "boxplot", position = "dodge2",
..., coef = 1.5, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE)
{
layer(data = data, mapping = mapping, stat = StatBoxplot,
geom = geom, position = position, show.legend = show.legend,
inherit.aes = inherit.aes, params = list(na.rm = na.rm,
coef = coef, ...))
}
GeomBoxplot и StatBoxplot являются объектами ggproto,Именно там происходит волшебство.
Шаг 1. Признайте, что параметр ggproto() _inherit - ваш друг.
Не изобретайте колесо.Поскольку мы хотим создать что-то, что хорошо сочетается с коробочным графиком, мы можем взять ссылку из Geom / Stat , использованной для этого, и изменить только то, что необходимо.
StatMeanDiamonds <- ggproto(
`_class` = "StatMeanDiamonds",
`_inherit` = StatBoxplot,
... # add functions here to override those defined in StatBoxplot
)
GeomMeanDiamonds <- ggproto(
`_class` = "GeomMeanDiamonds",
`_inherit` = GeomBoxplot,
... # as above
)
Шаг 2. Изменить Stat.
В StatBoxplot определены 3 функции: setup_data, setup_params и compute_group.Вы можете обратиться к коду на Github (ссылка выше) для получения подробной информации или просмотреть их, введя, например, StatBoxplot$compute_group.
Функция compute_group вычисляет значения ymin / lower / middle / upper / ymaxдля всех значений y, связанных с каждой группой (т. е. каждого уникального значения x), которые используются для построения блочного графика.Вместо этого мы можем заменить его на тот, который вычисляет доверительный интервал и средние значения:
# ci is added as a parameter, to allow the user to specify different confidence intervals
compute_group_new <- function(data, scales, width = NULL,
ci = 0.95, na.rm = FALSE){
a <- mean(data$y)
s <- sd(data$y)
n <- sum(!is.na(data$y))
error <- qt(ci + (1-ci)/2, df = n-1) * s / sqrt(n)
stats <- c("lower" = a - error, "mean" = a, "upper" = a + error)
if(length(unique(data$x)) > 1) width <- diff(range(data$x)) * 0.9
df <- as.data.frame(as.list(stats))
df$x <- if(is.factor(data$x)) data$x[1] else mean(range(data$x))
df$width <- width
df
}
(Необязательно) StatBoxplot предоставляет пользователю возможность включить weight в качестве эстетического отображения.Мы также можем учесть это, заменив:
a <- mean(data$y)
s <- sd(data$y)
n <- sum(!is.na(data$y))
на:
if(!is.null(data$weight)) {
a <- Hmisc::wtd.mean(data$y, weights = data$weight)
s <- sqrt(Hmisc::wtd.var(data$y, weights = data$weight))
n <- sum(data$weight[!is.na(data$y) & !is.na(data$weight)])
} else {
a <- mean(data$y)
s <- sd(data$y)
n <- sum(!is.na(data$y))
}
Нет необходимости изменять другие функции в StatBoxplot.Таким образом, мы можем определить StatMeanDiamonds следующим образом:
StatMeanDiamonds <- ggproto(
`_class` = "StatMeanDiamonds",
`_inherit` = StatBoxplot,
compute_group = compute_group_new
)
Шаг 3. Изменить Geom.
GeomBoxplot имеет 3 функции: setup_data, draw_group иdraw_key.Он также включает определения для default_aes() и required_aes().
Поскольку мы изменили источник данных в восходящем направлении (данные, полученные StatMeanDiamonds, содержат вычисленные столбцы «нижний» / «средний» / «верхний»,в то время как данные, полученные StatBoxplot, содержали бы вычисленные столбцы «ymin» / «lower» / «middle» / «upper» / «ymax»), проверьте также, действует ли функция setup_data ниже по потоку.(В этом случае GeomBoxplot$setup_data не ссылается на соответствующие столбцы, поэтому никаких изменений здесь не требуется.)
Функция draw_group берет данные, созданные StatMeanDiamonds и настроенные с помощью setup_data, и производитнесколько кадров данных.«common» содержит эстетические отображения, общие для всех геомов.«diamond.df» для отображений, которые вносят вклад в многоугольник алмазов, и «plot.df» для отображений, которые вносят вклад в горизонтальный отрезок в среднем.Затем кадры данных передаются в функции draw_panel GeomPolygon и GeomSegment, соответственно, для создания фактических многоугольников / отрезков.
draw_group_new = function(data, panel_params, coord,
varwidth = FALSE){
common <- data.frame(colour = data$colour,
size = data$size,
linetype = data$linetype,
fill = alpha(data$fill, data$alpha),
group = data$group,
stringsAsFactors = FALSE)
diamond.df <- data.frame(x = c(data$x, data$xmax, data$x, data$xmin),
y = c(data$upper, data$mean, data$lower, data$mean),
alpha = data$alpha,
common,
stringsAsFactors = FALSE)
segment.df <- data.frame(x = data$xmin, xend = data$xmax,
y = data$mean, yend = data$mean,
alpha = NA,
common,
stringsAsFactors = FALSE)
ggplot2:::ggname("geom_meanDiamonds",
grid::grobTree(
GeomPolygon$draw_panel(diamond.df, panel_params, coord),
GeomSegment$draw_panel(segment.df, panel_params, coord)
))
}
Функция draw_key используется для создания легенды для этого слояв случае необходимости.Поскольку GeomMeanDiamonds наследуется от GeomBoxplot, по умолчанию используется значение draw_key = draw_key_boxplot, и у нас нет для его изменения.Если оставить его без изменений, код не будет нарушен.Тем не менее, я думаю, что более простая легенда, такая как draw_key_polygon, предлагает менее загроможденный вид.
Характеристики GeomBoxplot default_aes выглядят хорошо.Но нам нужно изменить required_aes, так как данные, которые мы ожидаем получить от StatMeanDiamonds, отличаются («нижний» / «средний» / «верхний» вместо «ymin» / «нижний» / «средний» / «верхний» /"ymax").
Теперь мы готовы определить GeomMeanDiamonds:
GeomMeanDiamonds <- ggproto(
"GeomMeanDiamonds",
GeomBoxplot,
draw_group = draw_group_new,
draw_key = draw_key_polygon,
required_aes = c("x", "lower", "upper", "mean")
)
Шаг 4. Определить функции слоя.
Этоскучная часть.Я скопировал из geom_boxplot / stat_boxplot напрямую, удалив все ссылки на выбросы в geom_meanDiamonds, изменив на geom = GeomMeanDiamonds / stat = StatMeanDiamonds и добавив ci = 0.95 к stat_meanDiamonds.
geom_meanDiamonds <- function(mapping = NULL, data = NULL,
stat = "meanDiamonds", position = "dodge2",
..., varwidth = FALSE, na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE){
if (is.character(position)) {
if (varwidth == TRUE) position <- position_dodge2(preserve = "single")
} else {
if (identical(position$preserve, "total") & varwidth == TRUE) {
warning("Can't preserve total widths when varwidth = TRUE.", call. = FALSE)
position$preserve <- "single"
}
}
layer(data = data, mapping = mapping, stat = stat,
geom = GeomMeanDiamonds, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(varwidth = varwidth, na.rm = na.rm, ...))
}
stat_meanDiamonds <- function(mapping = NULL, data = NULL,
geom = "meanDiamonds", position = "dodge2",
..., ci = 0.95,
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = StatMeanDiamonds,
geom = geom, position = position, show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ci = ci, ...))
}
Шаг 5. Проверьте вывод.
# basic
ggplot(iris,
aes(Species, Sepal.Length)) +
geom_boxplot() +
geom_meanDiamonds()
# with additional parameters, to see if they break anything
ggplot(iris,
aes(Species, Sepal.Length)) +
geom_boxplot(width = 0.8) +
geom_meanDiamonds(aes(fill = Species),
color = "red", alpha = 0.5, size = 1,
ci = 0.99, width = 0.3)
