如何模糊ggplot中的部分情节？

Question

有没有办法模糊情节的某个部分ggplot？

例如，考虑下图：

library(ggplot2)
library(magrittr)

p <- 
  mtcars %>%
  ggplot(aes(x = disp, y = mpg)) +
  geom_line() +
  theme_minimal() +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.background = element_blank()) 

p +
  annotate("rect", xmin = 100, xmax = 200, ymin = 15, ymax = 30,
           alpha = .1,fill = "red") 

^{由reprex 包( v2.0.0 )于 2021 年 7 月 22 日创建}

---

期望输出

我想在p当前有红色矩形的区域上应用模糊效果。我正在寻找的演示：

这甚至可能吗？

---

参考：python 中的类似问题（和答案）。

Answer 1

您可以使用 ggfx 的遮罩和 ageom_rect()来确定应用效果的区域。下面的例子：

library(ggplot2)
library(magrittr)
library(ggfx)

# Plot without line
p <- 
  mtcars %>%
  ggplot(aes(x = disp, y = mpg)) +
  theme_minimal() +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.background = element_blank()) 

# Add mask as a reference
p + 
  as_reference(
    geom_rect(
      aes(xmin = 100, xmax = 200, ymin = 15, ymax = 30),
      inherit.aes = FALSE
    ),
    id = "draw_area" # <- set some name
  ) +
  # Plot blurry part with mask
  with_mask(
    with_blur(geom_line(), sigma = 5),
    mask = ch_alpha("draw_area")
  ) +
  # Plot crisp part with inverted mask
  with_mask(
    geom_line(),
    mask = ch_alpha("draw_area"),
    invert = TRUE
  )

^{由reprex 包(v1.0.0)于 2021 年 7 月 22 日创建}

如果你打算经常使用它，你可以像这样创建一个包装函数：

# trbl: Top, Right, Bottom, Left
area_effect <- function(layer, effect = with_blur, ..., trbl) {
  id <- rlang::hash(trbl)
  ref <- as_reference(
    annotate(
      "rect", xmin = trbl[4], xmax = trbl[2], ymin = trbl[3], ymax = trbl[1]
    ),
    id = id
  )
  mask1 <- with_mask(
    effect(layer, ...),
    mask = ch_alpha(id)
  )
  mask2 <- with_mask(
    layer, mask = ch_alpha(id), invert = TRUE
  )
  list(
    ref, mask1, mask2
  )
}

p +
  area_effect(geom_line(), trbl = c(30, 200, 15, 100), sigma = 5)

Answer 2

我们可以将数据分成两部分：正常绘图数据，模糊数据：

library(ggplot2)
library(ggfx)

d1 <- mtcars
d1 <- d2 <- d1[ order(d1$disp), ]

ix1 <- range(which(d1$disp > 100 & d1$disp < 200)) + c(1, -1)
ix2 <- which(d1$disp < 100 | d1$disp > 200)

d1[ ix1[ 1 ]:ix1[ 2 ], "mpg" ] <- NA
d2[ ix2, "mpg" ] <- NA

ggplot() +
  geom_line(aes(x = disp, y = mpg), d1) +
  with_blur(
    geom_line(aes(x = disp, y = mpg), d2),
    sigma = unit(1, 'mm')
  )