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