Site icon R-bloggers

a riddle at the end of its tether

[This article was first published on R – Xi'an's Og, 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.

A simply worded riddle this week on The Riddler, about four ropes having non-uniform and unknown burning rates, the only constraint being they all burn completely in one hour. With the help of a lighter (or even a single match), what are the possible units of time one can measure by burning them?

While I had worked out a range of possible times for each of the ropes to complete its combustion, I went for a simulation based confirmation. The starting point is that a new fire can only be started when a burning rope ends up burning. Which only happens for a finite number of possibilities. I found 24 of them, consisting of

> total*prec
[1]  0.000 0.5000 0.750 0.875 0.9375 1.000 1.125 1.1875 1.25 1.3125
[11] 1.375 1.4375 1.500 1.625 1.7500 1.875 2.000 2.1250 2.25 2.5000
[21] 2.750 3.0000 3.500 4.000

i.e., some combinations of 1, 2⁻¹, …, 2⁻⁴, with the comment that those times cannot all be obtained within a single arson experiment.

The simulation experiment consists in producing a random sequence of fire starts based on this principle. To reproduce the non-uniform burning rate I chose a Beta cdf although it has absolutely no relevance on the solution:

#safer beta quantile
myqbeta <-function(x,a,b){
 x=(x>0)*(x<1)*x+(x>=1)
 return(qbeta(x,a,b))}
#burning rate, by side of the rope
fuse <- function(t,side){
 (side==1)*pbeta(t,2.0,1.7)+(side==2)*pbeta(1-t,2.0,1.7)}
#time since start when at x
infuse <- function(x,side){
 (side==1)*myqbeta(x,2.0,1.7)+(side==2)*(1-myqbeta(x,2.0,1.7))}

then I defined R functions for proceeding on the time line and choosing starting points for new fires

#start a new burn
light <- function(ropes,burns){
 #check some are left
 if (max(ropes[,2]-ropes[,1])==0) return(burns)
 #pick number of new fires
 howmany=sample(0:sum((ropes[,2]-ropes[,1]==1)),1)
 if (howmany>0){
    whichropes=sample(rep((1:N)[ropes[,2]-ropes[,1]==1],2),howmany)
    burns[whichropes,1]=TRUE}
    #ropes[whichropes,1]=fuse(prec,1)}
  #pick second end fire-start
  howmany=sample(0:sum(burns[,1]&!burns[,2]),1)
  if (howmany>0){
    whichropes=sample(rep((1:N)[burns[,1]&!burns[,2]],2),howmany)
    burns[whichropes,2]=TRUE}
    #ropes[whichropes,2]=fuse(prec,2)}
  burns
}
#move fire along by one time step
shakem whichones=(1:N)[burns[,1]]
ropes[whichones,1]=fuse(infuse(ropes[whichones,1],1)+prec,1)
whichones=(1:N)[burns[,2]]
ropes[whichones,2]=fuse(infuse(ropes[whichones,2],2)+prec,2)
#eliminate burnt
whichones=(1:N)[ropes[,2]<=ropes[,1]]
ropes[whichones,2]=ropes[whichones,1]
burns[whichones,1]=burns[whichones,2]=FALSE
list(ropes=ropes,burns=burns)
}
#completely burned ropes
burnt <-function(ropes){
  (1:N)[ropes[,2]==ropes[,1]]}

which can then be used repeatedly to record times at which a rope ends up burning, using a time discretisation of 1/2⁵ (which has no impact when compared with a finer discretisation):

N=4
prec=1/2^(N+1)
ropes=cbind(rep(0,N),rep(1,N))
burns=cbind(rep(FALSE,N),rep(FALSE,N))
exhausted=NULL
#start with at least one rope
events=0
while (max(burns)==0)
  burns=light(ropes,burns)
for (t in 1:(N/prec)){
 update=shakem(ropes,burns)
 ropes=update$ropes
 burns=update$burns
 if (length(setdiff(burnt(ropes),exhausted))>0){
  #one fire ended
  events=c(events,t)
  exhausted=burnt(ropes)
  #new firestart
  burns=light(ropes,burns)
  }

Filed under: R, Statistics Tagged: mathematical puzzle, R, The Riddler

To leave a comment for the author, please follow the link and comment on their blog: R – Xi'an's Og.

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.