我目前正在学习自己编写几何图形,因此当我经历我的思维过程时,这将是一篇相当长且杂乱的文章,从统计方面(计算这些多边形的位置)理清几何方面(创建多边形和线段) & 段应该是)geom 的。
免责声明:我对这种情节并不熟悉,谷歌也没有给出很多权威指南。我对这里如何计算/使用置信区间的理解可能不正确。
步骤 0. 了解 geom / stat 和图层函数之间的关系。
geom_boxplot
and stat_boxplot
是层函数的示例。如果将它们输入 R 控制台,您会发现它们(相对)较短,并且不包含用于计算箱线图的箱线/须线的实际代码。反而,geom_boxplot
包含一行内容:geom = GeomBoxplot
, while 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
and StatBoxplot
是 ggproto 对象。它们是魔法发生的地方。
第 1 步:认识到这一点ggproto()
's _inherit
参数是你的朋友。
不要重新发明轮子。由于我们想要创建与箱线图很好地重叠的东西,因此我们可以参考Geom https://github.com/cran/ggplot2/blob/master/R/geom-boxplot.r / Stat https://github.com/cran/ggplot2/blob/master/R/stat-boxplot.r用于此目的,并且仅更改必要的内容。
StatMeanDiamonds <- ggproto(
`_class` = "StatMeanDiamonds",
`_inherit` = StatBoxplot,
... # add functions here to override those defined in StatBoxplot
)
GeomMeanDiamonds <- ggproto(
`_class` = "GeomMeanDiamonds",
`_inherit` = GeomBoxplot,
... # as above
)
步骤 2. 修改统计数据。
StatBoxplot 中定义了 3 个函数:setup_data
, setup_params
, and compute_group
。您可以参考Github上的代码(上面的链接)了解详细信息,或者输入例如StatBoxplot$compute_group
.
The compute_group
函数计算与每个组关联的所有 y 值(即每个唯一的 x 值)的 ymin/lower/middle/upper/ymax 值,这些值用于绘制箱线图。我们可以用计算置信区间和平均值的方法来覆盖它:
# 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))
with:
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。
Geom_Boxplot 有 3 个函数:setup_data
, draw_group
, and draw_key
。它还包括以下定义default_aes()
and required_aes()
.
由于我们更改了上游数据源(StatMeanDiamonds 生成的数据包含计算列“lower”/“mean”/“upper”,而 StatBoxplot 生成的数据将包含计算列“ymin”/“lower” /“middle”/“upper”/“ymax”),检查下游是否setup_data
功能也受到影响。 (在这种情况下,GeomBoxplot$setup_data
没有引用受影响的列,因此此处不需要进行任何更改。)
The draw_group
函数采用 StatMeanDiamonds 生成的数据并通过以下方式设置setup_data
,并产生多个数据帧。 “common”包含所有几何图形共有的美学映射。 “diamond.df”用于对菱形多边形做出贡献的映射,“segment.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)
))
}
The draw_key
函数用于在需要时创建该层的图例。由于GeomMeanDiamonds继承自GeomBoxplot,因此默认为draw_key = draw_key_boxplot
,而我们不have改变它。保持不变不会破坏代码。然而,我认为更简单的传说,例如draw_key_polygon
提供一个不那么混乱的外观。
GeomBoxplot 的default_aes
规格看起来不错。但我们需要改变required_aes
因为我们期望从 StatMeanDiamonds 获得的数据是不同的(“lower”/“mean”/“upper”而不是“ymin”/“lower”/“middle”/“upper”/“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
to 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)