基于值的曲线下填充区域 [英] Filling area under curve based on value

问题描述

我们正在尝试使用 ggplot2 绘制面积图，其中 x 轴上方的正区域是一种颜色，负区域是另一种颜色.

给定这个数据集，我想要一个面积图，在轴的每一侧用不同的颜色着色.

我可以看到一种将数据集划分为两个子集的方法，一个是正值，所有负值都为零，另一个是负值，所有正值都为零，然后将它们分别绘制在同一轴上，但似乎存在将是一种更像 ggplot 的方式来做到这一点.

在 应用于我们的数据集时会产生与过零相关的伪影:

由以下代码生成(请勿使用):

#设置分组功能rle.grp <- 函数(x){xx <- rle(x)xx$values = seq_along(xx$values)逆.rle(xx) }# 生成色带图ggplot(test, aes(x=x,y=y,group = factor(rle.grp(sign(y))))) +geom_ribbon(aes(ymax = pmax(0,y),ymin = pmin(0,y),fill = factor(sign(y), levels = c(-1,0,1), labels = c('-','0','+'))))+ scale_fill_brewer(name = 'sign', 调色板 = 'RdBu')

请参阅下面@baptiste 和 Kohske 建议的最终答案.

解决方案

根据@baptiste 的评论(已删除)，我会说这是最好的答案.它基于 Kohske 的这篇文章.它在零交叉处向数据集添加新的 x-y 对，并生成如下图:

# 创建一些带有过零的假数据yvals = c(2,2,-1,2,2,2,0,-1,-2,2,-2)d = data.frame(x=seq(1,length(yvals)),y=yvals)rx <- do.call("rbind",应用(1:(nrow(d)-1)，函数(i){f <- lm(x~y, d[i:(i+1),])如果(f$qr$rank <2)返回(NULL)r <- 预测(f，新数据=data.frame(y=0))if(d[i,]$x < r & r < d[i+1,]$x)返回(数据.框架(x = r，y = 0))否则返回(NULL)}))d2 <- rbind(d,rx)ggplot(d2,aes(x,y)) + geom_area(data=subset(d2, y<=0), fill="pink")+ geom_area(data=subset(d2, y>=0), fill="lightblue") + geom_point()

生成以下输出:

We are trying to make an area plot with ggplot2 where the positive areas above the x-axis are one color and the negative areas are another.

Given this data set, I would like an area graph to shaded different colors on each side of the axis.

I can see a way to divide the dataset into two subsets, one positive where all negative values are zero, and one negative with all positive values of zero, and then plot these separately on the same axis, but it seems like there would be a more ggplot-like way to do it.

The solution posted at this question does not give accurate results (see below).

Example data shown accurately as a bar plot

Generated by this code:

# create some fake data with zero-crossings
yvals=c(2,2,-1,2,2,2,0,-1,-2,2,-2)
test = data.frame(x=seq(1,length(yvals)),y=yvals)

# generate the bar plot
ggplot(data=test,aes(x=x,y=y)) 
    + geom_bar(data=test[test$y>0,],aes(y=y), fill="blue",stat="identity", width=.5) 
    + geom_bar(data=test[test$y<0,],aes(y=y), fill="red",stat="identity", width=.5)

RLE Approach is not General

The RLE approach proposed on the other question produces artifacts related to zero-crossings when applied to our data set:

Generated by the following code (do not use):

# set up grouping function
rle.grp <- function(x) {
   xx <- rle(x)
   xx$values = seq_along(xx$values)
   inverse.rle(xx) }

# generate ribbon plot
ggplot(test, aes(x=x,y=y,group = factor(rle.grp(sign(y))))) + 
    geom_ribbon(aes(ymax = pmax(0,y),ymin = pmin(0,y),
   fill = factor(sign(y), levels = c(-1,0,1), labels = c('-','0','+')))) 
   + scale_fill_brewer(name = 'sign', palette = 'RdBu')

See ultimate answer below as suggested by @baptiste and Kohske.

解决方案

Per @baptiste's comment (since deleted) I would say this is the best answer. It is based on this post by Kohske. It adds new x-y pairs to the dataset at zero crossings, and generates the plot below:

# create some fake data with zero-crossings
yvals = c(2,2,-1,2,2,2,0,-1,-2,2,-2)
d = data.frame(x=seq(1,length(yvals)),y=yvals)

rx <- do.call("rbind",
   sapply(1:(nrow(d)-1), function(i){
   f <- lm(x~y, d[i:(i+1),])
   if (f$qr$rank < 2) return(NULL)
   r <- predict(f, newdata=data.frame(y=0))
   if(d[i,]$x < r & r < d[i+1,]$x)
      return(data.frame(x=r,y=0))
    else return(NULL)
 }))
 d2 <- rbind(d,rx)
 ggplot(d2,aes(x,y)) + geom_area(data=subset(d2, y<=0), fill="pink") 
     + geom_area(data=subset(d2, y>=0), fill="lightblue") + geom_point()

Generates the following output:

这篇关于基于值的曲线下填充区域的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！