Golf Scramble Simulation in R

August 14, 2013
By

(This article was first published on You Know, and kindly contributed to R-bloggers)

Golf Scramble Simulation



Golf Scramble Simulation

This is a simulation of a standard best-ball golf scramble. Conventional wisdom has it that the best golfer (A) should hit last, the idea being that one of the lesser golfers may have a decent shot already so the best golfer can take a risky shot. This simulation suggests that the worst golfer should indeed go first, but after that the order should be best on down (D, A, B, C). Perhaps a rationale is that golfer A will likely make a decent safe shot, which allows the other two medium skilled golfers a chance at a risky shot.

This is one of my first cracks at a sports simulation in R, so I welcome any comments about errors or constructive criticism.

Prepare

library(combinat)
## Attaching package: 'combinat'
## The following object is masked from 'package:utils':
##
## combn
library(ggplot2)
set.seed(4444)
n <- 10000

Create golfer attributes

safe.attributes <- data.frame(golfer = c("a", "b", "c", "d"), mean = c(8, 7, 
6, 5), sd = c(1.5, 1.5, 1.5, 1.5))
risk.attributes <- data.frame(golfer = c("a", "b", "c", "d"), mean = c(7, 6,
5, 4), sd = c(3, 3, 3, 3))

safe.densities <- apply(safe.attributes[, -1], 1, function(x) sort(rnorm(n = 1000,
mean = x[1], sd = x[2])))
colnames(safe.densities) <- safe.attributes$golfer
safe.df <- data.frame(safe.densities)

risk.densities <- apply(risk.attributes[, -1], 1, function(x) sort(rnorm(n = 1000,
mean = x[1], sd = x[2])))
colnames(risk.densities) <- risk.attributes$golfer
risk.df <- data.frame(risk.densities)

Plot golfer attributes

par(mfrow = c(2, 2))
par(mar = rep(2, 4))

plot(density(safe.df$a), col = "blue", xlim = c(0, 16), ylim = c(0, 0.3), main = "Golfer A",
col.main = "black", font.main = 4)
lines(density(risk.df$a), col = "red")
legend("topright", c("safe", "risk"), cex = 0.8, col = c("blue", "red"), lty = 1)

plot(density(safe.df$b), col = "blue", xlim = c(0, 16), ylim = c(0, 0.3), main = "Golfer B",
col.main = "black", font.main = 4)
lines(density(risk.df$b), col = "red")
legend("topright", c("safe", "risk"), cex = 0.8, col = c("blue", "red"), lty = 1)

plot(density(safe.df$c), col = "blue", xlim = c(0, 16), ylim = c(0, 0.3), main = "Golfer C",
col.main = "black", font.main = 4)
lines(density(risk.df$c), col = "red")
legend("topright", c("safe", "risk"), cex = 0.8, col = c("blue", "red"), lty = 1)

plot(density(safe.df$d), col = "blue", xlim = c(0, 16), ylim = c(0, 0.3), main = "Golfer D",
col.main = "black", font.main = 4)
lines(density(risk.df$d), col = "red")
legend("topright", c("safe", "risk"), cex = 0.8, col = c("blue", "red"), lty = 1)

plot of chunk unnamed-chunk-3
Create holes dataframe

golfPerms <- permn(letters[1:4])
holes <- data.frame(matrix(NA, nrow = n, length(golfPerms)))

for (i in 1:length(golfPerms)) {
colnames(holes)[i] <- paste0(golfPerms[[i]][1], golfPerms[[i]][2], golfPerms[[i]][3],
golfPerms[[i]][4])
}

Process

for (j in 1:n) {
for (i in 1:length(golfPerms)) {
shot1 <- sample(safe.df[, substr(golfPerms[[i]][1], 1, 1)], 1, T)

if (shot1 >= 6) {
shot2 <- max(shot1, sample(risk.df[, substr(golfPerms[[i]][2], 1,
1)], 1, T))
} else {
shot2 <- max(shot1, sample(safe.df[, substr(golfPerms[[i]][2], 1,
1)], 1, T))
}

if (shot2 >= 6) {
shot3 <- max(shot2, sample(risk.df[, substr(golfPerms[[i]][3], 1,
1)], 1, T))
} else {
shot3 <- max(shot2, sample(safe.df[, substr(golfPerms[[i]][3], 1,
1)], 1, T))
}

if (shot3 >= 6) {
shot4 <- max(shot3, sample(risk.df[, substr(golfPerms[[i]][4], 1,
1)], 1, T))
} else {
shot4 <- max(shot3, sample(safe.df[, substr(golfPerms[[i]][4], 1,
1)], 1, T))
}

holes[j, i] <- shot4
}
}

Find winning order per hole

winners <- data.frame(matrix(NA, nrow = n, ncol = 1))
names(winners) <- "winner"
for (k in 1:n) {
winners[k, 1] <- colnames(holes)[(which.max(holes[k, ]))]
}
winnerCounts <- data.frame(table(winners))
winnerCounts$winners <- reorder(winnerCounts$winners, -winnerCounts$Freq)

Plot results

par(mfrow = c(1, 1))
ggplot(data = winnerCounts, aes(x = winners, y = Freq)) + geom_bar(colour = "black",
fill = "#DD8888", width = 0.7, stat = "identity") + guides(fill = FALSE) +
xlab("Order") + ylab("Wins") + ggtitle("Golf Scramble Simulation")

plot of chunk unnamed-chunk-7
ddunn801 at gmail dot com

To leave a comment for the author, please follow the link and comment on their blog: You Know.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Sponsors

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)