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

接下来,创建一个很多圈子!我是根据这篇文章做到的.

# 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