ggplot:按组自动化划分的百分位线
ggplot: percentile lines by group automation
我发现 dplyr
%>%
运算符对简单的 ggplot2 转换很有帮助(无需诉诸 ggproto
,这是 ggplot2 extensions 所必需的),例如
library(ggplot2)
library(scales)
library(dplyr)
gg.histo.pct.by.group <- function(g, ...) {
g +
geom_histogram(aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
scale_y_continuous(labels = percent) +
ylab("% of total count by group")
}
data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
g = ggplot(data, aes(carat, fill=color)) %>%
gg.histo.pct.by.group(binwidth=0.5, position="dodge")
在这些类型的图表中添加一些带有标签的百分位线是很常见的,例如,
一种剪切'n'粘贴的方法是
facts = data %>%
group_by(color) %>%
summarize(
p50=quantile(carat, 0.5, na.rm=T),
p90=quantile(carat, 0.9, na.rm=T)
)
ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2]
g +
geom_vline(data=facts, aes(xintercept=p50, color=color), linetype="dashed", size=1) +
geom_vline(data=facts, aes(xintercept=p90, color=color), linetype="dashed", size=1) +
geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90) +
geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90)
我很想将其封装成 g %>% gg.percentile.x(c(.5, .9))
之类的东西,但我一直没能找到将 aes_
或 aes_string
的使用与发现图形对象中的分组列,以便正确计算百分位数。如果能提供一些帮助,我将不胜感激。
我把你的例子放到了一个函数中。您可以在 fact
data.frame 中剖析 non-standard 评估。 (注意:我不喜欢命名 data.frame data
所以我在示例中将其更改为 mydata
)。
mydata = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
myFun <- function(df, X, col, bw, ...) {
facts <- df %>%
group_by_(col) %>%
summarize_(
p50= lazyeval::interp(~ quantile(var, 0.5, na.rm=TRUE), var = as.name(X)),
p90= lazyeval::interp(~ quantile(var, 0.9, na.rm=TRUE), var = as.name(X))
)
gp <- ggplot(df, aes_string(x = X, fill = col)) +
geom_histogram( position="dodge", binwidth = bw, aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
scale_y_continuous(labels = percent) + ylab("% of total count by group")
# ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2] #doesnt work
ymax = max(ggplot_build(g)$data[[1]]$ymax)
gp + aes_string(color = col) +
geom_vline(data=facts, aes_string(xintercept="p50", color = col), linetype="dashed", size=1) +
geom_vline(data=facts, aes_string(xintercept="p90", color = col), linetype="dashed", size=1) +
geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax), vjust=1.5, hjust=1, size=4, angle=90) +
geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax), vjust=1.5, hjust=1, size=4, angle=90)
}
myFun(df = mydata, X = "carat", col = "color", bw = 0.5)
如果您不想在函数调用中为变量加上引号,另一个提示是通过此 answer.
在函数开头设置变量
myOtherFun <- function(data, var1, var2, ...) {
#Value instead of string
internal.var1 <- eval(substitute(var1), data, parent.frame())
internal.var2 <- eval(substitute(var2), data, parent.frame())
ggplot(data, aes(x = internal.var1, y = internal.var2)) + geom_point()
}
myOtherFun(mtcars, mpg, hp) #note: mpg and hp aren't in quotes
ggplot(mtcars, aes(x = mpg, y = hp)) + geom_point() #same result
我认为创建所需情节的最有效方法包括三个步骤:
- 编写两个单独的简单统计数据(在从https://cran.r-project.org/web/packages/ggplot2/vignettes/extending-ggplot2.html创建新统计数据部分之后):一个用于在百分位数位置添加垂直线,另一个用于添加文本标签;
- 根据需要将刚刚写入的统计数据与参数组合成所需的数据;
- 使用工作成果。
所以答案也由3部分组成。
第 1 部分。在百分位数位置添加垂直线的统计数据应根据 x-axis 和 return 中的数据以适当的格式计算这些值。这是代码:
library(ggplot2)
StatPercentileX <- ggproto("StatPercentileX", Stat,
compute_group = function(data, scales, probs) {
percentiles <- quantile(data$x, probs=probs)
data.frame(xintercept=percentiles)
},
required_aes = c("x")
)
stat_percentile_x <- function(mapping = NULL, data = NULL, geom = "vline",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatPercentileX, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
添加文本标签的统计信息也是如此(默认位置在图的顶部):
StatPercentileXLabels <- ggproto("StatPercentileXLabels", Stat,
compute_group = function(data, scales, probs) {
percentiles <- quantile(data$x, probs=probs)
data.frame(x=percentiles, y=Inf,
label=paste0("p", probs*100, ": ",
round(percentiles, digits=3)))
},
required_aes = c("x")
)
stat_percentile_xlab <- function(mapping = NULL, data = NULL, geom = "text",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatPercentileXLabels, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
我们已经拥有非常强大的工具,可以以 ggplot2
可以提供的任何方式使用(着色、分组、刻面等等)。例如:
set.seed(1401)
plot_points <- data.frame(x_val=runif(100), y_val=runif(100),
g=sample(1:2, 100, replace=TRUE))
ggplot(plot_points, aes(x=x_val, y=y_val)) +
geom_point() +
stat_percentile_x(probs=c(0.25, 0.5, 0.75), linetype=2) +
stat_percentile_xlab(probs=c(0.25, 0.5, 0.75), hjust=1, vjust=1.5, angle=90) +
facet_wrap(~g)
# ggsave("Example_stat_percentile.png", width=10, height=5, units="in")
第 2 部分 尽管为线条和文本标签保留单独的层看起来很自然(尽管两次计算百分位数的计算效率有点低),但每次都添加两层非常冗长。特别是对于这个 ggplot2
有简单的组合层的方法:将它们放在结果函数调用的列表中。代码如下:
stat_percentile_x_wlabels <- function(probs=c(0.25, 0.5, 0.75)) {
list(
stat_percentile_x(probs=probs, linetype=2),
stat_percentile_xlab(probs=probs, hjust=1, vjust=1.5, angle=90)
)
}
使用此功能,可以通过以下命令重现前面的示例:
ggplot(plot_points, aes(x=x_val, y=y_val)) +
geom_point() +
stat_percentile_x_wlabels() +
facet_wrap(~g)
请注意,stat_percentile_x_wlabels
获取所需百分位数的概率,然后将其传递给 quantile
函数。这是指定它们的地方。
第 3 部分 再次使用组合图层的想法,您问题中的情节可以重现如下:
library(scales)
library(dplyr)
geom_histo_pct_by_group <- function() {
list(geom_histogram(aes(y=unlist(lapply(unique(..group..),
function(grp) {
..count..[..group..==grp] /
sum(..count..[..group..==grp])
}))),
binwidth=0.5, position="dodge"),
scale_y_continuous(labels = percent),
ylab("% of total count by group")
)
}
data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
ggplot(data, aes(carat, fill=color, colour=color)) +
geom_histo_pct_by_group() +
stat_percentile_x_wlabels(probs=c(0.5, 0.9))
# ggsave("Question_plot.png", width=10, height=6, unit="in")
备注
这里解决这个问题的方式允许用百分位线和标签构建更复杂的图;
将x
更改为y
(反之亦然),vline
更改为hline
,xintercept
更改为yintercept
在适当的地方,可以为来自 y-axis;
的数据定义相同的统计数据
当然,如果您喜欢使用 %>%
而不是 ggplot2
的 +
,您可以将定义的统计数据包装在函数中,就像您在问题中所做的那样 post。我个人不建议这样做,因为它违反了 ggplot2
.
的标准用法
我发现 dplyr
%>%
运算符对简单的 ggplot2 转换很有帮助(无需诉诸 ggproto
,这是 ggplot2 extensions 所必需的),例如
library(ggplot2)
library(scales)
library(dplyr)
gg.histo.pct.by.group <- function(g, ...) {
g +
geom_histogram(aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
scale_y_continuous(labels = percent) +
ylab("% of total count by group")
}
data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
g = ggplot(data, aes(carat, fill=color)) %>%
gg.histo.pct.by.group(binwidth=0.5, position="dodge")
在这些类型的图表中添加一些带有标签的百分位线是很常见的,例如,
一种剪切'n'粘贴的方法是
facts = data %>%
group_by(color) %>%
summarize(
p50=quantile(carat, 0.5, na.rm=T),
p90=quantile(carat, 0.9, na.rm=T)
)
ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2]
g +
geom_vline(data=facts, aes(xintercept=p50, color=color), linetype="dashed", size=1) +
geom_vline(data=facts, aes(xintercept=p90, color=color), linetype="dashed", size=1) +
geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90) +
geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90)
我很想将其封装成 g %>% gg.percentile.x(c(.5, .9))
之类的东西,但我一直没能找到将 aes_
或 aes_string
的使用与发现图形对象中的分组列,以便正确计算百分位数。如果能提供一些帮助,我将不胜感激。
我把你的例子放到了一个函数中。您可以在 fact
data.frame 中剖析 non-standard 评估。 (注意:我不喜欢命名 data.frame data
所以我在示例中将其更改为 mydata
)。
mydata = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
myFun <- function(df, X, col, bw, ...) {
facts <- df %>%
group_by_(col) %>%
summarize_(
p50= lazyeval::interp(~ quantile(var, 0.5, na.rm=TRUE), var = as.name(X)),
p90= lazyeval::interp(~ quantile(var, 0.9, na.rm=TRUE), var = as.name(X))
)
gp <- ggplot(df, aes_string(x = X, fill = col)) +
geom_histogram( position="dodge", binwidth = bw, aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
scale_y_continuous(labels = percent) + ylab("% of total count by group")
# ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2] #doesnt work
ymax = max(ggplot_build(g)$data[[1]]$ymax)
gp + aes_string(color = col) +
geom_vline(data=facts, aes_string(xintercept="p50", color = col), linetype="dashed", size=1) +
geom_vline(data=facts, aes_string(xintercept="p90", color = col), linetype="dashed", size=1) +
geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax), vjust=1.5, hjust=1, size=4, angle=90) +
geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax), vjust=1.5, hjust=1, size=4, angle=90)
}
myFun(df = mydata, X = "carat", col = "color", bw = 0.5)
如果您不想在函数调用中为变量加上引号,另一个提示是通过此 answer.
在函数开头设置变量myOtherFun <- function(data, var1, var2, ...) {
#Value instead of string
internal.var1 <- eval(substitute(var1), data, parent.frame())
internal.var2 <- eval(substitute(var2), data, parent.frame())
ggplot(data, aes(x = internal.var1, y = internal.var2)) + geom_point()
}
myOtherFun(mtcars, mpg, hp) #note: mpg and hp aren't in quotes
ggplot(mtcars, aes(x = mpg, y = hp)) + geom_point() #same result
我认为创建所需情节的最有效方法包括三个步骤:
- 编写两个单独的简单统计数据(在从https://cran.r-project.org/web/packages/ggplot2/vignettes/extending-ggplot2.html创建新统计数据部分之后):一个用于在百分位数位置添加垂直线,另一个用于添加文本标签;
- 根据需要将刚刚写入的统计数据与参数组合成所需的数据;
- 使用工作成果。
所以答案也由3部分组成。
第 1 部分。在百分位数位置添加垂直线的统计数据应根据 x-axis 和 return 中的数据以适当的格式计算这些值。这是代码:
library(ggplot2)
StatPercentileX <- ggproto("StatPercentileX", Stat,
compute_group = function(data, scales, probs) {
percentiles <- quantile(data$x, probs=probs)
data.frame(xintercept=percentiles)
},
required_aes = c("x")
)
stat_percentile_x <- function(mapping = NULL, data = NULL, geom = "vline",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatPercentileX, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
添加文本标签的统计信息也是如此(默认位置在图的顶部):
StatPercentileXLabels <- ggproto("StatPercentileXLabels", Stat,
compute_group = function(data, scales, probs) {
percentiles <- quantile(data$x, probs=probs)
data.frame(x=percentiles, y=Inf,
label=paste0("p", probs*100, ": ",
round(percentiles, digits=3)))
},
required_aes = c("x")
)
stat_percentile_xlab <- function(mapping = NULL, data = NULL, geom = "text",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatPercentileXLabels, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
我们已经拥有非常强大的工具,可以以 ggplot2
可以提供的任何方式使用(着色、分组、刻面等等)。例如:
set.seed(1401)
plot_points <- data.frame(x_val=runif(100), y_val=runif(100),
g=sample(1:2, 100, replace=TRUE))
ggplot(plot_points, aes(x=x_val, y=y_val)) +
geom_point() +
stat_percentile_x(probs=c(0.25, 0.5, 0.75), linetype=2) +
stat_percentile_xlab(probs=c(0.25, 0.5, 0.75), hjust=1, vjust=1.5, angle=90) +
facet_wrap(~g)
# ggsave("Example_stat_percentile.png", width=10, height=5, units="in")
第 2 部分 尽管为线条和文本标签保留单独的层看起来很自然(尽管两次计算百分位数的计算效率有点低),但每次都添加两层非常冗长。特别是对于这个 ggplot2
有简单的组合层的方法:将它们放在结果函数调用的列表中。代码如下:
stat_percentile_x_wlabels <- function(probs=c(0.25, 0.5, 0.75)) {
list(
stat_percentile_x(probs=probs, linetype=2),
stat_percentile_xlab(probs=probs, hjust=1, vjust=1.5, angle=90)
)
}
使用此功能,可以通过以下命令重现前面的示例:
ggplot(plot_points, aes(x=x_val, y=y_val)) +
geom_point() +
stat_percentile_x_wlabels() +
facet_wrap(~g)
请注意,stat_percentile_x_wlabels
获取所需百分位数的概率,然后将其传递给 quantile
函数。这是指定它们的地方。
第 3 部分 再次使用组合图层的想法,您问题中的情节可以重现如下:
library(scales)
library(dplyr)
geom_histo_pct_by_group <- function() {
list(geom_histogram(aes(y=unlist(lapply(unique(..group..),
function(grp) {
..count..[..group..==grp] /
sum(..count..[..group..==grp])
}))),
binwidth=0.5, position="dodge"),
scale_y_continuous(labels = percent),
ylab("% of total count by group")
)
}
data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))
ggplot(data, aes(carat, fill=color, colour=color)) +
geom_histo_pct_by_group() +
stat_percentile_x_wlabels(probs=c(0.5, 0.9))
# ggsave("Question_plot.png", width=10, height=6, unit="in")
备注
这里解决这个问题的方式允许用百分位线和标签构建更复杂的图;
将
x
更改为y
(反之亦然),vline
更改为hline
,xintercept
更改为yintercept
在适当的地方,可以为来自 y-axis; 的数据定义相同的统计数据
当然,如果您喜欢使用
%>%
而不是ggplot2
的+
,您可以将定义的统计数据包装在函数中,就像您在问题中所做的那样 post。我个人不建议这样做,因为它违反了ggplot2
. 的标准用法