我正在寻找一种更方便的方法来获取ggplot2
中的Q-Q图,其中为整个数据集计算分位数。但我可以为数据中的组使用映射(颜色/形状)。
library(dplyr)
library(ggplot2)
library(broom) ## for augment()
制作一些数据:
set.seed(1001)
N <- 1000
G <- 10
dd <- data_frame(x=runif(N),
f=factor(sample(1:G,size=N,replace=TRUE)),
y=rnorm(N)+2*x+as.numeric(f))
m1 <- lm(y~x,data=dd)
dda <- cbind(augment(m1),f=dd$f)
基本情节:
ggplot(dda)+stat_qq(aes(sample=.resid))
如果我尝试添加颜色,则分组进行分位数计算(我不想要):
ggplot(dda)+stat_qq(aes(sample=y,colour=f))
如果我使用stat_qq(aes(sample=y,colour=f,group=1))
ggplot忽略颜色规范,我会得到第一个图。
我想要一个绘图,其中点的位置与第一种情况相同,但颜色与第二种情况相同。我有一个基于qqnorm
的手动解决方案,我可以发布,但我正在寻找更好的东西......
答案 0 :(得分:4)
您可以自己计算分位数,然后使用geom_point
:
dda = cbind(dda, setNames(qqnorm(dda$.resid, plot.it=FALSE), c("Theoretical", "Sample")))
ggplot(dda) +
geom_point(aes(x=Theoretical, y=Sample, colour=f))
啊,我想我应该读到你问题的结尾。这是你指的手动解决方案,对吧?虽然你可以把它打包成一个函数:
my_stat_qq = function(data, colour.var) {
data=cbind(data, setNames(qqnorm(data$.resid, plot.it=FALSE), c("Theoretical", "Sample")))
ggplot(data) +
geom_point(aes_string(x="Theoretical", y="Sample", colour=colour.var))
}
my_stat_qq(dda, "f")
答案 1 :(得分:3)
这是一种基于ggproto的方法,尝试更改StatQq
,因为此处的根本问题(当显式指定组时,忽略颜色规范)是由于其compute_group
函数的编码方式。 / p>
StatQq
(最后几行代码)定义compute_group
的备用版本:StatQq2 <- ggproto("StatQq", Stat,
default_aes = aes(y = after_stat(sample), x = after_stat(theoretical)),
required_aes = c("sample"),
compute_group = function(data, scales, quantiles = NULL,
distribution = stats::qnorm, dparams = list(),
na.rm = FALSE) {
sample <- sort(data$sample)
n <- length(sample)
# Compute theoretical quantiles
if (is.null(quantiles)) {
quantiles <- stats::ppoints(n)
} else if (length(quantiles) != n) {
abort("length of quantiles must match length of data")
}
theoretical <- do.call(distribution, c(list(p = quote(quantiles)), dparams))
res <- ggplot2:::new_data_frame(list(sample = sample,
theoretical = theoretical))
# NEW: append remaining columns from original data
# (e.g. if there were other aesthetic variables),
# instead of returning res directly
data.new <- subset(data[rank(data$sample), ],
select = -c(sample, PANEL, group))
if(ncol(data.new) > 0) res <- cbind(res, data.new)
res
}
)
geom_qq2
/ stat_qq2
以使用修改后的StatQq2
而不是StatQq
作为统计信息:geom_qq2 <- function (mapping = NULL, data = NULL, geom = "point",
position = "identity", ..., distribution = stats::qnorm,
dparams = list(), na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = StatQq2, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(distribution = distribution, dparams = dparams,
na.rm = na.rm, ...))
}
stat_qq2 <- function (mapping = NULL, data = NULL, geom = "point",
position = "identity", ..., distribution = stats::qnorm,
dparams = list(), na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = StatQq2, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(distribution = distribution, dparams = dparams,
na.rm = na.rm, ...))
}
用法:
cowplot::plot_grid(
ggplot(dda) + stat_qq(aes(sample = .resid)), # original
ggplot(dda) + stat_qq2(aes(sample = .resid, # new
color = f, group = 1))
)