r - 面板的淡入淡出以指示正在进行的时间

Question

金融时报有一篇关于游戏机的有趣文章，“游戏机结束了吗？ ”，用直方图显示游戏机的时间线。

对于当前一代（Xbox One 和 PS4、Switch），框的右侧被模糊以表示“正在进行”。所有其他盒子都有硬边。

出于版权原因，我不会显示整个图表，但这是其中的一部分。我相信该图是在 R 中使用 ggplot2 生成的。

我找不到如何为盒子实现这种效果 - 只有点。是否有几何或技巧来实现这种模糊的边缘？

这是一个简单图形的代码来说明：

library(tidyverse)
tribble(~device, ~start, ~end, ~num, ~off,
        "x", 2015, 2020, 120, 0,
        "y", 2016, 2022, 150, 120,
        "z", 2017, 2023, 200, 270) %>% 
    ggplot() +
    geom_rect(aes(xmin = start, xmax = end, ymin = off, ymax = off+num, fill = device)) +
    geom_vline(aes(xintercept = 2020.5), lwd = 2, lty = 2) +
    geom_label(aes(x = 2020.5, y = 0, label = "Today")) +
    geom_text(aes(x = 2022, y = 320, label = "The right edge of the\nblue and green boxes\nshould be fuzzy or faded out...")) +
    geom_text(aes(x = 2022, y = 90, label = "...but not the red box")) +
    guides(fill = "none") +
    theme_minimal()

谢谢，

TC

标签： rggplot2

Answer 1

我使用划分空间然后线性减小 alpha 的想法。

编辑：

添加用于生成新数据集和附加绘图的函数。另外还有一个新的函数ggplot2用法。guides

data_rect_blur <- function(data, step, edge) {
  stopifnot(inherits(data, "data.frame"))
  stopifnot(is.numeric(step))
  stopifnot(is.numeric(edge))

  require("dplyr", quietly = TRUE)
  require("tidyr", quietly = TRUE)
  require("ggplot2", quietly = TRUE)

  data$edge <- edge
  data$mm <- pmin(data$edge, data$end)
  data$rest <- (data$end - data$edge)
  data$rest_t <- data$rest > 0

  rm_last <- function(x) {
    x[-length(x)]
  }

  df2 <- data %>%
    group_by(device) %>%
    mutate(
      seqe = list(seq(from = edge, to = if_else(rest_t, end, edge), by = step)),
      seqe_s = list(rm_last(seq(from = edge, to = if_else(rest_t, end, edge), by = step))),
      seqe_e = list((seq(from = edge, to = if_else(rest_t, end, edge), by = step))[-1]),
      alps = list(seq(0.8, 0, length = length(seqe[[1]]) - 1))
    )

  df3 <- tidyr::unnest(df2, cols = c(seqe_s, seqe_e, alps))

  res <- list(base = df2, add = df3)

  res
}

df <- dplyr::tribble(
  ~device, ~start, ~end, ~num, ~off,
  "x", 2015, 2020, 120, 0,
  "y", 2016, 2022, 150, 120,
  "z", 2017, 2023, 200, 270
)



gg_rect_blur <- function(df, step, edge) {
  stopifnot(inherits(df, "data.frame"))
  df_blur_list <- data_rect_blur(df, step, edge)
  ggplot(df) +
    geom_rect(data = df_blur_list$base, aes(xmin = start, xmax = mm, ymin = off, ymax = off + num, fill = device)) +
    geom_rect(data = df_blur_list$add, aes(xmin = seqe_s, xmax = seqe_e, ymin = off, ymax = off + num, fill = device, alpha = alps))
}

gg_rect_blur(df, 0.1, 2020.05) +
  geom_vline(aes(xintercept = 2020.5), lwd = 2, lty = 2) +
  geom_label(aes(x = 2020.5, y = 0, label = "Today")) +
  guides(fill = "none") +
  geom_text(aes(x = 2022, y = 320, label = "The right edge of the\nblue and green boxes\nshould be fuzzy or faded out...")) +
  geom_text(aes(x = 2022, y = 90, label = "...but not the red box")) +
  theme_minimal() +
  theme(legend.position = "none")
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

^{由reprex 包于 2021-07-07 创建 (v2.0.0 )}