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

问题描述

关键字是条形图竞赛"

您将如何在 R 中从

我将其标记为 ggplot2 和 gganimate 但任何可以从 R 生成的东西都是相关的.

数据(感谢

<小时>

我改编了我的一个答案

图书馆(tidyverse)图书馆(gganimate)图书馆(gapminder)主题集(主题经典())间隙<-gapminder%>%过滤器(大陆==亚洲")%>%group_by(年)%>%# * 1 使得滑动时可以有非整数等级变异(等级= min_rank(-gdpPercap)* 1)%>%取消分组()p <- ggplot(gap, aes(rank, group = country,填充 = as.factor(country), color = as.factor(country))) +geom_tile(aes(y = gdpPercap/2,高度 = 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", expand = FALSE) +scale_y_continuous(labels = scales::comma) +scale_x_reverse() +指南(颜色 = FALSE，填充 = FALSE)+实验室(title='{closest_state}', x = "", y = "人均GFP") +主题(plot.title = element_text(hjust = 0, size = 22),axis.ticks.y = element_blank(), # 这些与轴翻转后有关axis.text.y = element_blank(), # 这些与轴翻转后有关plot.margin = margin(1,1,1,4, "cm")) +transition_states(year, transition_length = 4, state_length = 1) +ease_aes('立方进出')动画(p，fps = 25，持续时间 = 20，宽度 = 800，高度 = 600)

<小时>

对于顶部更平滑的版本，我们可以在绘图步骤之前添加一个步骤来进一步插入数据.插值两次可能很有用，一次以粗粒度确定排名，另一次用于更精细的细节.如果排名计算得太细，柱线会过快地交换位置.

gap_smoother <- gapminder %>%过滤器(大陆==亚洲")%>%group_by(country) %>%# 对排名做一些粗略的插值#(否则排名变化得非常快.)完成(年 = full_seq(年，1))%>%变异(gdpPercap = spline(x = 年，y = gdpPercap，xout = 年)$y)%>%group_by(年)%>%变异(等级= min_rank(-gdpPercap)* 1)%>%取消分组()%>%# 然后进一步插值到季度年以进行快速数字滴答.# 插入先前计算的等级.group_by(country) %>%完成(年 = full_seq(年，.5))%>%变异(gdpPercap = spline(x = 年，y = gdpPercap，xout = 年)$y)%>%# "approx" 下面是线性插值.样条"具有弹性效果.变异(等级 = 近似(x = 年，y = 等级，xout = 年)$y)%>%取消分组()%>%安排(国家，年份)

然后情节使用了一些修改的线条，否则相同:

p <- ggplot(gap_smoother, ...# 这一行是打勾的数字geom_text(aes(y = gdpPercap,标签 = 尺度::逗号(gdpPercap)), hjust = 0, nudge_y = 300 ) +...实验室(title='{closest_state %>% as.numeric %>% floor}',x = "", y = "人均 GFP") +...过渡状态(年，过渡长度= 1，状态长度= 0)+enter_grow() +exit_shrink() +ease_aes('线性')动画(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屋！