Riddler Express - March 20, 2020

Solving a math puzzle and exploring the accumulate() function

R
Puzzles
Coding Challenge
Published

March 31, 2020

One of my personal goals for 2020 is to improve my proficiency doing data-y things – mostly using R, but potentially other software as well. Typically, I’ve been using data from the #TidyTuesday project to practice data visualization and data from Kaggle, personal research projects, and other potentially interesting datasets to work on statistical modeling. I recently discovered The Riddler series – a weekly math/logic puzzle – that seems to be a good medium for brushing up on other skills (e.g. certain types of math and programming) that may not come up as often when I do visualizations or statistics.

The Problem

Anyway, this post solves the Riddler Express puzzle from March 20, 2020. The problem is this:

A manager is trying to produce sales of his company’s widget, so he instructs his team to hold a sale every morning, lowering the price of the widget by 10 percent. However, he gives very specific instructions as to what should happen in the afternoon: Increase the price by 10 percent from the sale price, with the (incorrect) idea that it would return it to the original price. The team follows his instructions quite literally, lowering and then raising the price by 10 percent every day.

After N days, the manager walks through the store in the evening, horrified to see that the widgets are marked more than 50 percent off of their original price. What is the smallest possible value of N?

I’ll walk through a couple of ways to solve this – first, I’ll solve it algebraically, and next, I’ll solve it by “brute force” using the accumulate() function from the {purrr} package.

Solving Algebraically

So, the first thing that strikes me when reading this is that it’s essentially a compounding interest problem, except in this case the interest is negative. That is, rather than gaining value exponentially over the number of compounding periods, we’re losing value exponentially. The formula for calculating compound interest is:

\[A = P(1 + r)^n\]

where A equals the final amount, P equals the principal (our initial value), r equals the interest rate, and n equals the number of compounding periods (the number of days in this case). We’re interested in solving for the value of n where our final amount, A, is less than .5. Our principal amount, P, in this case, is 1 (i.e. 100% of the value). So, our equation looks like this:

\[.5 > ((1-1*.1)*1.1)^n\]

The internal logic here is that we subtract 10% from our initial value (1-1*.1) to represent the 10% decrease in price in the morning, then multiply this resulting value by 1.1 to represent the subsequent 10& increase in price in the afternoon. This simplifies to:

\[.5 > .99^n\]

From here, we can just solve by taking the log of each side and then dividing, which get us our answer

n <- log(.5)/log(.99)
n
[1] 68.96756

Rounding this up (since we’re dealing in full days), we can say that after 69 days, the price of the widget will be below 50% of its initial price.

Solving using accumulate()

We can also solve this problem using the accumulate() function from the {purrr} package, which is part of the {tidyverse}. Essentially, accumulate() will take a function, evaluate it, and then pass the result of the evaluation back into the function, evaluate it again, pass the new result back into the function, etc. This makes it useful for solving problems like this one, where the end price of the widget on the previous day is the starting price of the widget on the current day.

First, let’s load our packages. For this, we’ll just use {tidyverse}

library(tidyverse)

Next, let’s set up a function that, if we give it the price of the widget at the beginning of the day, will calculate the price of the widget at the end of the day.

discount_func <- function(x) {
  (x-x*.1)*1.1
}

And then let’s test this function manually a few times.

discount_func(1)
[1] 0.99
discount_func(.99)
[1] 0.9801
discount_func(.9801)
[1] 0.970299

Now, we can use accumulate() to automate what we just did manually. The first argument in accumulate() is, in this case, each day that we want to pass into the function. In the code below, I’m testing this for days 0-3 (but coded as 1-4 because we want the start value to be 1). The second argument is the function we just wrote.

accumulate(1:4, ~discount_func(.))
[1] 1.000000 0.990000 0.980100 0.970299

And we can see that the values returned match our manual tests above, which is good!

Now, we can use accumulate() to make a table with the end price of the widget each day. Note that because we want to start the widget price at 1, our first “day” in the table is day 0, which represents the beginning price of the widget on day 1.

days_tbl <- tibble(
  day = c(0:1000),
  end_price = accumulate(c(1:1001), ~discount_func(.))
)
head(days_tbl)
# A tibble: 6 × 2
    day end_price
  <int>     <dbl>
1     0     1    
2     1     0.99 
3     2     0.980
4     3     0.970
5     4     0.961
6     5     0.951

And then we can plot the end price over time. I’ve added a little bit of transparency to each point so we can more easily see the clustering/overlap.

ggplot(days_tbl, aes(x = day, y = end_price)) +
  geom_point(alpha = .3) +
  theme_minimal() +
  labs(
    title = "End Price of Widget over Time"
  )

Finally, we can find the day where the end price is below .5 by filtering our table to only those where the price is less than .5 and then returning the first row.

days_tbl %>%
  filter(end_price <= .5) %>%
  slice(1)
# A tibble: 1 × 2
    day end_price
  <int>     <dbl>
1    69     0.500

And we can see that this matches our algebraic result – great success!

Reuse

Citation

BibTeX citation:
@online{ekholm2020,
  author = {Ekholm, Eric},
  title = {Riddler {Express} - {March} 20, 2020},
  date = {2020-03-31},
  url = {https://www.ericekholm.com/posts/riddler-express-march-20-2020},
  langid = {en}
}
For attribution, please cite this work as:
Ekholm, Eric. 2020. “Riddler Express - March 20, 2020.” March 31, 2020. https://www.ericekholm.com/posts/riddler-express-march-20-2020.