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
  0.000 0.5000 0.750 0.875 0.9375 1.000 1.125 1.1875 1.25 1.3125
 1.375 1.4375 1.500 1.625 1.7500 1.875 2.000 2.1250 2.25 2.5000
 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
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  