# Cracking Safe Cracker with R

**TRinker's R Blog » R**, 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.

My wife got me a Safe Cracker 40 puzzle a while back. I believe I misplaced the solution some time back. The company, Creative Crafthouse, stands behind their products. They had amazing customer service and promptly supplied me with a solution. I’d supply the actual wheels as a cutout paper version but this is their property so this blog will be more enjoyable if you buy yourself a Safe Cracker 40 as well (I have no affiliation with the company, just enjoy their products and they have great customer service). Here’s what the puzzle looks like:

There are 26 columns of 4 rows. The goal is to line up the dials so you have all columns summing to 40. It is somewhat difficult to explain how the puzzle moves, but the dials control two rows. The outer row of the dial is notched and only covers every other cell of the row below. The outer most row does not have a notched row covering it. I believe there are 16^4 = 65536 possible combinations. I think it’s best to understand the logic by watching the video:

I enjoy puzzles but after a year didn’t solve it. This one begged me for a computer solution, and so I decided to use R to force the solution a bit. To me the computer challenge was pretty fun in itself.

Here are the dials. The NAs represents the notches in the notched dials. I used a list structure because it helped me sort things out. Anything in the same list moves together, though are not the same row. Row a is the outer most wheel. Both b and b_1 make up the next row, and so on.

L1 <- list(#outer a = c(2, 15, 23, 19, 3, 2, 3, 27, 20, 11, 27, 10, 19, 10, 13, 10), b = c(22, 9, 5, 10, 5, 1, 24, 2, 10, 9, 7, 3, 12, 24, 10, 9) ) L2 <- list( b_i = c(16, NA, 17, NA, 2, NA, 2, NA, 10, NA, 15, NA, 6, NA, 9, NA), c = c(11, 27, 14, 5, 5, 7, 8, 24, 8, 3, 6, 15, 22, 6, 1, 1) ) L3 <- list( c_j = c(10, NA, 2, NA, 22, NA, 2, NA, 17, NA, 15, NA, 14, NA, 5, NA), d = c( 1, 6, 10, 6, 10, 2, 6, 10, 4, 1, 5, 5, 4, 8, 6, 3) #inner wheel ) L4 <- list(#inner wheel d_k = c(6, NA, 13, NA, 3, NA, 3, NA, 6, NA, 10, NA, 10, NA, 10, NA) )

This is a brute force method but is still pretty quick. I made a shift function to treat vectors like circles or in this case dials. Here’s a demo of shift moving the vector one rotation to the right.

"A" "B" "C" "D" "E" "F" "G" "H" "I" "J"

results in:

"J" "A" "B" "C" "D" "E" "F" "G" "H" "I"

I use some indexing of the NAs to over write the notched dials onto each of the top three rows.

shift <- function(x, n){ if (n == 0) return(x) c(x[(n+1):length(x)], x[1:n]) } dat <- NULL m <- FALSE for (i in 0:15){ for (j in 0:15){ for (k in 0:15){ # Column 1 c1 <- L1[[1]] # Column 2 c2 <- L1[[2]] c2b <- shift(L2[[1]], i) c2[!is.na(c2b)]<- na.omit(c2b) # Column 3 c3 <- shift(L2[[2]], i) c3b <- shift(L3[[1]], j) c3[!is.na(c3b)]<- na.omit(c3b) # Column 4 c4 <- shift(L3[[2]], j) c4b <- shift(L4[[1]], k) c4[!is.na(c4b)]<- na.omit(c4b) ## Check and see if all rows add up to 40 m <- all(rowSums(data.frame(c1, c2, c3, c4)) %in% 40) ## If all rows are 40 print the solution and assign to dat if (m){ assign("dat", data.frame(c1, c2, c3, c4), envir=.GlobalEnv) print(data.frame(c1, c2, c3, c4)) break } if (m) break } if (m) break } if (m) break }

Here’s the solution:

c1 c2 c3 c4 1 2 6 22 10 2 15 9 6 10 3 23 9 2 6 4 19 10 1 10 5 3 16 17 4 6 2 1 27 10 7 3 17 15 5 8 27 2 5 6 9 20 2 14 4 10 11 9 7 13 11 27 2 5 6 12 10 3 24 3 13 19 10 10 1 14 10 24 3 3 15 13 15 2 10 16 10 9 15 6

We can check dat (I wrote the solution the global environment) with rowSums:

rowSums(dat) [1] 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40 40

A fun exercise for me. If anyone has a more efficient and/or less code intensive solution I’d love to hear about it.

**leave a comment**for the author, please follow the link and comment on their blog:

**TRinker's R Blog » R**.

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.