【问题标题】:ggplot2 shade area under density curve by groupggplot2按组在密度曲线下的阴影面积
【发布时间】:2013-12-19 18:53:58
【问题描述】:

我有这个数据框:

set.seed(1)
x <- c(rnorm(50, mean = 1), rnorm(50, mean = 3))
y <- c(rep("site1", 50), rep("site2", 50))
xy <- data.frame(x, y)

我已经制作了这个密度图:

library(ggplot2)
ggplot(xy, aes(x, color = y)) + geom_density()

对于site1,我需要对曲线下大于 1% 的数据的区域进行着色。对于site2,我需要对曲线下小于 75% 数据的区域进行着色。

我希望情节看起来像这样(photoshopped)。经历过堆栈溢出后,我知道其他人问过如何对曲线下的部分区域进行着色,但我不知道如何按组对曲线下的区域进行着色。

【问题讨论】:

标签: r ggplot2


【解决方案1】:

这是一种方法(正如@joran 所说,这是响应here 的扩展):

#  same data, just renaming columns for clarity later on
#  also, use data tables
library(data.table)
set.seed(1)
value <- c(rnorm(50, mean = 1), rnorm(50, mean = 3))
site  <- c(rep("site1", 50), rep("site2", 50))
dt    <- data.table(site,value)
#  generate kdf
gg <- dt[,list(x=density(value)$x, y=density(value)$y),by="site"]
#  calculate quantiles
q1 <- quantile(dt[site=="site1",value],0.01)
q2 <- quantile(dt[site=="site2",value],0.75)
# generate the plot
ggplot(dt) + stat_density(aes(x=value,color=site),geom="line",position="dodge")+
  geom_ribbon(data=subset(gg,site=="site1" & x>q1),
              aes(x=x,ymax=y),ymin=0,fill="red", alpha=0.5)+
  geom_ribbon(data=subset(gg,site=="site2" & x<q2),
              aes(x=x,ymax=y),ymin=0,fill="blue", alpha=0.5)

产生这个:

【讨论】:

    【解决方案2】:

    @jlhoward 解决方案的问题是您需要为您拥有的每个组手动添加goem_ribbon。我在vignette 之后编写了自己的ggplot stat 包装器。这样做的好处是它可以自动与group_byfacet 一起使用,您无需为每个组手动添加geom。

    StatAreaUnderDensity <- ggproto(
      "StatAreaUnderDensity", Stat,
      required_aes = "x",
      compute_group = function(data, scales, xlim = NULL, n = 50) {
        fun <- approxfun(density(data$x))
        StatFunction$compute_group(data, scales, fun = fun, xlim = xlim, n = n)
      }
    )
    
    stat_aud <- function(mapping = NULL, data = NULL, geom = "area",
                        position = "identity", na.rm = FALSE, show.legend = NA, 
                        inherit.aes = TRUE, n = 50, xlim=NULL,  
                        ...) {
      layer(
        stat = StatAreaUnderDensity, data = data, mapping = mapping, geom = geom, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(xlim = xlim, n = n, ...))
    }
    

    现在您可以像使用其他 ggplot 几何图形一样使用 stat_aud 函数。

    set.seed(1)
    x <- c(rnorm(500, mean = 1), rnorm(500, mean = 3))
    y <- c(rep("group 1", 500), rep("group 2", 500))
    t_critical = 1.5
    
    tibble(x=x, y=y)%>%ggplot(aes(x=x,color=y))+
      geom_density()+
      geom_vline(xintercept = t_critical)+
      stat_aud(geom="area",
               aes(fill=y),
               xlim = c(0, t_critical), 
                  alpha = .2)
    

    tibble(x=x, y=y)%>%ggplot(aes(x=x))+
      geom_density()+
      geom_vline(xintercept = t_critical)+
      stat_aud(geom="area",
               fill = "orange",
               xlim = c(0, t_critical), 
                  alpha = .2)+
      facet_grid(~y)
    

    【讨论】:

    • 如何根据我的data.frame 中的变量扩展它以使用不同的x_lim 每组?
    • 你可以阅读here 并尝试扩展自定义层以接受美学。
    【解决方案3】:

    您需要使用填充。颜色控制密度图的轮廓,如果您想要非黑色轮廓,这是必需的。

    ggplot(xy, aes(x, color=y, fill = y, alpha=0.4)) + geom_density()
    

    得到类似的东西。然后您可以使用删除图例的 alpha 部分

    ggplot(xy, aes(x, color = y, fill = y, alpha=0.4)) + geom_density()+ guides(alpha='none')
    

    【讨论】:

    • 抱歉,我没有得到我需要的情节。请注意,每组需要填充不同的区域,而不是曲线下的全部区域
    猜你喜欢
    • 2018-06-21
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2020-08-29
    • 1970-01-01
    • 1970-01-01
    • 2020-04-15
    • 2016-09-15
    相关资源
    最近更新 更多