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!
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 100something 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 100damn, sorry. the loop is broken, i do not know why. ist there something which i can do or you?
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 100Dear sebastian,
I still get an error:
Error: unexpected numeric constant in "for(i in 1:length(l)){ l[funfun(length(l),i)] 0"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
This is really strange, never happened before. Also, I didn’t get your email, where did you send it to? You can find my contact details here: https://blog.ephorie.de/about.
Hope that we can find a solution.
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 100Thank you!
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
Yes, indeed, fixed it.
I guess without the code-tag some escape sequence is triggered which gets deleted by wordpress… should be ok now, thank you again!
Interesting little riddle/challenge! I love this because competitive programming is like a brain training app, but for real skills. By practicing to solve problems regularly, programmers can ensure that the coding part of their brain receives a regular workout
Thank you, Rick, I couldn’t agree more!