r - 使用 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)

将图像转换为值的 2D 矩阵(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 中调整它们