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...

Answer 1

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