Riddler: Can You Roll The Perfect Bowl?
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
FiveThirtyEight’s Riddler Express
At the recent World Indoor Bowls Championships in Great Yarmouth, England, one of the rolls by Nick Brett went viral. Here it is in all its glory:
12/10 on the mindblowing scale ???? #SCtop10
(via @BBCSport) pic.twitter.com/6pN6ybzVel— SportsCenter (@SportsCenter) January 23, 2020
In order for Nick’s green bowl to split the two red bowls, he needed expert precision in both the speed of the roll and its final angle of approach.
Suppose you were standing in Nick’s shoes, and you wanted to split two of your opponent’s bowls. Let’s simplify the math a little, and say that each bowl is a sphere with a radius of 1. Let’s further suppose that your opponent’s two red bowls are separated by a distance of 3 — that is, the centers of the red bowls are separated by a distance of 5. Define phi as the angle between the path your bowl is on and the line connecting your opponent’s bowls.
For example, here’s how you could split your opponent’s bowls when phi is 75 degrees:
What is the minimum value of phi that will allow your bowl to split your opponents’ bowls without hitting them?
Plan
I will approximate the solution to this puzzle by simulating the game from many different angles. Thankfully, because the game is vertically and horizontally symmetric, I only need to simulate the green ball reaching the middle point between the red balls and only need to see if it collides with the top red ball.
Setup
knitr::opts_chunk$set(echo = TRUE, comment = "#>", cache = TRUE) library(glue) library(clisymbols) library(ggforce) library(gganimate) library(tidyverse) theme_set(theme_minimal()) # Some standard colors used throughout green <- "#54c761" red <- "#c75454" purple <- "#a06bdb" light_grey <- "grey70" grey <- "grey40" set.seed(0)
Simulate a single pass
I split the code into two pieces. The first simulates a bowl with a given angle, and the second decides on the angle to narrow down the approximation. The following functions take care of the first part: simulating a bowl.
A single simulation can be run by calling run_bowl_simulation()
with
an angle (in degrees). The function works by changing the hypotenuse,
starting with h_start = 5
and decreasing it to 0 by step_size
steps
(the steps are held in the numeric vector h_vals
). The actual position
of the ball is calculated from the length of the hypotenuse and angle
with a bit of trigonometry in make_green_ball()
. For each hypotenuse
value, the green ball is positioned and then tested to see if it
collides with the red ball (set at ((x,y) = (0,2.5)) as per the
riddle) using the function did_balls_collide()
. This information is
recorded by building a single data frame with the data for each step of
the simulation. The data frame is returned at the end of the simulation.
# Run a simulation of the bowling game. run_bowl_simulation <- function(angle, step_size = 0.1, red_ball_loc = list(x = 0, y = 2.5)) { h_start <- 5 h_vals <- seq(h_start, 0, by = -step_size) angle <- angle * (pi / 180) all_ball_pos <- NULL for (h in h_vals) { green_ball <- make_green_ball(h, angle) collision <- did_balls_collide(green_ball, red_ball_loc, radius = 1) all_ball_pos <- bind_rows( all_ball_pos, tibble(h = h, x = green_ball$x, y = green_ball$y, collision = collision) ) } return(all_ball_pos) } # Make a green ball location from the x-position and angle. make_green_ball <- function(h, angle) { x <- -1 * h * cos(pi/2 - angle) y <- h * sin(pi/2 - angle) list(x = x, y = y) } # Decide wether the two balls of radius `r` collided. did_balls_collide <- function(ball1, ball2, radius) { d <- sqrt((ball1$x - ball2$x)^2 + (ball1$y - ball2$y)^2) return(d <= 2*radius) }
Below are the results from running the simulation at angles between 90
degrees (horizontal) and 0 degrees (vertical) at 10 degree increments.
Each line is an individual simulation, and each point is a round of the
simulation. A red ball is positioned as per the riddle, and the purple
points indicate where the green ball would collide with the red ball.
These example simulations show that the run_bowl_simulation()
function
is working as expected.
map(seq(90, 0, -10), run_bowl_simulation, step_size = 0.1) %>% map2(seq(90, 0, -10), ~ .x %>% add_column(angle = .y)) %>% bind_rows() %>% mutate(collision = ifelse(collision, "collision", "safe")) %>% ggplot() + geom_point(aes(x, y, color = collision), size = 2) + geom_circle(aes(x0 = x0, y0 = y0, r = r), data = tibble(x0 = 0, y0 = 2.5, r = 1), color = red, fill = red, alpha = 0.5) + scale_color_manual(values = c(purple, light_grey)) + coord_fixed() + theme( legend.position = c(0.15, 0.9), legend.title = element_blank() ) + labs(x = "x", y = "y", title = "Example paths of the green ball", subtitle = "For the angles between 0 and 90 at 10 degree intervals.")
Find the smallest angle
The second part of the code is to find the smallest (narrowest) angle at which there is no collision. Instead of trying every angle between 90 degrees and 0 degrees at some very small increment, I approach this problem a bit more efficiently. I built an algorithm than starts at 90 degrees and takes large steps until there is an angle that causes a collision. It then takes a step back an tries again with a progressively smaller step, until it no longer collides. This continues with the step size getting smaller and smaller. The algorithm stops when the step size is small enough for a good approximation and the angle does not cause a collision. The code chunk below carries out this process, printing the information for each pass.
The purpose of the angle
and previous_angle
parameters are fairly
obvious. The angle_delta
parameter is the value by which the angle is
reduced at each step. epsilon
is used to reduce angle_delta
when
there are collisions at an angle. Finally, min_angle_delta
is one of
the stopping criteria: when angle_delta
gets below this value, the
algorithm is sufficiently close to the correct answer and it stops
trying new angles. Thus, this parameter determines the precision of the
algorithm. It is set relatively high for now, because this first pass
is just a demonstration and prints out the results of each iteration.
For efficiency, the while loop uses a memoised version of
run_bowl_simulation()
because when the balls collide, the previous
step is tried again. Therefore, memoising the function saves some time
instead of running the simulation from the same angle multiple times.
# The starting angle. angle <- 90 previous_angle <- angle # The "learning rate" paramerters. angle_delta <- 10 epsilon <- 0.5 min_angle_delta <- 0.01 # Start with TRUE, though it doesn't matter. collision <- TRUE memo_bowl_sim <- memoise::memoise(run_bowl_simulation) while (angle_delta >= min_angle_delta | collision) { # Run the bowling simulation with the current angle. sim_res <- memo_bowl_sim(angle = angle, step_size = 0.1) # Were there any collisions? collision <- any(sim_res$collision) # Print results msg <- "collision: {ifelse(collision, symbol$cross, symbol$tick)}" %>% paste("{collision},") %>% paste("angle: {round(angle, 4)},") %>% paste("angle_delta: {round(angle_delta, 4)}") print(glue(msg)) if (!collision) { # Reduce the angle if there is no collision. previous_angle <- angle angle <- angle - angle_delta } else { # Revert to the previous angle and reduce delta if there is a collision. angle_delta <- epsilon * angle_delta angle <- previous_angle } } #> collision: ✔ FALSE, angle: 90, angle_delta: 10 #> collision: ✔ FALSE, angle: 80, angle_delta: 10 #> collision: ✔ FALSE, angle: 70, angle_delta: 10 #> collision: ✔ FALSE, angle: 60, angle_delta: 10 #> collision: ✖ TRUE, angle: 50, angle_delta: 10 #> collision: ✔ FALSE, angle: 60, angle_delta: 5 #> collision: ✔ FALSE, angle: 55, angle_delta: 5 #> collision: ✖ TRUE, angle: 50, angle_delta: 5 #> collision: ✔ FALSE, angle: 55, angle_delta: 2.5 #> collision: ✖ TRUE, angle: 52.5, angle_delta: 2.5 #> collision: ✔ FALSE, angle: 55, angle_delta: 1.25 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 1.25 #> collision: ✖ TRUE, angle: 52.5, angle_delta: 1.25 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 0.625 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.625 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 0.3125 #> collision: ✔ FALSE, angle: 53.4375, angle_delta: 0.3125 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.3125 #> collision: ✔ FALSE, angle: 53.4375, angle_delta: 0.1562 #> collision: ✔ FALSE, angle: 53.2812, angle_delta: 0.1562 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.1562 #> collision: ✔ FALSE, angle: 53.2812, angle_delta: 0.0781 #> collision: ✔ FALSE, angle: 53.2031, angle_delta: 0.0781 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0781 #> collision: ✔ FALSE, angle: 53.2031, angle_delta: 0.0391 #> collision: ✔ FALSE, angle: 53.1641, angle_delta: 0.0391 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0391 #> collision: ✔ FALSE, angle: 53.1641, angle_delta: 0.0195 #> collision: ✔ FALSE, angle: 53.1445, angle_delta: 0.0195 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0195 #> collision: ✔ FALSE, angle: 53.1445, angle_delta: 0.0098
From the print-out above, we can see how the algorithm jumps back an forth, narrowing in on a solution around 53 degrees.
With that successful proof-of-concept, the following code runs the
algorithm with a smaller min_angle_delta = 1e-5
to achieve greater
precision. Instead of printing out the results of each iteration, the
simulation results and parameters are saved to sim_results_tracker
and
sim_parameters_tracker
, respectively, and are inspected below.
angle <- 90 previous_angle <- angle angle_delta <- 10 epsilon <- 0.7 min_angle_delta <- 1e-5 collision <- TRUE sim_results_tracker <- tibble() sim_parameters_tracker <- tibble() memo_bowl_sim <- memoise::memoise(run_bowl_simulation) while (angle_delta >= min_angle_delta | collision) { sim_res <- memo_bowl_sim(angle = angle, step_size = 0.01) collision <- any(sim_res$collision) sim_results_tracker <- bind_rows(sim_results_tracker, sim_res %>% add_column(angle = angle)) sim_parameters_tracker <- bind_rows(sim_parameters_tracker, tibble(angle, angle_delta, collision, epsilon)) if (!collision) { previous_angle <- angle angle <- angle - angle_delta } else { angle_delta <- epsilon * angle_delta angle <- previous_angle } }
The simulation took 89 steps. The plot below shows the angle and
angle_delta
at each step, colored by whether there was a collision or
not.
sim_parameters_tracker %>% mutate(row_idx = row_number()) %>% pivot_longer(-c(row_idx, epsilon, collision)) %>% ggplot(aes(x = row_idx, y = value)) + facet_wrap(~ name, nrow = 2, scales = "free") + geom_point(aes(color = collision), size = 0.9) + scale_color_manual(values = c(light_grey, purple)) + labs(x = "iteration number", y = "value", title = "Simulation parameters")
The following plot shows each of the paths tried, again, coloring the locations of collisions in purple.
sim_results_tracker %>% mutate(collision = ifelse(collision, "collision", "safe")) %>% ggplot() + geom_point(aes(x = x, y = y, color = collision), size = 0.1) + scale_color_manual(values = c(collision = purple, safe = light_grey)) + coord_fixed() + theme(legend.position = "none") + labs(x = "x", y = "y", title = "Paths of the green ball", subtitle = "Points marked in purple were collisions with the red ball.")
Finally, we can find the approximated angle by taking the smallest angle tried in the rounds of simulation that did not have any collisions.
smallest_angle <- sim_parameters_tracker %>% filter(collision == FALSE) %>% top_n(1, wt = -angle) %>% pull(angle) %>% unique()
The algorithm approximates the solution to be: 53.1301 degrees (0.9273 in radians).
The simulation with this angle is shown in an animated plot below.
final_result <- sim_results_tracker %>% filter(angle == smallest_angle) %>% mutate(row_idx = row_number()) %>% filter(row_idx == 1) bind_rows( final_result, final_result %>% mutate(x = -1 * x, y = -1 * y) ) %>% mutate(row_idx = row_number()) %>% ggplot() + geom_point(aes(x = x, y = y), color = green, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = 1), fill = green, alpha = 0.2, size = 0) + geom_point(aes(x, y), data = tibble(x = 0, y = 2.5), color = red, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = r), data = tibble(x = 0, y = 2.5, r = 1), fill = red, alpha = 0.2, size = 0) + geom_point(aes(x, y), data = tibble(x = 0, y = -2.5), color = red, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = r), data = tibble(x = 0, y = -2.5, r = 1), fill = red, alpha = 0.2, size = 0) + coord_fixed() + labs( x = "x", y = "y", title = glue( "The tightest angle of the perfect bowl: {round(smallest_angle, 3)} deg." )) + transition_states(row_idx, transition_length = 2, state_length = 0, wrap = FALSE) + ease_aes("sine-in-out")
Acknowledgements
Repetitive tasks were sped up using the ‘memoise’ package for memoization. Plotting was accomplished using ‘ggplot2’, ‘ggforce’, and ‘gganimate’.
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.