Simulating Dart Throws in R

[This article was first published on Cerebral Mastication » R, 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.

Back in November 2009 Wired wrote an article about some grad students who decided to try to stochastically model throwing darts. Because I don’t actually read printed material I didn’t see the article until a couple of months ago. My immediate thought was, “hey, I drink beer. I throw darts. I build stochastic models. Why haven’t I done this?” Well we all know why I haven’t done this. I have a job and a 2 year old daughter and I like my wife. Well a funny thing happened a few weeks ago. I sat down and was thinking about this problem and then 5 hours later I had a working dart simulator in my text editor. I don’t remember writing this. So Occam’s Razor says that the most likely explanation is the simplest explanation. So clearly I was abducted by aliens and someone broke into my office and built a dart simulator.

I do reinsurance modeling to pay the bills and it immediacy hit me that this type of modeling is very similar to what I do for work. This similarity became the impetus for my presentation at R in Finance 2010 which starts today.

I dumped the dart board code into a github gist which can be found here:

#draw.circle is from the plotrix library
require(plyr)
draw.circle <- function (x, y, radius, nv = 100, border = NULL, col = NA, lty = 1,
lwd = 1)
{
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
angle.inc <- 2 * pi/nv
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
xv <- cos(angles) * radius + x
yv <- sin(angles) * radius * ymult + y
polygon(xv, yv, border = border, col = col, lty = lty, lwd = lwd)
invisible(list(x = xv, y = yv))
}
drawBoard <- function() {
plot(-260:260, -260:260, type="n", xlab="", ylab="", asp = 1, main="Dart Board")
draw.circle(0, 0, 12.7/2, border="purple", lty=1, lwd=1) # bull
draw.circle(0, 0, 31.8/2, border="purple", lty=1, lwd=1) # outer bull
draw.circle(0, 0, 107, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 99, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 162, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 170, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 107, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 99, border="purple", lty=1, lwd=1)
draw.circle(0, 0, 451/2, border="black", lty=1, lwd=1) #outer edge of board
angle.inc <- 2 * pi/20 # 20 sections in a board
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
angles <- angles - .5 * pi / 10 #dart boards are rotated slightly
xSeries <- sin(angles) * 170
ySeries <- cos(angles) * 170
for (i in 1:20){
lines(c(0,xSeries[i]),c(0,ySeries[i] ))
}
points <- c(20, 1, 18, 4, 13, 6, 10, 15, 2, 17, 3, 19, 7, 16, 8, 11, 14, 9, 12, 5)
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
xSeries <- sin(angles) * 180
ySeries <- cos(angles) * 180
for (i in 1:20){
text(xSeries[i],ySeries[i], points[i] )
}
}
throw <- function(n, targetX, targetY, stdev){
# input the x, y coord of a throw and the standard deviation of throw pattern
# return the x,y coord of the resulting throw
# assumes normal distribution of throws
# returns a data frame with columns xThrow and yThrow
distanceFromTarget <- rnorm(n, 0, stdev)
angleFromTarget <- runif(n, 0, 2 * pi)
xOffset <- sin(angleFromTarget) * distanceFromTarget
yOffset <- cos(angleFromTarget) * distanceFromTarget
xThrow <- targetX + xOffset
yThrow <- targetY + yOffset
return(data.frame(xThrow, yThrow ))
}
throwNormXY <- function(n, targetX, targetY, stdevX, stdevY){
# input the x, y coord of a throw and the standard deviation of X and Y
# return the x,y coord of the resulting throw
# assumes normal distribution of throws
# returns a data frame with columns xThrow and yThrow
xOffset <- rnorm(n, 0, stdevX)
yOffset <- rnorm(n, 0, stdevY)
xThrow <- targetX + xOffset
yThrow <- targetY + yOffset
return(data.frame(xThrow, yThrow ))
}
scoreThrow <- function(xThrow, yThrow){
# function for turning the x,y coordinates of a throw into
# a point score
angle.inc <- 2 * pi/20 # 20 sections in a board
points <- c(20, 1, 18, 4, 13, 6, 10, 15, 2, 17, 3, 19, 7, 16, 8, 11, 14, 9, 12, 5)
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
angles <- angles - .5 * pi / 10 #dart boards are rotated slightly
distance <- (xThrow^2 + yThrow^2)^.5
angle <- (.5 * pi) - asin(yThrow/distance)
angle <- if (xThrow < 0 ) { pi + (pi - angle )
} else {angle}
#determine which angle section the throw was in
angleSection <- NA
for (i in 1:19){
if (angles[i] < angle & angles[i+1] >= angle) {angleSection <- i}
} #there has to be a prettier way to do this
if (is.na(angleSection)==TRUE) {angleSection <- 20}
#determine which band the throw was in (1-6) 1 is bull, 2 is outer bull etc
band <- if (distance <= 12.7/2) {1
} else if (distance >= 12.7/2 & distance < 31.8/2) {2
} else if (distance >= 31.8/2 & distance < 99) {3
} else if (distance >= 99 & distance < 107) {4
} else if (distance >= 107 & distance < 162) {5
} else if (distance >= 162 & distance < 170) {6
} else {7}
bandScore <- c(50, 25, 1, 3, 1, 2, 0)
finalScore <- if (band <= 2) {bandScore[band]} else {points[angleSection] * bandScore[band] }
return(finalScore)
}
ePoints <- function(n, xPoint, yPoint, sDev) {
#takes in an x, y point and simultes it n times
#returs a single value which is the average score per throw
throws <- throw(n, xPoint, yPoint, sDev)
scores <- ddply(throws,c("xThrow", "yThrow"), function(df) scoreThrow(df$xThrow, df$yThrow))
names(scores) <- c("xThrow", "yThrow", "points")
return(mean(scores$points))
}
runtest <- function(){
drawBoard()
require(plyr)
yThrow <- (rep(20,15))
yThrow <- c(yThrow, (rep(-20,15)))
yThrow <- c(yThrow, (rep(60,15)))
yThrow <- c(yThrow, (rep(-60,15)))
yThrow <- c(yThrow, (rep(100,15)))
yThrow <- c(yThrow, (rep(-100,15)))
yThrow <- c(yThrow, (rep(140,15)))
yThrow <- c(yThrow, (rep(-140,15)))
xThrow <- rep(seq(-175,175, 25),8)
throws <- data.frame(xThrow, yThrow)
points(throws$xThrow, throws$yThrow, col="red", pch=18 )
scores <- ddply(throws,c("xThrow", "yThrow"), function(df) scoreThrow(df$xThrow, df$yThrow))
text(scores$xThrow, scores$yThrow, scores$V1, col="blue")
}
view raw darts.R hosted with ❤ by GitHub
#############################################################################
#### Examples of use
#########################################################################
drawBoard()
throws <- throw(5, 0, 0, 25)
points(throws$xThrow, throws$yThrow, col="red", pch=18 )
drawBoard()
throws <- throwNormXY(500, 0, 0, 20, 40)
points(throws$xThrow, throws$yThrow, col="red", pch=18 )
scores <- adply(throws, 1, transform, points=scoreThrow(xThrow, yThrow))
sum(scores$points)
#triple points
angle.inc <- 2 * pi/20 # 20 sections in a board
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
xSeries <- sin(angles) * 103
ySeries <- cos(angles) * 103
for (i in 1:20){
points(xSeries[i],ySeries[i] )
}
targetlist <- data.frame(xSeries, ySeries)
#double points
angle.inc <- 2 * pi/20 # 20 sections in a board
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
xSeries <- sin(angles) * 166
ySeries <- cos(angles) * 166
for (i in 1:20){
points(xSeries[i],ySeries[i] )
}
targetlist <-rbind(targetlist, data.frame(xSeries, ySeries))
xSeries <- 0
ySeries <- 0
targetlist <-rbind(targetlist, data.frame(xSeries, ySeries))
view raw darts.use.R hosted with ❤ by GitHub

If the embedded code is not showing up, you can get to it directly on Github.

To leave a comment for the author, please follow the link and comment on their blog: Cerebral Mastication » R.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)