代码之家  ›  专栏  ›  技术社区  ›  tjebo

用几何图形创建的线之间的打印功能区

  •  3
  • tjebo  · 技术社区  · 6 年前

    我试图在用创建的线之间创建一个阴影区域 geom_abline

    require(ggplot2)
    
    val_intcpt <- c(-1,1)
    
    ggplot() + 
      geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
      geom_abline(intercept = 0, slope = 1, linetype = 'dashed') +
      geom_abline(intercept = val_intcpt, slope = 1, linetype = 'dotted') 
    

    enter image description here

    我们的想法是在虚线之间的区域加上阴影。

    • geom_ribbon 不起作用,因为它需要 ymin/ymax 而且我没有这个信息(当然,我可以硬编码一个数据帧,但这并不是一个很好的解决方案,因为它不会自动为任何给定的数据工作)。
    • 使用 ggplot_build 没有帮助,因为数据帧不提供X/Y数据。

    我肯定我漏掉了一些很明显的东西:(

    1 回复  |  直到 5 年前
        1
  •  3
  •   Z.Lin    5 年前

    也许画一个多边形?

    # let ss be the slope for geom_abline
    ss <- 1
    
    p <- ggplot() + 
      geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
      geom_abline(intercept = 0, slope = ss, linetype = 'dashed') +
      geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dotted') 
    
    # get plot limits
    p.x <- layer_scales(p)$x$get_limits()
    p.y <- layer_scales(p)$y$get_limits()
    
    # create polygon coordinates, setting x positions somewhere
    # beyond the current plot limits
    df <- data.frame(
      x = rep(c(p.x[1] - (p.x[2] - p.x[1]),
                p.x[2] + (p.x[2] - p.x[1])), each = 2),
      intcpt = c(val_intcpt, rev(val_intcpt))
    ) %>%
      mutate(y = intcpt + ss * x)
    
    # add polygon layer, & constrain to previous plot limits
    p +
      annotate(geom = "polygon",
               x = df$x,
               y = df$y,
               alpha = 0.2) +
      coord_cartesian(xlim = p.x, ylim = p.y)
    

    plot

    解释其工作原理

    让我们考虑一个正常的曲线图:

    ss <- 0.75 # this doubles up as illustration for different slope values
    
    p <- ggplot() +
      geom_point(data = iris, aes(x = Petal.Length, y = Sepal.Width), color = "grey75") +
      geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dashed', 
                  color = c("blue", "red"), size = 1) +
      annotate(geom = "text", x = c(6, 3), y = c(2.3, 4), color = c("blue", "red"), size = 4,
               label = c("y == a[1] + b*x", "y == a[2] + b*x"), parse = TRUE)
      coord_fixed(ratio = 1.5) +
      theme_classic()
    
    p + ggtitle("Step 0: Construct plot")
    

    step 0

    达到极限 p.x / p.y p ,查看绘图本身中的相应位置(紫色):

    p.x <- layer_scales(p)$x$get_limits()
    p.y <- layer_scales(p)$y$get_limits()
    
    p1 <- p + 
      geom_point(data = data.frame(x = p.x, y = p.y) %>% tidyr::complete(x, y),
                 aes(x = x, y = y), 
                 size = 2, stroke = 1, color = "purple")
    
    p1 + ggtitle("Step 1: Get plot limits")
    

    step 1

    注意X轴极限值(仍为紫色):

    p2 <- p1 +
      annotate(geom = "text", x = p.x, y = min(p.y), label = c("x[0]", "x[1]"), 
               vjust = -1, parse = TRUE, color = "purple", size = 4)
    
    p2 + 
      ggtitle("Step 2: Note x-axis coordinates of limits") +
      annotate(geom = "segment", 
               x = p.x[1] + diff(p.x), 
               xend = p.x[2] - diff(p.x), 
               y = min(p.y), yend = min(p.y),
               color = "purple", linetype = "dashed", size = 1,
               arrow = arrow(ends = "both")) +
      annotate(geom = "text", x = mean(p.x), y = min(p.y), label = "x[1] - x[0]",
               vjust = -1, parse = TRUE, color = "purple", size = 4)
    

    step 2

    我们要构造一个多边形(准确地说,是平行四边形),其角点远远超出原始绘图的范围,这样在绘图中就看不到任何角点。实现这一点的一种方法是采用现有绘图的X轴限制,并将其向外移动与现有绘图的X轴范围相同的量:得到的位置(黑色)非常远:

    p3 <- p2 +
      annotate(geom = "point", 
               x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
               shape = 4, size = 1, stroke = 2) +
      annotate(geom = "text", 
               x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
               label = c("x[0] - (x[1] - x[0])", "x[1] + (x[1] - x[0])"),
               vjust = -1, parse = TRUE, size = 5, hjust = c(0, 1))
    
    p3 +
      ggtitle("Calculate x-axis coordinates of two points far beyond the limits") +
      annotate(geom = "segment", 
               x = p.x, 
               xend = p.x + c(-diff(p.x), diff(p.x)), 
               y = min(p.y), yend = min(p.y),
               linetype = "dashed", size = 0.5,
               arrow = arrow(ends = "both", length = unit(0.1, "inches"))) 
    

    step 3

    我们可以导出与x轴位置相关的对应y值 geom_abline (红色/蓝色),使用标准 y = a + b * x 公式:

    p4 <- p3 + 
      annotate(geom = "point",
               x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
               y = val_intcpt[2] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
               shape = 8, size = 2, stroke = 2, col = "red") + 
      annotate(geom = "point",
               x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
               y = val_intcpt[1] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
               shape = 8, size = 2, stroke = 2, col = "blue")
    
    p4 +
      ggtitle("Calculate the corresponding y coordinates for both ab-lines") +
      annotate(geom = "text",
               x = p.x[1] - diff(p.x),
               y = val_intcpt + ss * (p.x[1] - diff(p.x)),
               label = c("y == a[1] + b * (x[0] - (x[1] - x[0]))", 
                         "y == a[2] + b * (x[0] - (x[1] - x[0]))"), 
               hjust = -0.2, parse = TRUE, 
               color = c("blue", "red")) +
      annotate(geom = "text",
               x = p.x[2] + diff(p.x),
               y = val_intcpt + ss * (p.x[2] + diff(p.x)),
               label = c("y == a[1] + b * (x[1] + (x[1] - x[0]))", 
                         "y == a[2] + b * (x[1] + (x[1] - x[0]))"), 
               hjust = 1.2, parse = TRUE, 
               color = c("blue", "red"))
    

    step 4

    既然我们已经得到了角点的x/y坐标,那么构造多边形只需将它们连接在一起即可:

    p5 <- p4 +
      annotate(geom = "polygon",
               x = rep(c(p.x[1] - diff(p.x),
                         p.x[2] + diff(p.x)),
                       each = 2),
               y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                     rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
               fill = "yellow", alpha = 0.4)
    
    p5 +
      ggtitle("Step 5: Draw polygon based on calculated coordinates") +
      annotate(geom = "label",
               x = rep(c(p.x[1] - diff(p.x),
                         p.x[2] + diff(p.x)),
                       each = 2),
               y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                     rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
               label = c("list(x[0] - (x[1] - x[0]), a[1] + b*(x[0] - (x[1] - x[0])))",
                         "list(x[0] - (x[1] - x[0]), a[2] + b*(x[0] - (x[1] - x[0])))",
                         "list(x[1] + (x[1] - x[0]), a[2] + b*(x[1] + (x[1] - x[0])))",
                         "list(x[1] + (x[1] - x[0]), a[1] + b*(x[1] + (x[1] - x[0])))"),
               parse = TRUE, hjust = rep(c(0, 1), each = 2))
    

    step 5

    应用原始绘图范围,&我们有一个多边形,假装是填充的功能区,角安全地隐藏在视线之外:

    p5 +
      ggtitle("Step 6: Reset plot range to original range") +
      coord_fixed(ratio = 1.5, xlim = p.x, ylim = p.y) 
    

    step 6

    (注意:这里有很多不必要的代码,用于标记和着色中间步骤,以便于说明。)为了实际使用,根据我最初的解决方案,这些都不是必需的。但就解释而言,要么是这个,要么是我糟糕的笔迹草图+扫描…)