@Andrzej. For adding clock, rescale the height to make the coordination in equal scale. Draw the circle with geom_circle from geforce package. Pre-calculate the coordinate of the hand of the clock in the data. Draw the hand with geom_segment. Finally, adjust the aspect.ratio to make the circle orbit.
library(tidyverse)
library(ggimage)
library(gganimate)
library(gapminder)
library(ggforce)
library(transformr)
library(av)
theme_set(theme_classic())
geom_numeric <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
parse = FALSE,
nudge_x = 0,
nudge_y = 0,
check_overlap = FALSE,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE)
{
if (!missing(nudge_x) || !missing(nudge_y)) {
if (!missing(position)) {
stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE)
}
position <- position_nudge(nudge_x, nudge_y)
}
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomNumeric,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
parse = parse,
check_overlap = check_overlap,
na.rm = na.rm,
...
)
)
}
GeomNumeric <- ggproto("GeomNumeric", Geom,
required_aes = c("x", "y", "label"),
default_aes = aes(
colour = "black", size = 3.88, angle = 0, hjust = 0.5,
vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2
),
draw_panel = function(data, panel_params, coord, parse = FALSE,
na.rm = FALSE, check_overlap = FALSE) {
lab <- data$label
if (parse) {
lab <- scales::comma(as.numeric(lab), accuracy = 1)
}
data <- coord$transform(data, panel_params)
if (is.character(data$vjust)) {
data$vjust <- compute_just(data$vjust, data$y)
}
if (is.character(data$hjust)) {
data$hjust <- compute_just(data$hjust, data$x)
}
grid::textGrob(
lab,
data$x, data$y, default.units = "native",
hjust = data$hjust, vjust = data$vjust,
rot = data$angle,
gp = grid::gpar(
col = alpha(data$colour, data$alpha),
fontsize = data$size * .pt,
fontfamily = data$family,
fontface = data$fontface,
lineheight = data$lineheight
),
check.overlap = check_overlap
)
},
draw_key = draw_key_text
)
dataForAnim <- gapminder %>%
filter(continent == "Americas") %>%
group_by(year) %>%
# The * 1 makes it possible to have non-integer ranks while sliding
mutate(rank = min_rank(-gdpPercap) * 1) %>%
mutate(height = gdpPercap / max(gdpPercap) * 25) %>%
ungroup() %>%
mutate(degree = (year - min(year)) / (max(year) - min(year)) * 360,
clockx = 18 + 0.7 * cos(pi * (degree/180)),
clocky = 20 + 0.7 * sin(pi * (degree/180)))
dataForAnim %>%
ggplot() +
geom_col(aes(max(rank) - rank, height, fill = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8))) +
geom_text(aes(max(rank) - rank, -0.75, label = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 1) +
geom_numeric(aes(max(rank) - rank, height + 2.5, label = gdpPercap, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 0, parse = TRUE) +
geom_image(aes(max(rank) - rank, height + 1.25), image = "https://www.r-project.org/logo/Rlogo.png") +
geom_text(aes(x = 16, y = 20, label = as.character(year)), size = 5) +
geom_circle(aes(x0 = 18, y0 = 20, r = 1)) +
geom_segment(aes(x = 18, y = 20, xend = clockx, yend = clocky)) +
coord_flip() +
guides(fill = FALSE, alpha = FALSE) +
scale_y_continuous(limits = c(-10, 30)) +
theme_void() +
theme(aspect.ratio = 0.25) +
transition_states(year, transition_length = 200000, state_length = 2000, wrap = FALSE) +
view_follow(fixed_x = c(15, 25), fixed_y = c(-10, 30))
