animation for polynomial regression overfitting

overfitting_poly.R

library(tidyverse)
library(gganimate)
set.seed(8)

grid <- seq(-5,12, by=0.01)

x <- seq(-3,9, by=1)
y <- x^2 + rnorm(n=length(x), sd=30)
data <-tibble(x=x, y=y)

# Create data given a polynomial degree
get_data <- function(degree){
  df <- tibble(x=grid)
  fit <- lm(y ~ poly(x, degree, raw=TRUE))
  df$y <- predict(fit, newdata=df)
  return(df)
}

# Generate the data for each degree
df <- map_dfr(1:13, ~get_data(.x) %>% mutate(n=.x))

anim <- 
  df %>%
  ggplot(aes(x=x, y=y)) +
  geom_line(color="#8f2727") + # plot polynomial regression
  geom_point(data=data, mapping=aes(x=x,y=y))+ # plot underplying data points
  geom_line(mapping=aes(x=x,y=x^2), linetype=2, color="gray", alpha=0.5)+ # plot true model
  coord_cartesian(xlim=c(-5,12), ylim=c(-100,150))+
  labs(subtitle = "Polynomial Degree: {closest_state}",
       title = "Overfitting with polynomials",
       x= "x",
       y= "y",
       caption = "True model shown in dashed line") +
  cowplot::theme_cowplot(font_family = "Source Sans Pro",
                         font_size = 10) +
  theme(plot.title = element_text(size=10)) +
  theme(legend.position = "none")+
  transition_states(n, state_length = 1, transition_length = 2, wrap=FALSE) +
  ease_aes('quartic-in-out')

# Render animation
out <- animate(anim,
               duration=8,
               fps=60,
               height = 3,
               width = 4,
               units = "in",
               res = 300,
               renderer = ffmpeg_renderer())

# Save to mp4
anim_save(animation = out, filename = "overfitting_anim.mp4")