Riddler: Can You Tell When The Snow Started?

[This article was first published on Posts | Joshua Cook, 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.

FiveThirtyEight’s Riddler Express

( Link to the original article.)

From Patrick Mayor comes a question about something we’re doing these days to keep ourselves and others safe: social distancing.

You’re walking along the middle of a wide sidewalk when you see someone walking toward you from the other direction, also down the middle of the sidewalk, 12 feet away. Being responsible citizens, you pass each other while maintaining a distance of at least 6 feet at all times. By the time you reach each other’s original positions, you should be back in the middle of the sidewalk again.

You should assume that the other person follows the same path you do, but flipped around (since they’re walking in the opposite direction). For example, you could both walk 3 feet to the left, 12 feet forward and finally 3 feet back to the right, walking a total of 18 feet before swapping positions.

Being lazy (I mean, efficient), you’d like to know the shortest distance you and the other person could walk so that you can switch positions, all while staying at least 6 feet apart at all times. What is this distance?

Plan

I am basically going to simulate the process with very small time steps and track the location of each person. These points can then be used to measure the distance traveled by each person.

Setup

knitr::opts_chunk$set(echo = TRUE, comment = "#>")
library(glue)
library(ggforce)
library(gganimate)
library(tidyverse)
theme_set(theme_minimal())

Simulation

Global constants

Below are a few constants to define from the beginning. time_step_size is the distance traveled at each time step of the simulation. minimum_distance is the minimum safe distance that the two people need to stay from each other.

time_step_size <- 0.01
minimum_distance <- 6

Subroutines

The update_tracker() function updates a data table with a person’s current location for a given time step.

update_tracker <- function(pos, time_step, tracker_tib) {
bind_rows(
tracker_tib,
tibble(x = pos[[1]], y = pos[[2]], t = time_step)
)
}

The move_person() function moves a person left or right by a given amount x.

move_person <- function(person, x, right = TRUE) {
if (right) {
person[[1]] <- person[[1]] + x
} else {
person[[1]] <- person[[1]] - x
}
return(person)
}

The shift_person() function shifts a person up or down by a given about y.

shift_person <- function(person, y, down = TRUE) {
if (down) {
person[[2]] <- person[[2]] - y
} else {
person[[2]] <- person[[2]] + y
}
return(person)
}

The measure_distance() function measures the distances between two ((x, y)) coordinates a and b.

measure_distance <- function(a, b) {
dist(matrix(c(a, b), nrow = 2, byrow = TRUE))[[1]]
}

Main simulation loop

The following for-loop moves each person, A and B, towards each other from 12 feet away. At each step, the distance between one another is measured, and if they are too close to each other, they are slowly moved apart until they are again safe. The movement of each person is tracked in a data table.

One complication I ran into was how to move the people back towards the middle after they passed each other. Instead, I realized that the problem is symmetric, so I could just run the first half of the simulation - from 12 to 6 feet apart - and then use the symmetry to get the second half.

A <- c(0, 0)
B <- c(12, 0)
A_tracker <- update_tracker(A, 0, tibble())
B_tracker <- update_tracker(B, 0, tibble())
for (t in seq(time_step_size, 6, time_step_size)) {
A <- move_person(A, time_step_size)
B <- move_person(B, time_step_size, right = FALSE)
while (measure_distance(A, B) < minimum_distance) {
A <- shift_person(A, 0.01, down = TRUE)
B <- shift_person(B, 0.01, down = FALSE)
}
A_tracker <- update_tracker(A, t, A_tracker)
B_tracker <- update_tracker(B, t, B_tracker)
}

The plot below shows the path of A for the first half of the simulation.

A_tracker %>%
ggplot(aes(x = x, y = y)) +
geom_line() +
labs(title = "Person A's path or the first half of the simulation")

The simulation was completed by copying the tracker data tables for A and B and combing these into a single people_tracker data table.

A_tracker <- bind_rows(
A_tracker,
A_tracker %>%
mutate(x = 6 + x, y = rev(y), t = 6 + t) %>%
filter(t != 6)
)
B_tracker <- bind_rows(
B_tracker,
B_tracker %>%
mutate(x = x - 6, y = rev(y), t = 6 + t) %>%
filter(t != 6)
)
ppl_tracker <- inner_join(A_tracker,
B_tracker,
by = "t",
suffix = c("_A", "_B"))

Finally, I could plot the paths taken by the two individuals while always remaining as close to the middle of the sidewalk as possible and keeping 6 feet apart.

ppl_tracker %>%
mutate(y_A = y_A - 0.05,
y_B = y_B + 0.05) %>%
ggplot() +
geom_line(aes(x = x_A, y = y_A), color = "red", size = 1.1) +
geom_line(aes(x = x_B, y = y_B), color = "blue", size = 1.1) +
coord_equal() +
labs(x = "x", y = "y",
title = "Social distancing paths")

The social distancing rules guides are shown in the plot below, they they overlap a lot because there is no time dimension.

ppl_tracker %>%
mutate(y_A = y_A - 0.05,
y_B = y_B + 0.05) %>%
ggplot() +
geom_ribbon(aes(x = x_A,
ymin = y_A-minimum_distance, ymax = y_A+minimum_distance),
fill = "red", color = NA, alpha = 0.1) +
geom_ribbon(aes(x = x_B,
ymin = y_B-minimum_distance, ymax = y_B+minimum_distance),
fill = "blue", color = NA, alpha = 0.1) +
geom_line(aes(x = x_A, y = y_A), color = "red", size = 1.1) +
geom_line(aes(x = x_B, y = y_B), color = "blue", size = 1.1) +
coord_equal() +
labs(x = "x", y = "y",
title = "Social distancing paths",
subtitle = "The ribbons indicate the 6 ft radius\naround each person")

I used ‘gganimate’ to show the two people walking towards each other with their 6-foot social distancing guides.

ppl_tracker %>%
mutate(y_A = y_A - 0.05,
y_B = y_B + 0.05) %>%
filter(row_number() %% 20 == 0) %>%
ggplot() +
geom_point(aes(x = x_A, y = y_A), color = "red", size = 3) +
geom_point(aes(x = x_B, y = y_B), color = "blue", size = 3) +
geom_circle(aes(x0 = x_A, y0 = y_A, r = minimum_distance / 2),
fill = "red", alpha = 0.1, color = NA) +
geom_circle(aes(x0 = x_B, y0 = y_B, r = minimum_distance / 2),
fill = "blue", alpha = 0.1, color = NA) +
coord_equal() +
labs(x = "x", y = "y", title = "Social distancing paths") +
transition_states(t, transition_length = 0.01,
state_length = 0, wrap = FALSE)

Total distance traveled

Finally, as the Riddler requested, I calculated the total distance traveled by person A.

total_distance <- 0
for (i in seq(2, nrow(A_tracker))) {
a <- c(A_tracker$x[[i - 1]], A_tracker$y[[i - 1]])
b <- c(A_tracker$x[[i]], A_tracker$y[[i]])
total_distance <- total_distance + measure_distance(a, b)
}
total_distance <- round(total_distance, 1)

Each person travels a total of 15.7 ft, 3.7 more feet than without the need for social distancing.

To leave a comment for the author, please follow the link and comment on their blog: Posts | Joshua Cook.

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)