Create a color track test with ggplot

Question

I would like to create a blind color test similar to the one below using ggplot.

The main idea is to use geom_hex as a starting point (or, possibly, a voronoi diagram or, possibly, even circles, as in the figure above), and define a data frame that, when built in ggplot, creates an image.

Let's start by creating a dataset, for example:

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

then build 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 displays a meaningful character (letter or number), and I'm not sure how best to do this without carefully matching the coordinates. Ideally, you could read the coordinates, possibly from an image file.

Finally, you can remove a little around the edges of the plot, removing distant points.

All suggestions are welcome!

EDIT

Going closer to what I need, we can use the image below the letter "e":

Using the imager package, we can read this and convert it to a data framework:

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

then build this data file with 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 graph:

 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 get there, but obviously still far away ...

Answer 1

Here's the approach used to create this graph:

---

Required Packages:

 library(tidyverse) library(packcircles) 

Get the image in a 2D matrix (x and y coordinates) of the values. To do this, I downloaded the .png file e as "e.png" and saved it in the 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) 

Then create a 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 pixel values ​​of the image for the center of each circle. This will indicate whether the circle is in shape or not. Add some noise to get a variance in color and graphics.

 # 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 the right colors, set them to scale_fill_gradient