动画排序的条形图，条形相互超越 [英] Animated sorted bar chart with bars overtaking each other

问题描述

编辑：关键字是条形图竞赛

您将如何从

我将其标记为 ggplot2 和 gganimate ，但可以从R中生成的任何内容都是相关的。

数据（感谢

---

我改编了我的答案

 库（tidyverse）
库（gganimate）
库（gapminder）
 theme_set（theme_classic（））
 
 gap<-gapminder％>％
 filter（continent == Asia）％&％;％
 group_by（year）％>％
＃* 1使滑动
 mutate时具有非整数等级成为可能（rank = min_rank（-gdpPercap）* 1）％>％
 ungroup（）
 
p<-ggplot（gap，aes（rank，group = country，
 fill = as.factor（country），color = as.factor（country）） ）+ 
 geom_tile（aes（y = gdpPercap / 2，
 height = gdpPercap，
宽度= 0.9），alpha = 0.8，颜色= NA）+ 
 
＃x轴上的文本（需要在coord_ *中使用clip = off）
＃ paste（country，）是一种可以使间距很好的技巧，因为hjust> 1 
＃导致文本间距中的异常产物。 
 geom_text（aes（y = 0，label = paste（country，）），vjust = 0.2，hjust = 1）+ 
 
 coord_flip（clip = off，展开= FALSE）+ 
 scale_y_continuous（标签=标尺::逗号）+ 
 scale_x_reverse（）+ 
指南（颜色= FALSE，填充= FALSE）+ 
 
实验室（ title ='{closest_state}'，x =，y =人均GFP）+ 
 theme（plot.title = element_text（just = 0，size = 22），
 axis.ticks .y = element_blank（），＃这些与翻转后的轴
 axis.text.y = element_blank（），＃这些与翻转后的轴
图.margin = margin（1 ，1,1,4， cm））+ 
 
 transition_states（year，transition_length = 4，state_length = 1）+ 
 ease_aes（'cubic-in-out'）
 
动画（p，fps = 25，持续时间= 20，宽度= 800，高度= 600）
  

$ b对于顶部的更平滑版本，我们可以在绘制步骤之前添加一个步骤以进一步插值数据。插值两次非常有用，一次以粗粒度确定排名，另一次插值更精细。如果排名计算得太精细，则条形图将太快交换位置。

  gap_smoother<-gapminder％&％;％
 filter（continent == Asia）％&％;％
 group_by（国家/地区）％&％;％
＃对
排名进行一些粗略的插值＃（否则，排名会发生不愉快的变化
 complete（year = full_seq（year，1））％>％
 mutate（gdpPercap = spline（x = year，y = gdpPercap，xout = year）$ y）％> ％
 group_by（year）％>％
 mutate（rank = min_rank（-gdpPercap）* 1）％>％
 ungroup（）％>％
 
＃然后进一步内插到四分之一年以进行快速数字滴答。 
＃内插先前计算的等级。 
 group_by（国家/地区）％>％
完成（year = full_seq（year，.5））％>％
 mutate（gdpPercap = spline（x = year，y = gdpPercap， xout =年）$ y）％&％;％
＃下面的近似用于线性插值。 样条曲线具有弹力效果。 
 mutate（等级=大约（x =年，y =等级，xout =年）$ y）％&％;％
 ungroup（）％&％;％
排列（国家/地区） 
  

然后，该图使用了一些修改的行，否则相同：

  p<-ggplot（gap_smoother，... 
＃这行是用于打勾
的数字的行geom_text（aes（y = gdpPercap，
 label = scales :: comma（gdpPercap）），hjust = 0，nudge_y = 300）+ 
 ... 
 labs（title ='{closest_state％>％as。数字％>％floor}'，
x =，y =人均GFP）+ 
 ... 
 transition_states（year，transition_length = 1，state_length = 0）+ 
 enter_grow（）+ 
 exit_shrink（）+ 
 ease_aes（'linear'）
 
 animate（p，fps = 20，持续时间= 5，宽度= 400，高度= 600，end_pause = 10）
  

Edit: keyword is 'bar chart race'

How would you go at reproducing this chart from Jaime Albella in R ?

See the animation on visualcapitalist.com or on twitter (giving several references in case one breaks).

I'm tagging this as ggplot2 and gganimate but anything that can be produced from R is relevant.

data (thanks to https://github.com/datasets/gdp )

gdp <- read.csv("https://raw.github.com/datasets/gdp/master/data/gdp.csv")
# remove irrelevant aggregated values
words <- scan(
  text="world income only total dividend asia euro america africa oecd",
  what= character())
pattern <- paste0("(",words,")",collapse="|")
gdp  <- subset(gdp, !grepl(pattern, Country.Name , ignore.case = TRUE))

Edit:

Another cool example from John Murdoch :

Most populous cities from 1500 to 2018

解决方案

Edit: added spline interpolation for smoother transitions, without making rank changes happen too fast. Code at bottom.

---

I've adapted an answer of mine to a related question. I like to use geom_tile for animated bars, since it allows you to slide positions.

I worked on this prior to your addition of data, but as it happens, the gapminder data I used is closely related.

library(tidyverse)
library(gganimate)
library(gapminder)
theme_set(theme_classic())

gap <- gapminder %>%
  filter(continent == "Asia") %>%
  group_by(year) %>%
  # The * 1 makes it possible to have non-integer ranks while sliding
  mutate(rank = min_rank(-gdpPercap) * 1) %>%
  ungroup()

p <- ggplot(gap, aes(rank, group = country, 
                     fill = as.factor(country), color = as.factor(country))) +
  geom_tile(aes(y = gdpPercap/2,
                height = gdpPercap,
                width = 0.9), alpha = 0.8, color = NA) +

  # text in x-axis (requires clip = "off" in coord_*)
  # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1 
  #   leads to weird artifacts in text spacing.
  geom_text(aes(y = 0, label = paste(country, " ")), vjust = 0.2, hjust = 1) +

  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +

  labs(title='{closest_state}', x = "", y = "GFP per capita") +
  theme(plot.title = element_text(hjust = 0, size = 22),
        axis.ticks.y = element_blank(),  # These relate to the axes post-flip
        axis.text.y  = element_blank(),  # These relate to the axes post-flip
        plot.margin = margin(1,1,1,4, "cm")) +

  transition_states(year, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

animate(p, fps = 25, duration = 20, width = 800, height = 600)

---

For the smoother version at the top, we can add a step to interpolate the data further before the plotting step. It can be useful to interpolate twice, once at rough granularity to determine the ranking, and another time for finer detail. If the ranking is calculated too finely, the bars will swap position too quickly.

gap_smoother <- gapminder %>%
  filter(continent == "Asia") %>%
  group_by(country) %>%
  # Do somewhat rough interpolation for ranking
  # (Otherwise the ranking shifts unpleasantly fast.)
  complete(year = full_seq(year, 1)) %>%
  mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %>%
  group_by(year) %>%
  mutate(rank = min_rank(-gdpPercap) * 1) %>%
  ungroup() %>%

  # Then interpolate further to quarter years for fast number ticking.
  # Interpolate the ranks calculated earlier.
  group_by(country) %>%
  complete(year = full_seq(year, .5)) %>%
  mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %>%
  # "approx" below for linear interpolation. "spline" has a bouncy effect.
  mutate(rank =      approx(x = year, y = rank,      xout = year)$y) %>%
  ungroup()  %>% 
  arrange(country,year)

Then the plot uses a few modified lines, otherwise the same:

p <- ggplot(gap_smoother, ...
  # This line for the numbers that tick up
  geom_text(aes(y = gdpPercap,
                label = scales::comma(gdpPercap)), hjust = 0, nudge_y = 300 ) +
  ...
  labs(title='{closest_state %>% as.numeric %>% floor}', 
   x = "", y = "GFP per capita") +
...
transition_states(year, transition_length = 1, state_length = 0) +
enter_grow() +
exit_shrink() +
ease_aes('linear')

animate(p, fps = 20, duration = 5, width = 400, height = 600, end_pause = 10)

这篇关于动画排序的条形图，条形相互超越的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！