3

The below code makes a plot of the actual slope (the red line) produced by running linear regression using the entire mtcars data. The plot also shows all the slopes produced by using subsets of mtcars (black lines).

But how can I show the slopes produced using subsets of mtcars (the black lines) one at a time using gganimate?

Also, the abline is has been drawn below the minimum value of mtcars$drat and above the maximum value of mtcars$drat. How can I make the abline stop at the minimum and maximum values?

Make tibble

library(tibble); library(dplyr); library(purrr); library(ggplot2); library(gganimate)

tibble(actual.slope = lm(mpg ~ drat, mtcars)$coef[2], actual.intercept = lm(mpg ~ drat, mtcars)$coef[1]) -> 
  mtcars_slopes

sample_slope <- function() {
  mtcars %>% 
    slice_sample(prop = 0.5, replace = TRUE) ->
    mtcars_sample
    
  lm(mpg ~ drat, mtcars_sample)$coef[2] -> sample.slope
  lm(mpg ~ drat, mtcars_sample)$coef[1] -> sample.intercept
  
  tibble(sample.slope, sample.intercept)
}

purrr::map_df(1:1000, function(x) sample_slope()) -> df

cbind(mtcars_slopes, df) -> mtcars_slopes

Plot

ggplot() +
  geom_point(data = mtcars, aes(drat, mpg), color = "black", fill = NA, size = 1, alpha = 1) +
  geom_abline(slope = mtcars_slopes$actual.slope, intercept = mtcars_slopes$actual.intercept, colour = "red", alpha = 1, size = 1.5) +
  geom_abline(slope = mtcars_slopes$sample.slope, intercept = mtcars_slopes$sample.intercept, colour = "black", alpha = 0.02)

enter image description here

luciano
  • 13,158
  • 36
  • 90
  • 130

1 Answers1

2

Here is how it works:

library(gganimate)
library(ggplot2)

ggplot(df) +
  geom_point(data = mtcars, aes(drat, mpg), color = "black", fill = NA, size = 1, alpha = 1) +
  geom_abline(aes(slope = sample.slope, intercept = sample.intercept), color = "black", alpha = 0.2) +
  theme_bw()+
  labs(title = "Sample Slope: {closest_state}") +
  transition_states(cumsum(!is.na(sample.slope)), 
                    transition_length = 0.5,
                    state_length = 1,
                    wrap = FALSE) +
  shadow_mark()+
  ease_aes('linear')+
  geom_abline(aes(slope = mtcars_slopes$actual.slope, 
                  intercept = mtcars_slopes$actual.intercept), 
              color = "red", alpha = 1, size = 1.5) 

enter image description here

TarJae
  • 72,363
  • 6
  • 19
  • 66