Cracking Safe Cracker with R

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.

Advertisements

About tylerrinker

I am Literacy PhD student with a bent for the quantitative and a passion for R.
This entry was posted in games, r and tagged , , , , . Bookmark the permalink.

5 Responses to Cracking Safe Cracker with R

  1. mike says:

    Nice puzzle! I tried to make a faster solver just for the hell of it. The following code finds the solution in 0.007 seconds.

    a <- c( 2, 15, 23, 19, 3, 2, 3, 27, 20, 11, 27, 10, 19, 10, 13, 10) # doesn't rotate

    b0 <- c(22, 9, 5, 10, 5, 1, 24, 2, 10, 9, 7, 3, 12, 24, 10, 9) # doesn't rotate
    b1 <- c(16, NA, 17, NA, 2, NA, 2, NA, 10, NA, 15, NA, 6, NA, 9, NA) # rot1

    c0 <- c(11, 27, 14, 5, 5, 7, 8, 24, 8, 3, 6, 15, 22, 6, 1, 1) # rot1
    c1 <- c(10, NA, 2, NA, 22, NA, 2, NA, 17, NA, 15, NA, 14, NA, 5, NA) # rot2

    d0 <- c( 1, 6, 10, 6, 10, 2, 6, 10, 4, 1, 5, 5, 4, 8, 6, 3) # rot2
    d1 <- c( 6, NA, 13, NA, 3, NA, 3, NA, 6, NA, 10, NA, 10, NA, 10, NA) # rot3

    N <- length(a)
    roll <- function(v, n) {
    if (n == 0 | n==N) {
    return(v)
    } else {
    return(c(v[(n+1):N], v[1:n]))
    }
    }

    system.time({
    for(rot1 in 1:N) { # for every rotation of the b1/c0 wheel
    b1r <- roll(b1, rot1) # rotate the 'b1' numbers
    b <- ifelse(is.na(b1r), b0 , b1r) # work out what is left showing at level 'b'
    s1 <- a + b # sum level a + b
    if (all(s1 < 40)) { # only continue if all sums are less than 40 (otherwise this isn't a winning rotation)
    c0r <- roll(c0, rot1) # rotate the c0 numbers attached to b1
    for(rot2 in 1:N) { # for every rotation of the c1/d0 wheel
    c1r <- roll(c1, rot2) # rotate the 'c1' numbers
    c <- ifelse(is.na(c1r), c0r, c1r) # work out what is left showing at level 'c'
    s2 <- s1 + c # sum level a + b + c
    if (all(s2 < 40)) { # only continue if all sums are less than 40 (otherwise this isn't a winning rotation)
    d0r <- roll(d0, rot2) # rotate the d0 numbers attached to the c1
    for(rot3 in 1:N) { # for every rotation of the d1 wheel
    d1r <- roll(d1, rot3) # rotate the 'd1' numbers
    d <- ifelse(is.na(d1r), d0r, d1r) # work out what is left showing at level 'd'
    if (all(s2 + d == 40)) { # if all the sums are 40
    print(data.frame(a, b, c, d)) # we've found the solution
    stop("Finished!")
    }
    }
    }
    }
    }
    }
    })

    • tylerrinker says:

      Nice solution. It is indeed fast. We could scale up. I have a safe cracker 50 I may try this out on. Presumably your approach would shine there.

      • mike says:

        By doing sums as I progress up the rings, if the sum in any location ever gets above 40 then don’t nest any deeper. Saves *lots* of calcs.

        It would be great to see the “50” puzzle 🙂

  2. Tanner H says:

    If you are solving by hand, here is my solution. I was able to solve it in about an hour. **Do not read any further if you do not want spoiler hints.

    There are four circles of numbers which cannot be hidden, the outer set per wheel. There are 18 columns of 4 numbers. When the solution is showing, the total numbers visible will sum to 16 columns times 40 per column (16×40=640), or 640. The top wheel’s permanently visible numbers total to 61, the second wheel’s 87, the third’s 77, the fourth’s 214. The permanent values sum to 439. This means the variable values must sum to 201. Each wheel’s inner circle of values only has two possible sums. The top wheel has no variable values because all values are permanently visible. The second wheel’s inner circle either sums to 46 or 41. The third’s 88 or 75, and the bottom’s 95 or 67. At this stage, we have reduced the possible positions to 32,768. There are only 8 possible combinations to find a total sum of 201. Cycling these possibility quickly reveals 46, 88, and 67 as the only possibility. Now we have reduced the possible number of positions by a factor of 16 to 4,096.

    From this point, it only took an additional 10 minutes to find the correct solution by trial and error.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s