Create a colour blind test with ggplot

Question

I would like to create a colour blind test, similar to that below, using ggplot.

The basic idea is to use geom_hex (or perhaps a voronoi diagram, or possibly even circles as in the figure above) as the starting point, and define a dataframe that, when plotted in ggplot, produces the image.

We would start by creating a dataset, such as:

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

then plot this:

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

which gives the image below:

The main missing step is to create a dataset that actually plots a meaningful symbol (letter or number), and I'm not sure how best to go about this without painstakingly mapping the coordinates. Ideally one would be able to read in the coordinates perhaps from an image file.

Finally, a bit of tidying up could round the plot edges by removing the outlying points.

All suggestions are very welcome!

EDIT

Getting a little closer to what I'm after, we can use the image below of the letter 'e':

Using the imager package, we can read this in and convert it to a dataframe:

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

then plot that dataframe using 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()

If we use geom_hex instead of geom_raster, we can get the following plot:

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()

so, getting there but clearly still a long way off...

Seems pretty close - looks like you need to pad the edges and add in some random noise. Maybe thicken up the lines too? — Gregor Thomas, Apr 18 '17 at 18:37
@Gregor Thanks. Do you know how would you do those things fairly simply? — Jonny, Apr 18 '17 at 18:50
You'll get a pattern more like the original if you generate a dense hardcore point pattern using the `spatstat` package... I'll investigate... — Spacedman, Apr 18 '17 at 19:08
Note these are called Ishihara tests: https://en.wikipedia.org/wiki/Ishihara_test — Spacedman, Apr 18 '17 at 19:11
The `packcircles` package might help with the layout: https://github.com/mbedward/packcircles/blob/master/vignettes/graph_packing.Rmd — Spacedman, Apr 18 '17 at 19:38

score 5 · Accepted Answer · answered May 16 '17 at 08:26

Here's an approach for creating this plot:

Packages you need:

library(tidyverse)
library(packcircles)

Get image into a 2D matrix (x and y coordinates) of values. To do this, I downloaded the .png file of the e as "e.png" and saved in my working directory. Then some processing:

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)

Next, create a whole lot of circles! I did this based on 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()

Finally, interpolate the image pixel values for the centre of each circle. This will indicate whether a circle is centered over the shape or not. Add some noise to get variance in colour and plot.

# 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"

To get colours right, tweak them in scale_fill_gradient

Wow, great job! Thanks so much for the great solution! – Jonny May 16 '17 at 10:03 — Jonny, May 16 '17 at 10:03

Create a colour blind test with ggplot

EDIT

1 Answers1