将geom_line()动画转变为geom_point()

3
我希望有一个动画,其中一些线条会坍塌成为点,这些点是平均值,以此来展示这些线条可以通过平均值进行总结。
类似于这样的效果。
首先,设置数据和线图:
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包 (v0.3.0) 创建于2019-07-25。

1个回答

1
似乎可以将多个进入和退出动画堆叠在一起,例如exit_shrinkexit_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 image description here

由于某种原因,我无法像你的示例那样顺畅地执行点数的enter_grow()函数,但我无法找出原因。

哇,非常感谢您!我甚至没有考虑过exit_fly()可以组合使用。这太棒了。谢谢! - Nick Tierney

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接