使用 ggplot 创建色盲测试

Question

我想使用 ggplot 创建一个类似于下面的色盲测试。

基本思想是使用geom_hex（或者可能是 voronoi 图，或者甚至可能是上图中的圆圈）作为起点，并定义一个数据框，当在 ggplot 中绘制时，该数据框会生成图像。

我们将从创建数据集开始，例如：

df <- data.frame(x = rnorm(10000), y = rnorm(10000))

然后绘制这个：

ggplot(df, aes(x, y)) +
  geom_hex() + 
  coord_equal() +
  scale_fill_gradient(low = "red", high = "green", guide = FALSE) +
  theme_void()

它给出了下面的图像：

主要缺少的步骤是创建一个实际绘制有意义符号（字母或数字）的数据集，我不确定如何在不费力地映射坐标的情况下最好地进行此操作。理想情况下，也许可以从图像文件中读取坐标。

最后，稍微整理一下就可以通过移除离群点来使绘图边缘变圆。

非常欢迎所有建议！

编辑

离我所追求的更近一点，我们可以使用下面的字母“e”的图片：

使用imager 包，我们可以将其读入并将其转换为数据帧：

img <- imager::load.image("e.png")
df <- as.data.frame(img)

然后使用geom_raster 绘制该数据框：

ggplot(df, aes(x, y)) +
  geom_raster(aes(fill = value)) +
  coord_equal() +
  scale_y_continuous(trans = scales::reverse_trans()) +
  scale_fill_gradient(low = "red", high = "green", guide = FALSE) +
  theme_void()

如果我们使用geom_hex而不是geom_raster，我们可以得到如下图：

ggplot(df %>% filter(value %in% 1), aes(x, y)) +
  geom_hex() + 
  coord_equal() +
  scale_y_continuous(trans = scales::reverse_trans()) +
  scale_fill_gradient(low = "red", high = "green", guide = FALSE) +
  theme_void()

所以，到达那里，但显然还有很长的路要走......

Answer 1

这是创建此图的一种方法：

---

你需要的包：

library(tidyverse)
library(packcircles)

将图像转换为值的二维矩阵（x 和 y 坐标）。为此，我将 e 的 .png 文件下载为“e.png”并保存在我的工作目录中。然后进行一些处理：

img <- png::readPNG("e.png")

# From http://stackoverflow.com/questions/16496210/rotate-a-matrix-in-r
rotate <- function(x) t(apply(x, 2, rev))

# Convert to one colour layer and rotate it to be in right direction
img <- rotate(img[,,1])

# Check that matrix makes sense:
image(img)

接下来，创建一大堆圈子！我是根据this post 做的。

# Create random "circles"
# *** THESE VALUES WAY NEED ADJUSTING
ncircles <- 1200
offset   <- 100
rmax     <- 80
x_limits <- c(-offset, ncol(img) + offset)
y_limits <- c(-offset, nrow(img) + offset)

xyr <- data.frame(
  x = runif(ncircles, min(x_limits), max(x_limits)),
  y = runif(ncircles, min(y_limits), max(y_limits)),
  r = rbeta(ncircles, 1, 10) * rmax)

# Find non-overlapping arrangement
res <- circleLayout(xyr, x_limits, y_limits, maxiter = 1000)
cat(res$niter, "iterations performed")
#> 1000 iterations performed

# Convert to data for plotting (just circles for now)
plot_d <- circlePlotData(res$layout)

# Check circle arrangement
ggplot(plot_d) + 
  geom_polygon(aes(x, y, group=id), colour = "white", fill = "skyblue") +
  coord_fixed() +
  theme_minimal()

最后，为每个圆的中心插入图像像素值。这将指示一个圆是否以形状为中心。添加一些噪点以获得颜色和绘图的差异。

# Get x,y positions of centre of each circle
circle_positions <- plot_d %>%
  group_by(id) %>% 
  summarise(x = min(x) + (diff(range(x)) / 2),
            y = min(y) + (diff(range(y)) / 2))

# Interpolate on original image to get z value for each circle
circle_positions <- circle_positions %>% 
  mutate(
    z = fields::interp.surface(
      list(x = seq(nrow(img)), y = seq(ncol(img)), z = img),
      as.matrix(.[, c("x", "y")])),
    z = ifelse(is.na(z), 1, round(z))  # 1 is the "empty" area shown earlier
  )

# Add a little noise to the z values
set.seed(070516)
circle_positions <- circle_positions %>%
  mutate(z = z + rnorm(n(), sd = .1))

# Bind z value to data for plotting and use as fill
plot_d %>% 
  left_join(select(circle_positions, id, z)) %>% 
  ggplot(aes(x, y, group = id, fill = z)) + 
  geom_polygon(colour = "white", show.legend = FALSE) +
  scale_fill_gradient(low = "#008000", high = "#ff4040") +
  coord_fixed() +
  theme_void()
#> Joining, by = "id"

要获得正确的颜色，请在 scale_fill_gradient 中调整它们