R Coding Challenge: How many Lockers are Open?


The German news magazine DER SPIEGEL has a regular puzzle section in its online version, called “Rätsel der Woche” (“Riddle of the Week”). Some of those puzzles are quite interesting but I am often too lazy to solve them analytically.

So I often kill two birds with one stone: having fun solving the puzzle with R and creating some new teaching material for my R classes! This is what we will do with one of those more interesting riddles, which is quite hard to solve analytically but relatively easy to solve with R, so read on!

The riddle goes like this (source: Wie viele Schließfächer stehen offen?):

We are standing in front of 100 lockers arranged side by side, all of which are closed. One man has a bunch of keys with all 100 keys and will pass the lockers exactly a hundred times, opening or closing some of them.

On the first pass, he opens all the lockers. On the second pass, the man will go to every other locker and change its state. That means: If it is closed, it will be opened. If it is already open, it will be closed. In this case, he closes lockers 2, 4, 6… 98 and 100, because all doors were open before.

On the third pass, he changes the state of every third locker – that is, 3, 6, 9, … 96, 99. Closed doors are opened, open doors closed. In the fourth pass, every fourth locker is changed, at the fifth every fifth – and so on. At the last, the 100th, the man finally only changes the state of door number 100.

The question is: How many of the 100 compartments are open after the 100th pass?

Now, please try to solve the riddle with R yourself… after that I will provide you with one possible solution!

You should have got the quadratic numbers 1, 4, 9,…, 81, 100 – did you? If yes, well done!

To get the correct result we will do two things simultaneously: run through all the passes one after the other (with a for loop) and, as a bonus, create an image for all the runs with the open doors in green and the closed doors in red (with the image function):

ndoors <- 100
img <- matrix(nrow = ndoors, ncol = ndoors)

which.door <- function (n, nd = ndoors) {
  seq(n, nd, n)
}

img_t <- function(m) {
  image(t(m)[ , nrow(m):1], col = c("red", "green"), xaxt = "n", yaxt = "n", xlab = "doors", ylab = "passes")
  axis(1, at = seq(0, 1, length.out = 11), labels = c(1, seq(10, 100, 10)))
  axis(2, at = seq(0, 1, length.out = 11), labels = c(seq(100, 10, -10), 1))
}

pass <- rep(TRUE , ndoors) # TRUE = door open
img[1, ] <- pass

for (i in 2:ndoors) {
  pass[which.door(i)] <- !pass[which.door(i)]
  img[i, ] <- pass
}

which(pass)
##  [1]   1   4   9  16  25  36  49  64  81 100

sum(pass)
## [1] 10

img_t(img)

Interesting how simple actions can create intricate patterns!

That was fun, wasn’t it! And I hope you learned something along the way… stay tuned!

11 thoughts on “R Coding Challenge: How many Lockers are Open?”

  1. that was really nice. i also solved some puzzles with a simulation in r.

    for the puzzle you presented here, i have another solution which i made before looking at your solution:

    ## set a vector (lockers) of -1 (-1 is closed, 1 is open)
    l<-rep(-1,100)
    ## a function that gives a sequence of positions in a vector
    funfun <- function(x,y){seq.int(from = y,to=x,by=y)} 
    ## loop over length of vector and change specific lockers (-1 to 1 or otherwise)
    for(i in 1:length(l)){
      l[funfun(length(l),i)] 0])
    # [1] 10
    which(l>0)
    #[1]   1   4   9  16  25  36  49  64  81 100
    
    1. something went wrong, seems to be formatted incorrectly

      ## set a vector (lockers) of -1 (-1 is closed, 1 is open)
      l<-rep(-1,100)
      ## a function that gives a sequence of positions in a vector
      funfun <- function(x,y){seq.int(from = y,to=x,by=y)} 
      ## loop over length of vector and change specific lockers (-1 to 1 or otherwise)
      for(i in 1:length(l)){
        l[funfun(length(l),i)] 0])
      #[1] 10
      which(l>0)
      #[1]   1   4   9  16  25  36  49  64  81 100
      
        1. last try, maybe the brackets… please delete other comments if this works

          ## set a vector (lockers) of -1 (-1 is closed, 1 is open)
          l<-rep(-1,100)
          ## a function that gives a sequence of positions in a vector
          funfun <- function(x,y){seq.int(from = y,to=x,by=y)} 
          ## loop over length of vector and change specific lockers (-1 to 1 or otherwise)
          for(i in 1:length(l)){  l[funfun(length(l),i)] 0)
          #[1] 1 4 9 16 25 36 49 64 81 100
          
  2. dear Holger,

    i sent you an email with the code (3rd Feb.). it seems to happen an error when I copy the code into this comment field. before I post the comment, everything seems fine. but after publication it is going to be “destroyed” after line 6 of the code (the first and second comment code). some parts are missing.

    if you have a clue, please let me know.

    best,
    sebastian

    1. Ok, now I got the email!

      The code seems to work alright:

      ## set a vector (lockers) of -1 (-1 is closed, 1 is open)
      l<-rep(-1,100)
      ## a function that gives a sequence of positions in a vector
      funfun <- function(x,y){seq.int(from = y,to=x,by=y)}
      ## loop over length of vector and change specific lockers (-1 to 1 or otherwise)
      for(i in 1:length(l)){
        l[funfun(length(l),i)] <- l[funfun(length(l),i)]*-1
      }
      ## check result
      length(l[l>0])
      ## [1] 10
      which(l>0)
      ##  [1]   1   4   9  16  25  36  49  64  81 100
      

      Thank you!

      1. it is really strange. your copy and paste action of the code gives the same error… some lines and parts of code are missing.

        but good to hear that the code sent by email is working properly

Leave a Reply

Your email address will not be published. Required fields are marked *

I accept that my given data and my IP address is sent to a server in the USA only for the purpose of spam prevention through the Akismet program.More information on Akismet and GDPR.

This site uses Akismet to reduce spam. Learn how your comment data is processed.