GC4F5HY Shredded – JPS09

[This article was first published on geocacheR, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

This puzzle is in Jersey and features an image, which, judging by the colours and rough shape, is obviously a scrambled version of a map of Jersey. The text confirms that a map has been “shredded”, and your task is to unshred it.

I’m intrigued to know how they did this in the first place — I sincerely hope it wasn’t done by hand. There are 100 slices there, and it’d take forever to do using Photoshop. Similarly, I didn’t want to stitch it back together by hand, so… what about the programmatic approach?

There are two main challenges here. Firstly, I need to divide the image up correctly. Luckily, the cache owner has left a couple of pixels’ white space between each strip. That should be easy to detect. Secondly, we have to decide how to stick them back together. The way I chose to do this was to take the right-hand edge of one strip, and compare the RGB values from the left hand edges of the others. Whichever one gives the best match gets glued on, and we start again, repeating until we have just one strip left.

I’m using the jpeg package, which converts a jpeg file into a three dimensional array representing the red, green and blue pixels.

library(jpeg)
library(plyr)
library(tidyverse)
library(magrittr)
library(abind)


## get the image
dr <- "C:/Users/alunh/OneDrive/Documents/Repos/geo2/Solving/"
shred <- readJPEG(paste0(dr, "GC4F5HY_shredded-jps09.jpg")) * 255

## find the white lines
whiteness <- apply(shred, 1:2, sum) strips <- whiteness %>% apply(2, sum)
strips %>% plot()

This is great! There’s a clear demarcation between the white separating lines and the strips.

## assume everything above 540,000 is a dividing line
divides <- which(strips > 540000)
divides <- divides[-1] divides <- rev(rev(divides)[-1]) divides %<>% matrix(ncol = 2, byrow = TRUE)
## split the original image into strips
shredl <- apply(divides, 1, function(q) {
  shred[, (q[1]+1):(q[2]-1), ]
}) 

Now we have a list of strips, we need a function to compare two strips, and another one to bind two given strips together.

## takes two strips and compares the right v left edges
compare_strips <- function(stripsl, x, y) {
  r <- stripsl[[x]][, ncol(stripsl[[x]]), 1] - stripsl[[y]][, 1, 1]
  g <- stripsl[[x]][, ncol(stripsl[[x]]), 2] - stripsl[[y]][, 1, 2]
  b <- stripsl[[x]][, ncol(stripsl[[x]]), 3] - stripsl[[y]][, 1, 3]
  r %<>% abs() %>% sum()
  g %<>% abs() %>% sum()
  b %<>% abs() %>% sum()
  r+g+b
}
## bind two given strips together
bindem <- function(stripsl, lft, rgt) {
  bound <- abind(stripsl[[lft]], stripsl[[rgt]], along=2)#[,,1] %>% image()
  stripsl <- c(stripsl[-c(lft, rgt)], list(bound))
} 

Now the hard work is done, we can run the strips through:

for (qq in 1:99) {
wm <- sapply(2:length(shredl), function(q) compare_strips(shredl, 1, q)) %>% which.min() + 1
shredl <- bindem(shredl, 1, wm)
}

And finally, we’ll export the solution to see whether its legible.

(shredl[[length(shredl)]]/255) %>%
jpeg::writeJPEG(target = paste0(dr, "GC4F5HY_shredded-jps09_solved.jpg"))

And here it is. I’ve censored the final coordinates out of respect for the cache owner. You can see the algorithm for stitching together the strips hasn’t worked perfectly, but the map and coordinates are legible. Success!

And yes, the coordinates are upside down. That’s a feature of the puzzle, I guess. The strips I’ve output are oriented the same way as in the original, as you can see from the town names in the map itself.

To leave a comment for the author, please follow the link and comment on their blog: geocacheR.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)