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

Data Scientist, open-source developer , #rstats enthusiast, #dataviz geek, and #nlp buff
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.

• Tanner H says:

**Edit: there are 16 columns of 4 numbers.