r - ggplot2 - 线上方的阴影区域

Question

我有一些数据限制在 1:1 线以下。我将通过对线上方的区域轻轻涂上阴影来在绘图上演示这一点，以将观看者的注意力吸引到线下方的区域。

我正在使用 qplot 生成图表。很快，我就有了；

qplot(x,y)+geom_abline(slope=1)

但对于我来说，无法弄清楚如何在不绘制单独对象的情况下轻松地对上述区域进行着色。有没有简单的解决办法？

<小时/>

编辑

好的，Joran，这是一个示例数据集:

 df=data.frame(x=runif(6,-2,2),y=runif(6,-2,2),
   var1=rep(c("A","B"),3),var2=rep(c("C","D"),3))
 df_poly=data.frame(x=c(-Inf, Inf, -Inf),y=c(-Inf, Inf, Inf))

这是我用来绘制它的代码(我听取了你的建议并一直在查找ggplot()):

ggplot(df,aes(x,y,color=var1))+
 facet_wrap(~var2)+
 geom_abline(slope=1,intercept=0,lwd=0.5)+
 geom_point(size=3)+
 scale_color_manual(values=c("red","blue"))+
 geom_polygon(data=df_poly,aes(x,y),fill="blue",alpha=0.2)

返回的错误是:“未找到对象'var1'”有些东西告诉我，我错误地实现了参数...

Answer 1

基于@Andrie的答案，这是一个更通用的解决方案(但不完全)，在大多数情况下处理给定线上方或下方的阴影。

我没有使用@Andrie引用的方法here因为我遇到了 ggplot 的问题当您在边缘附近添加点时，会自动扩展绘图范围。相反，这会使用 Inf 手动构建多边形点。和-Inf如所须。一些注意事项:

• 数据框中的点必须处于“正确”的顺序，因为 ggplot按照点出现的顺序绘制多边形。所以仅仅获取多边形的顶点是不够的，它们还必须被排序(顺时针或逆时针)。

• 此解决方案假设您正在绘制的线本身不会导致 ggplot以扩大绘图范围。您将在我的示例中看到，我通过随机选择数据中的两个点并通过它们绘制线条来选择要绘制的线条。如果您尝试画一条距离其他点太远的线，ggplot会自动改变绘图范围，并且很难预测它们会是什么。

首先，这是构建多边形数据框的函数:

buildPoly <- function(xr, yr, slope = 1, intercept = 0, above = TRUE){
    #Assumes ggplot default of expand = c(0.05,0)
    xrTru <- xr + 0.05*diff(xr)*c(-1,1)
    yrTru <- yr + 0.05*diff(yr)*c(-1,1)

    #Find where the line crosses the plot edges
    yCross <- (yrTru - intercept) / slope
    xCross <- (slope * xrTru) + intercept

    #Build polygon by cases
    if (above & (slope >= 0)){
        rs <- data.frame(x=-Inf,y=Inf)
        if (xCross[1] < yrTru[1]){
            rs <- rbind(rs,c(-Inf,-Inf),c(yCross[1],-Inf))
        }
        else{
            rs <- rbind(rs,c(-Inf,xCross[1]))
        }
        if (xCross[2] < yrTru[2]){
            rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,Inf))
        }
        else{
            rs <- rbind(rs,c(yCross[2],Inf))
        }
    }
    if (!above & (slope >= 0)){
        rs <- data.frame(x= Inf,y= -Inf)
        if (xCross[1] > yrTru[1]){
            rs <- rbind(rs,c(-Inf,-Inf),c(-Inf,xCross[1]))
        }
        else{
            rs <- rbind(rs,c(yCross[1],-Inf))
        }
        if (xCross[2] > yrTru[2]){
            rs <- rbind(rs,c(yCross[2],Inf),c(Inf,Inf))
        }
        else{
            rs <- rbind(rs,c(Inf,xCross[2]))
        }
    }
    if (above & (slope < 0)){
        rs <- data.frame(x=Inf,y=Inf)
        if (xCross[1] < yrTru[2]){
            rs <- rbind(rs,c(-Inf,Inf),c(-Inf,xCross[1]))
        }
        else{
            rs <- rbind(rs,c(yCross[2],Inf))
        }
        if (xCross[2] < yrTru[1]){
            rs <- rbind(rs,c(yCross[1],-Inf),c(Inf,-Inf))
        }
        else{
            rs <- rbind(rs,c(Inf,xCross[2]))
        }
    }
    if (!above & (slope < 0)){
        rs <- data.frame(x= -Inf,y= -Inf)
        if (xCross[1] > yrTru[2]){
            rs <- rbind(rs,c(-Inf,Inf),c(yCross[2],Inf))
        }
        else{
            rs <- rbind(rs,c(-Inf,xCross[1]))
        }
        if (xCross[2] > yrTru[1]){
            rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,-Inf))
        }
        else{
            rs <- rbind(rs,c(yCross[1],-Inf))
        }
    }

    return(rs)
}

它期望数据的 x 和 y 范围(如 range() )、要绘制的线的斜率和截距，以及是否要在线上方或下方绘制阴影。这是我用来生成以下四个示例的代码:

#Generate some data
dat <- data.frame(x=runif(10),y=runif(10))

#Select two of the points to define the line
pts <- dat[sample(1:nrow(dat),size=2,replace=FALSE),]

#Slope and intercept of line through those points
sl <- diff(pts$y) / diff(pts$x)
int <- pts$y[1] - (sl*pts$x[1])

#Build the polygon
datPoly <- buildPoly(range(dat$x),range(dat$y),
            slope=sl,intercept=int,above=FALSE)

#Make the plot
p <- ggplot(dat,aes(x=x,y=y)) + 
        geom_point() + 
        geom_abline(slope=sl,intercept = int) +
        geom_polygon(data=datPoly,aes(x=x,y=y),alpha=0.2,fill="blue")
print(p)    

以下是一些结果示例。当然，如果您发现任何错误，请告诉我，以便我可以更新此答案...

编辑

更新以使用 OP 的示例数据说明解决方案:

set.seed(1)
dat <- data.frame(x=runif(6,-2,2),y=runif(6,-2,2),
        var1=rep(c("A","B"),3),var2=rep(c("C","D"),3))
#Create polygon data frame
df_poly <- buildPoly(range(dat$x),range(dat$y))

ggplot(data=dat,aes(x,y)) + 
    facet_wrap(~var2) +
    geom_abline(slope=1,intercept=0,lwd=0.5)+
    geom_point(aes(colour=var1),size=3) + 
    scale_color_manual(values=c("red","blue"))+
    geom_polygon(data=df_poly,aes(x,y),fill="blue",alpha=0.2)

这会产生以下输出: