<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/a-riddle-at-the-end-of-its-tether/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://xianblog.wordpress.com/2017/02/24/a-riddle-at-the-end-of-its-tether/"> R – Xi'an's Og</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p><strong>A</strong> simply worded <a target="_blank" rel="nofollow" href="https://fivethirtyeight.com/features/a-riddle-how-many-crooked-politicians-are-there/">riddle</a> this week on <a target="_blank" rel="nofollow" href="https://fivethirtyeight.com/features/a-riddle-how-many-crooked-politicians-are-there/">The Riddler</a>, 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?</p>
<p>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</p>
<pre>> 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</pre>
<p>i.e., some combinations of 1, 2⁻¹, …, 2⁻⁴, with the comment that those times cannot all be obtained within a single arson experiment.</p>
<p><span></span>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:</p>
<pre>#safer beta quantile
myqbeta &lt;-function(x,a,b){
 x=(x>0)*(x&lt;1)*x+(x>=1)
 return(qbeta(x,a,b))}
#burning rate, by side of the rope
fuse &lt;- 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 &lt;- function(x,side){
 (side==1)*myqbeta(x,2.0,1.7)+(side==2)*(1-myqbeta(x,2.0,1.7))}
</pre>
<p>then I defined R functions for proceeding on the time line and choosing starting points for new fires</p>
<pre>#start a new burn
light &lt;- 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]&amp;!burns[,2]),1)
  if (howmany>0){
    whichropes=sample(rep((1:N)[burns[,1]&amp;!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]&lt;=ropes[,1]]
ropes[whichones,2]=ropes[whichones,1]
burns[whichones,1]=burns[whichones,2]=FALSE
list(ropes=ropes,burns=burns)
}
#completely burned ropes
burnt &lt;-function(ropes){
  (1:N)[ropes[,2]==ropes[,1]]}
</pre>
<p>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):</p>
<pre>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)
  }
</pre>
<p>Filed under: <a target="_blank" rel="nofollow" href="https://xianblog.wordpress.com/category/statistics/r-statistics/">R</a>, <a target="_blank" rel="nofollow" href="https://xianblog.wordpress.com/category/statistics/">Statistics</a> Tagged: <a target="_blank" rel="nofollow" href="https://xianblog.wordpress.com/tag/mathematical-puzzle/">mathematical puzzle</a>, <a target="_blank" rel="nofollow" href="https://xianblog.wordpress.com/tag/r/">R</a>, <a target="_blank" rel="nofollow" href="https://xianblog.wordpress.com/tag/the-riddler/">The Riddler</a> <a target="_blank" rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/xianblog.wordpress.com/32817/"><img alt="" src="http://feeds.wordpress.com/1.0/comments/xianblog.wordpress.com/32817/" border="0"></a> <img alt="" src="https://i1.wp.com/pixel.wp.com/b.gif?resize=1%2C1&ssl=1" border="0" data-recalc-dims="1"></p>
<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://xianblog.wordpress.com/2017/02/24/a-riddle-at-the-end-of-its-tether/"> R – Xi'an's Og</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/search/data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/search/map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/search/animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/search/sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/search/SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/search/git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/search/hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/search/PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/search/time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/search/trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/mZxeaRKBA3M"></a></div>