Animate geom_line() collapsing into geom_point()

I'd like to have an animation where some lines collapse into points, which are the mean value, to demonstrate that the lines can be summarised by the mean value.

Something like this.

First, set up the data, and the line plot:

library(tidyverse)
# remotes::install_github("njtierney/brolgar)
# library(brolgar)
# h_cut <- sample_n_keys(heights, 5) %>%
#   mutate(type = "raw") 
# 
# datapasta::dpasta(h_cut)

h_cut <- tibble::tribble(
                 ~country, ~year, ~height_cm, ~continent, ~type,
                "Bolivia",  1890,    163.594, "Americas", "raw",
                "Bolivia",  1900,     162.45, "Americas", "raw",
                "Bolivia",  1930,      162.5, "Americas", "raw",
                "Bolivia",  1940,      163.4, "Americas", "raw",
                "Bolivia",  1950,    162.482, "Americas", "raw",
                "Bolivia",  1960,    163.182, "Americas", "raw",
                "Bolivia",  1970,    163.886, "Americas", "raw",
                "Bolivia",  1980,    164.191, "Americas", "raw",
                "Bolivia",  1990,      168.1, "Americas", "raw",
                "Bolivia",  2000,      168.7, "Americas", "raw",
               "Ethiopia",  1860,      169.3,   "Africa", "raw",
               "Ethiopia",  1880,    167.461,   "Africa", "raw",
               "Ethiopia",  1910,    161.451,   "Africa", "raw",
               "Ethiopia",  1920,    166.636,   "Africa", "raw",
               "Ethiopia",  1930,     167.27,   "Africa", "raw",
               "Ethiopia",  1940,      168.5,   "Africa", "raw",
               "Ethiopia",  1950,    166.823,   "Africa", "raw",
               "Ethiopia",  1960,    167.512,   "Africa", "raw",
               "Ethiopia",  1970,     167.49,   "Africa", "raw",
               "Ethiopia",  1980,    167.253,   "Africa", "raw",
                "Georgia",  1840,      165.5,     "Asia", "raw",
                "Georgia",  1860,        163,     "Asia", "raw",
                "Georgia",  1890,     164.26,     "Asia", "raw",
                "Georgia",  2000,      173.2,     "Asia", "raw",
               "Paraguay",  1900,    165.615, "Americas", "raw",
               "Paraguay",  1930,    165.363, "Americas", "raw",
               "Paraguay",  1990,      172.6, "Americas", "raw",
                  "Spain",  1740,      163.3,   "Europe", "raw",
                  "Spain",  1750,      163.6,   "Europe", "raw",
                  "Spain",  1760,      163.2,   "Europe", "raw",
                  "Spain",  1770,      164.3,   "Europe", "raw",
                  "Spain",  1780,      163.3,   "Europe", "raw",
                  "Spain",  1830,        161,   "Europe", "raw",
                  "Spain",  1840,      163.7,   "Europe", "raw",
                  "Spain",  1850,      162.5,   "Europe", "raw",
                  "Spain",  1860,      162.7,   "Europe", "raw",
                  "Spain",  1870,      162.6,   "Europe", "raw",
                  "Spain",  1880,      163.9,   "Europe", "raw",
                  "Spain",  1890,        164,   "Europe", "raw",
                  "Spain",  1900,      164.6,   "Europe", "raw",
                  "Spain",  1910,      165.1,   "Europe", "raw",
                  "Spain",  1920,      165.6,   "Europe", "raw",
                  "Spain",  1930,      165.2,   "Europe", "raw",
                  "Spain",  1940,      166.3,   "Europe", "raw",
                  "Spain",  1950,      170.8,   "Europe", "raw",
                  "Spain",  1960,      174.2,   "Europe", "raw",
                  "Spain",  1970,      175.2,   "Europe", "raw",
                  "Spain",  1980,      175.6,   "Europe", "raw"
               )
ggplot(h_cut,
       aes(x = year,
           y = height_cm,
           colour = country)) + 
  geom_line() + 
  theme(legend.position = "bottom")

Then, show the points


# demonstrate these lines collapsing down onto a point
h_sum <- h_cut %>%
  group_by(country) %>%
  summarise(height_cm = mean(height_cm)) %>%
  mutate(year = max(h_cut$year),
         type = "summary")

ggplot(h_sum,
       aes(x = year,
           y = height_cm)) + 
  geom_point()

These can be combined into one plot like so:


# combined:
p <- ggplot(h_cut,
            aes(x = year,
                y = height_cm,
                colour = country)) + 
  geom_line() + 
  geom_point(data = h_sum,
             aes(x = year,
                 y = height_cm,
                 colour = country))

p

Manually transition from line to points

library(gganimate)
anim <- p + 
  transition_layers(keep_layers = FALSE) + 
  enter_grow() + 
  exit_shrink() + 
  ease_aes(default = "cubic-in-out")

anim

But is there some way to make the lines shrink into the points?

h_full <- h_sum %>% full_join(h_cut)
#> Joining, by = c("country", "height_cm", "year", "type")

h_full 
#> # A tibble: 53 x 5
#>    country  height_cm  year type    continent
#>    <chr>        <dbl> <dbl> <chr>   <chr>    
#>  1 Bolivia       164.  2000 summary <NA>     
#>  2 Ethiopia      167.  2000 summary <NA>     
#>  3 Georgia       166.  2000 summary <NA>     
#>  4 Paraguay      168.  2000 summary <NA>     
#>  5 Spain         166.  2000 summary <NA>     
#>  6 Bolivia       164.  1890 raw     Americas 
#>  7 Bolivia       162.  1900 raw     Americas 
#>  8 Bolivia       162.  1930 raw     Americas 
#>  9 Bolivia       163.  1940 raw     Americas 
#> 10 Bolivia       162.  1950 raw     Americas 
#> # … with 43 more rows

p <- ggplot(h_full,
       aes(x = year,
           y = height_cm,
           group = country,
           colour = type)) + 
  geom_point() + 
  geom_line()


anim <- p + transition_states(type)
anim
#> Error in `$<-.data.frame`(`*tmp*`, ".id", value = c(1L, 1L, 1L, 1L, 1L, : replacement has 250 rows, data has 5

^{Created on 2019-07-25 by the reprex package (v0.3.0)}

Solution

It seems as though you can stack multiple enter and exit animations together, such as exit_shrink and exit_fly.

Given the code you provided, I was able to have the lines shrink into the points by adding exit_fly(x_loc = 2000), which specifies that the lines fly to 2000 on the x axis.

Here is the edited code chunk which specifies the animation

anim <- p + 
  transition_layers(keep_layers = FALSE) + 
  enter_grow() + 
  exit_fly(x_loc = 2000) + 
  exit_shrink() +
  ease_aes(default = "cubic-in-out")

anim

giving the following animation

For some reason the enter_grow() for the points isn't as smooth as your example which I could not figure out.