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)来使线条缩小为点，anim <- p + transition_layers(keep_layers = FALSE) + enter_grow() + exit_fly(x_loc = 2000) + exit_shrink() + ease_aes(default = "cubic-in-out") anim指定了线条在x轴上的飞行角度为2000。

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

{
    [portfolioId[0]]: "Dhaka",
    [portfolioId[1]]: "Chittagong",
    [portfolioId[2]]: "Sylhet",
}

提供以下动画

由于某些原因，这些点的enter_grow（）并不如您想的那样平滑。

动画geom_line（）崩溃为geom_point（）

1 个答案: