Solving Riddle(r)s

As I look back on my blog, I can see that I have written two blog posts in the past year. Clearly, I am killig it with this blog thing.

I realized I could include some of my work solving Riddlers. For those unfamiliar, fivethirtyeight produces a regular puzzle challenge called The Riddler. While many can be solved with basic math and logic, I’ve used these as opportunities to practice/improve my coding in R and Python.

Previously, I had a separate repo where I created a basic website with {rmarkdown}. This was largely exploratory and can be found here at the website I created via github pages.

For this post, I will copy over a past Riddler puzzle for this post. Future posts will be fresh attempts looking at new Riddler challenges.

Riddler Express from June 26, 2020:

URL: https://fivethirtyeight.com/features/can-you-connect-the-dots/

In Riddler City, the city streets follow a grid layout, running north-south and east-west. You’re driving north when you decide to play a little game. Every time you reach an intersection, you randomly turn left or right, each with a 50 percent chance.

After driving through 10 intersections, what is the probability that you are still driving north?

Extra credit: Now suppose that at every intersection, there’s a one-third chance you turn left, a one-third chance you turn right and a one-third chance you drive straight. After driving through 10 intersections, now what’s the probability that you are still driving north?And what are your chances of winning the prize?

My Approach:

Well for the first question, the answer is a 50% change of driving north. Given an even number of turns, you must be facing South or North with equal probability. For this, I’ll focus on the extra credit which is a little more complicated. Full disclosure, I rushed the last little bit.

Setup

Lets generate some helper functions. I figure I need to create random turns based on the available diretions and then repeat the process 10 times. I quickly documented these helpers.

library(dplyr)
options(stringsAsFactors = FALSE)

# Generate valid turn options
# Requires a character argument
# returns a character vector
turn_options <- function(direction){
  
  if(!direction %in% c("North", "East", "South", "West")){
    message("Invalid Direction.  Try 'North', 'South', 'East' or 'West'")
  } else {
  if(direction == "North"){options <- c("West", "North", "East")}
  if(direction == "East"){options <- c("North", "East", "South")}
  if(direction == "South"){options <- c("East", "South", "West")}
  if(direction == "West"){options <- c("South", "West", "North")}
  return(options)
  }
}

# Take a direction and  make a random turn
# Requires a character input
# Returns a character (direction you are heading)
turn_random <- function(direction) {
  turn.options <- turn_options(direction)
  result <- sample(turn.options, 1)
  return(result)
    
}

# Randomly turn ten times and see where you end up
# Dont love while loop, but hey its quick
turn_10_times <- function(initial.direction = "North"){
  
  turn.result <- turn_random(initial.direction)
  count <- 1
  while(count < 10){
    turn.result <- turn_random(turn.result)
    count <- count + 1
  }
  return(turn.result)
}

Now that we have some helpers, lets generate some simulations. First, we’ll start by simply generating results, adn then seeing the perecnt change of driving North.

trial.count <- 100000
sim <- tibble::tibble(
  trial = 1:trial.count,
  outcome = base::replicate(trial.count, turn_10_times())
) 
sim$outcome %>% janitor::tabyl() %>% janitor::adorn_pct_formatting()
##      .     n percent
##   East 24977   25.0%
##  North 24949   24.9%
##  South 24938   24.9%
##   West 25136   25.1%
result <- sim %>% 
  summarise(chance.north = sum(ifelse(outcome == "North", 1, 0)) / n())

Looks like there is a 0.25% chance of still heading north.

Plot Paths

For fun, I wanted to go one step further and visualize the path the car could take.

New Helper Functions

This was done quickly, and I spent less time documenting my code. There is LOADS of room for improvement here.


# Genenrate actual path of simulation
# Lots of quick code at the end to create data format I wanted
turn_10_times_path <- function(initial.direction = "North"){
  path <- tibble::tibble(
    start  = "start",  
    turn1  = turn_random(initial.direction),
    turn2  = turn_random(turn1),
    turn3  = turn_random(turn2),
    turn4  = turn_random(turn3),
    turn5  = turn_random(turn4),
    turn6  = turn_random(turn5),
    turn7  = turn_random(turn6),
    turn8  = turn_random(turn7),
    turn9  = turn_random(turn8),
    turn10 = turn_random(turn9),
  ) %>% 
    t() %>% 
    as.data.frame() %>%
    tibble::rownames_to_column() %>% 
    setNames(c("Turn", "Path")) 
  return(path)
}

add_x_coords <- function(dataset, num.turns){
  result.vector <- c(0)
  x <- 0
  for(row in 2:num.turns){
    direction <- dataset$Path[row]
    if(direction == "East"){x <- x + 1}
    if(direction == "West"){x <- x - 1}
    result.vector <- append(result.vector, x)
  }
  dataset <- dataset %>% 
    mutate(x = result.vector)
  return(dataset)
}

add_y_coords <- function(dataset, num.turns){
  result.vector <- c(0)
  y <- 0
  for(row in 2:num.turns){
    direction <- dataset$Path[row]
    if(direction == "North"){y <- y + 1}
    if(direction == "South"){y <- y - 1}
    result.vector <- append(result.vector, y)
  }
  dataset <- dataset %>% 
    mutate(y = result.vector)
  return(dataset)
}

generate_one_scenario <- function(number.turns = 10, trial.input = 1){
  dat <- turn_10_times_path() %>% 
    add_x_coords(num.turns = number.turns+1) %>% 
    add_y_coords(num.turns = number.turns+1) %>% 
    mutate(trial = trial.input) %>% 
    select(trial, everything())
  return(dat)
}

generate_many_trials <- function(trial.count) {
  df.out <- generate_one_scenario()
  trial <- 1
  for(trials in 1:(trial.count-1)){
    trial <- trial + 1
    result.df <- generate_one_scenario(trial.input = trial)
    df.out <- rbind(df.out, result.df)
  }
  return(df.out)
}
library(ggplot2)
trial.count <- 1000
sim <- generate_many_trials(trial.count)
sim %>% 
  ggplot(aes(x, y, group = trial, color = trial)) + 
  geom_path(alpha= 0.05) +
  geom_point(aes(x,y), 
             data = sim %>% 
               filter(Turn == "turn10") %>% 
               add_count(x,y),
             alpha = 0.02,
             color="red") +
  geom_point(aes(x = 0, y =0), color = "darkgreen", size = 4.5) +
  theme_minimal() +
  xlim(-10, 10) +
  ylim(-10, 10) +
  labs(title = "Path taken for each trial",
       subtitle = "Green dot represents starting point, red dots ending point."
       ) +
  theme(legend.position = "none") 

There we go! It might be interesting to see the path from each trip, but for now I just have the start and ending points. It’s rough, but glad to have actually ‘written’ a blog post again.