Q-Q绘图与ggplot2 :: stat_qq,颜色,单组

时间:2017-03-08 18:14:18

标签: r plot ggplot2

我正在寻找一种更方便的方法来获取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))

enter image description here

如果我尝试添加颜色,则分组进行分位数计算(我不想要):

ggplot(dda)+stat_qq(aes(sample=y,colour=f))

enter image description here

如果我使用stat_qq(aes(sample=y,colour=f,group=1)) ggplot忽略颜色规范,我会得到第一个图。

我想要一个绘图,其中点的位置与第一种情况相同,但颜色与第二种情况相同。我有一个基于qqnorm的手动解决方案,我可以发布,但我正在寻找更好的东西......

2 个答案:

答案 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))

enter image description here

啊,我想我应该读到你问题的结尾。这是你指的手动解决方案,对吧?虽然你可以把它打包成一个函数:

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>

  1. 使用修改后的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
                  }
)
  1. 定义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))
)

result