当前位置： 文江博客话题详情

ggplot2 - 线上方的阴影区域

发布于 2024-11-26 01:25:42 字数 838 浏览 9 评论 0原文

我有一些数据限制在 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'”有些东西告诉我，我错误地实现了参数......

原文

I have some data that is constrained below a 1:1 line. I would to demonstrate this on a plot by lightly shading the area ABOVE the line, to draw the attention of the viewer to the area beneath the line.

I'm using qplot to generate the graphs. Quickly, I have;

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

but for the life of me, can't figure out how to easily shade the above area without plotting a separate object. Is there an easy fix for this?

EDIT

Ok, Joran, here is an example data set:

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

and here is the code that I'm using to plot it (I took your advice and have been looking up 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)

The error kicked back is: "object 'var1' not found" Something tells me that I'm implementing the argument incorrectly...

如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论， 你可以免费 注册 一个本站的账号。

评论（4）

自由如风 2024-12-03 01:25:42

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

我没有使用@Andrie此处引用的方法 因为我遇到了 ggplot 的问题，当您在边缘附近添加点时，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)

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

shade_above1

shade_above2

shade_below1

shade_below2

编辑

更新以使用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)

：产生以下输出：

在此处输入图像描述

Building on @Andrie's answer here is a more (but not completely) general solution that handles shading above or below a given line in most cases.

I did not use the method that @Andrie referenced here since I ran into issues with ggplot's tendency to automatically extend the plot extents when you add points near the edges. Instead, this builds the polygon points manually using Inf and -Inf as needed. A few notes:

  • The points have to be in the 'correct' order in the data frame, since ggplot plots the polygon in the order that the points appear. So it's not enough to get the vertices of the polygon, they must be ordered (either clockwise or counterclockwise) as well.

  • This solution assumes that the line you are plotting does not itself cause ggplot to extend the plot range. You'll see in my example that I pick a line to draw by randomly choosing two points in the data and drawing the line through them. If you try to draw a line too far away from the rest of you points, ggplot will automatically alter the plot ranges, and it becomes hard to predict what they will be.

First, here's the function that builds the polygon data frame:

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)
}

It expects the x and y ranges of your data (as in range()), the slope and intercept of the line you are going to plot, and whether you want to shade above or below the line. Here's the code I used to generate the following four examples:

#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)

And here are some examples of the results. If you find any bugs, of course, let me know so that I can update this answer...

shade_above1

shade_above2

shade_below1

shade_below2

EDIT

Updated to illustrate solution using OP's example data:

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)

and this produces the following output:

enter image description here

回复 原文
扶醉桌前 2024-12-03 01:25:42

据我所知，除了创建具有 alpha 混合填充的多边形之外，没有其他方法。例如：

df <- data.frame(x=1, y=1)
df_poly <- data.frame(
    x=c(-Inf, Inf, -Inf),
    y=c(-Inf, Inf, Inf)
)

ggplot(df, aes(x, y)) + 
    geom_blank() + 
    geom_abline(slope=1, intercept=0) + 
    geom_polygon(data=df_poly, aes(x, y), fill="blue", alpha=0.2) +

在此处输入图像描述

As far as I know there is no other way other than creating a polygon with alpha-blended fill. For example:

df <- data.frame(x=1, y=1)
df_poly <- data.frame(
    x=c(-Inf, Inf, -Inf),
    y=c(-Inf, Inf, Inf)
)

ggplot(df, aes(x, y)) + 
    geom_blank() + 
    geom_abline(slope=1, intercept=0) + 
    geom_polygon(data=df_poly, aes(x, y), fill="blue", alpha=0.2) +

enter image description here

回复 原文
锦爱 2024-12-03 01:25:42

实现此目的的一种简单方法是使用 geom_ribbon，并将 ymax 值设置为 Inf，并将 ymin 值设置为 Inf通过stat_function计算：

library(ggplot2)

myfun  <- function(x) x
myfun2 <- function(x) x^2

ggplot() +
  geom_function(fun = myfun) +
  geom_ribbon(stat = 'function', fun = myfun,
              mapping = aes(ymin = after_stat(y), ymax = Inf),
              fill = 'lightblue', alpha = 0.5)


ggplot() +
  geom_function(fun = myfun2) +
  geom_ribbon(stat = 'function', fun = myfun2,
              mapping = aes(ymin = after_stat(y), ymax = Inf),
              fill = 'lightblue', alpha = 0.5)

由 reprex 包 (v2.0.1) 创建于 2022 年 5 月 26 日< /sup>

One easy way to do this is to use geom_ribbon with the ymax value set to Inf, and the ymin value calculated by stat_function:

library(ggplot2)

myfun  <- function(x) x
myfun2 <- function(x) x^2

ggplot() +
  geom_function(fun = myfun) +
  geom_ribbon(stat = 'function', fun = myfun,
              mapping = aes(ymin = after_stat(y), ymax = Inf),
              fill = 'lightblue', alpha = 0.5)


ggplot() +
  geom_function(fun = myfun2) +
  geom_ribbon(stat = 'function', fun = myfun2,
              mapping = aes(ymin = after_stat(y), ymax = Inf),
              fill = 'lightblue', alpha = 0.5)

Created on 2022-05-26 by the reprex package (v2.0.1)

回复 原文
孤独岁月 2024-12-03 01:25:42

基于@joran的答案的最小修改版本：

library(ggplot2)
library(tidyr)
library(dplyr)

buildPoly <- function(slope, intercept, above, xr, yr){
  # By Joran Elias, @joran https://stackoverflow.com/a/6809174/1870254
  #Find where the line crosses the plot edges
  yCross <- (yr - intercept) / slope
  xCross <- (slope * xr) + intercept

  #Build polygon by cases
  if (above & (slope >= 0)){
    rs <- data.frame(x=-Inf,y=Inf)
    if (xCross[1] < yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(yCross[1],-Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] < yr[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] > yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
    if (xCross[2] > yr[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] < yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[2],Inf))
    }
    if (xCross[2] < yr[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] > yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(yCross[2],Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] > yr[1]){
      rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,-Inf))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
  }
  return(rs)
}

您还可以扩展 ggplot 像这样：

GeomSection <- ggproto("GeomSection", GeomPolygon, 
  default_aes = list(fill="blue", size=0, alpha=0.2, colour=NA, linetype="dashed"), 
  required_aes = c("slope", "intercept", "above"),
  draw_panel = function(data, panel_params, coord) {
    ranges <- coord$backtransform_range(panel_params)
    data$group <- seq_len(nrow(data))
    data <- data %>% group_by_all %>% do(buildPoly(.$slope, .$intercept, .$above, ranges$x, ranges$y)) %>% unnest
    GeomPolygon$draw_panel(data, panel_params, coord)
    }
  )

geom_section <- function (mapping = NULL, data = NULL, ..., slope, intercept, above, 
          na.rm = FALSE, show.legend = NA) {
  if (missing(mapping) && missing(slope) && missing(intercept) && missing(above)) {
    slope <- 1
    intercept <- 0
    above <- TRUE
  }
  if (!missing(slope) || !missing(intercept)|| !missing(above)) {
    if (missing(slope)) 
      slope <- 1
    if (missing(intercept)) 
      intercept <- 0
    if (missing(above)) 
      above <- TRUE
    data <- data.frame(intercept = intercept, slope = slope, above=above)
    mapping <- aes(intercept = intercept, slope = slope, above=above)
    show.legend <- FALSE
  }
  layer(data = data, mapping = mapping, stat = StatIdentity, 
        geom = GeomSection, position = PositionIdentity, show.legend = show.legend, 
        inherit.aes = FALSE, params = list(na.rm = na.rm, ...))
}

能够像使用它一样轻松地使用它geom_abline：

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

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_section(slope=1, intercept=0, above=TRUE)

此变体还有一个额外的优点，即它还可以处理多个斜率和非默认极限扩展。

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_section(data=data.frame(slope=c(-1,1), above=c(FALSE,TRUE), selected=c("selected","selected 2")), 
               aes(slope=slope, above=above, intercept=0, fill=selected), size=1) +
  expand_limits(x=3)

如上所述，但是有两个突出显示的区域和扩展的限制

Based on a minimally modified version of @joran's answer:

library(ggplot2)
library(tidyr)
library(dplyr)

buildPoly <- function(slope, intercept, above, xr, yr){
  # By Joran Elias, @joran https://stackoverflow.com/a/6809174/1870254
  #Find where the line crosses the plot edges
  yCross <- (yr - intercept) / slope
  xCross <- (slope * xr) + intercept

  #Build polygon by cases
  if (above & (slope >= 0)){
    rs <- data.frame(x=-Inf,y=Inf)
    if (xCross[1] < yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(yCross[1],-Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] < yr[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] > yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
    if (xCross[2] > yr[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] < yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[2],Inf))
    }
    if (xCross[2] < yr[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] > yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(yCross[2],Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] > yr[1]){
      rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,-Inf))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
  }
  return(rs)
}

you can also extend ggplot like this:

GeomSection <- ggproto("GeomSection", GeomPolygon, 
  default_aes = list(fill="blue", size=0, alpha=0.2, colour=NA, linetype="dashed"), 
  required_aes = c("slope", "intercept", "above"),
  draw_panel = function(data, panel_params, coord) {
    ranges <- coord$backtransform_range(panel_params)
    data$group <- seq_len(nrow(data))
    data <- data %>% group_by_all %>% do(buildPoly(.$slope, .$intercept, .$above, ranges$x, ranges$y)) %>% unnest
    GeomPolygon$draw_panel(data, panel_params, coord)
    }
  )

geom_section <- function (mapping = NULL, data = NULL, ..., slope, intercept, above, 
          na.rm = FALSE, show.legend = NA) {
  if (missing(mapping) && missing(slope) && missing(intercept) && missing(above)) {
    slope <- 1
    intercept <- 0
    above <- TRUE
  }
  if (!missing(slope) || !missing(intercept)|| !missing(above)) {
    if (missing(slope)) 
      slope <- 1
    if (missing(intercept)) 
      intercept <- 0
    if (missing(above)) 
      above <- TRUE
    data <- data.frame(intercept = intercept, slope = slope, above=above)
    mapping <- aes(intercept = intercept, slope = slope, above=above)
    show.legend <- FALSE
  }
  layer(data = data, mapping = mapping, stat = StatIdentity, 
        geom = GeomSection, position = PositionIdentity, show.legend = show.legend, 
        inherit.aes = FALSE, params = list(na.rm = na.rm, ...))
}

To be able to use it as easily as a geom_abline:

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

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_section(slope=1, intercept=0, above=TRUE)

two facets with points and a section of the plot areas hihlighted

This variant has the additional advantage that it also works with multiple slopes and non-default limit expansions.

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_section(data=data.frame(slope=c(-1,1), above=c(FALSE,TRUE), selected=c("selected","selected 2")), 
               aes(slope=slope, above=above, intercept=0, fill=selected), size=1) +
  expand_limits(x=3)

as above but with two highlighted areas and expanded limits

回复 原文
~没有更多了~

关于作者

ゃ人海孤独症

暂无简介

0 文章
0 评论
24 人气
发私信

相关话题

更多

热门标签

操作系统 程序设计 IT运维 Linux系统管理 JavaScript 服务器应用 solaris C/C++ PHP Shell BSD Vue.js aix Oracle Python HTML 系统管理 HTML5 CSS 前端
更多

推荐作者

lixs

文章 0 评论 0

敷衍　

文章 0 评论 0

盗梦空间

文章 0 评论 0

tian

文章 0 评论 0

13375331123

文章 0 评论 0

你对谁都笑

文章 0 评论 0

更多

友情链接

文江博客
    我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站，即表示您同意使用 Cookies 和您的相关数据。
    原文