动画 geom_line() 折叠成 geom_point()

Question

我想要一个动画，其中一些线折叠成点，这是平均值，以证明线可以用平均值概括。

像这样。

首先，设置数据和线图：

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")

然后，显示分数


# 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()

这些可以像这样组合成一个图：


# 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

手动从线过渡到点

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

anim

但是有什么方法可以让线 收缩成 点吗？

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

^{由 reprex package (v0.3.0)}

于 2019-07-25 创建

Answer 1

似乎可以将多个进入和退出动画堆叠在一起，例如 exit_shrink 和 exit_fly。

根据您提供的代码，我可以通过添加 exit_fly(x_loc = 2000) 将线缩小为点，它指定线在 x 轴上飞到 2000。

这是指定动画的已编辑代码块

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

anim

给出以下动画

由于某些原因，点的 enter_grow() 不像您的示例那样流畅，我无法理解。

动画 geom_line() 折叠成 geom_point()

Animate geom_line() collapsing into geom_point()

r

ggplot2

gganimate