动画排序条形图：重叠条的问题
Animated sorted bar chart: problem with overlapping bars
我创建了一个动画条形图来显示一些球员的进球数。整个代码下方显示了我是如何得出输出的。
动画如愿。但是，具有相同值的柱重叠。
我想防止条形重叠。最好的情况是先得分的玩家显示在同段位的其他玩家之上。
动画开始时得分相同的玩家顺序无关紧要。
library(tidyverse)
library(gganimate)
theme_set(theme_classic())
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
gap <- df %>%
group_by(Gameday) %>%
mutate(rank = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank <=10) %>%
ungroup()
p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
fill = as.factor(Player), color = as.factor(Player))) +
geom_tile(aes(y = Goals/2,
height = Goals,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
p
代码输出如下图：
补充说明：
最后，应根据以下示例显示条形图。最好不要在同一高度上，以增加可读性。
非常感谢您的努力！
根据说明编辑解决方案：
gap %>%
# for each player, note his the rank from his previous day
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
# for every game day,
# sort players by rank & break ties by previous day's rank
group_by(Gameday) %>%
arrange(rank, prev.rank) %>%
mutate(x = seq(1, n())) %>%
ungroup() %>%
ggplot(aes(x = x, y = Goals, fill = Player, color = Player)) +
# geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
geom_col() +
geom_text(aes(y = 0, label = Player), hjust = 1) +
geom_text(aes(label = Value_lbl), hjust = 0) +
# rest of the code below is unchanged from the question
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
theme(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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
原解:
gap %>%
# for each player, note his the rank from his previous day
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
# for every game day & every rank,
# reduce tile width if there are multiple players sharing that rank,
# sort players in order of who reached that rank first,
# & calculate the appropriate tile midpoint depending on how many players are there
group_by(Gameday, rank) %>%
mutate(n = n_distinct(Player)) %>%
mutate(width = 0.9 / n_distinct(Player)) %>%
arrange(prev.rank) %>%
mutate(x = rank + 0.9 * (seq(1, 2 * n() - 1, by = 2) / 2 / n() - 0.5)) %>%
ungroup() %>%
ggplot(aes(x = x, fill = Player, color = Player)) +
geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
geom_text(aes(y = 0, label = Player), hjust = 1) +
geom_text(aes(y = Goals, label = Value_lbl), hjust = 0) +
# rest of the code below is unchanged from the question
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
theme(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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
注意：这并不完美。我想如果有太多玩家/太多天，上面用于确定同一天/排名的玩家顺序的简单逻辑将不会是理想的，因为它只能向后看一个天.但它适用于这个例子，而且我对足球了解不够（至少我 认为 这就是足球？）来推断你的用例。
一个更简单的解决方案：你只需要排名是目标和球员名字的顺序
（不需要记住上周的排名，也不需要担心玩家的数量——只要他们的名字不同，柱子就不会重叠）
library(tidyverse)
library(gganimate)
theme_set(theme_classic())
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
gap <- df %>%
group_by(Gameday) %>%
mutate(rank1 = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank1==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank1 <=10) %>%
ungroup() %>%
group_by(Gameday) %>%
arrange(rank1, Player) %>%
mutate(rank = seq(1, n())) %>%
ungroup()
p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
fill = as.factor(Player), color = as.factor(Player))) +
geom_tile(aes(y = Goals/2,
height = Goals,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
p
我创建了一个动画条形图来显示一些球员的进球数。整个代码下方显示了我是如何得出输出的。
动画如愿。但是，具有相同值的柱重叠。
我想防止条形重叠。最好的情况是先得分的玩家显示在同段位的其他玩家之上。
动画开始时得分相同的玩家顺序无关紧要。
library(tidyverse)
library(gganimate)
theme_set(theme_classic())
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
gap <- df %>%
group_by(Gameday) %>%
mutate(rank = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank <=10) %>%
ungroup()
p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
fill = as.factor(Player), color = as.factor(Player))) +
geom_tile(aes(y = Goals/2,
height = Goals,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
p
代码输出如下图：
补充说明：
最后，应根据以下示例显示条形图。最好不要在同一高度上，以增加可读性。
非常感谢您的努力！
根据说明编辑解决方案：
gap %>%
# for each player, note his the rank from his previous day
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
# for every game day,
# sort players by rank & break ties by previous day's rank
group_by(Gameday) %>%
arrange(rank, prev.rank) %>%
mutate(x = seq(1, n())) %>%
ungroup() %>%
ggplot(aes(x = x, y = Goals, fill = Player, color = Player)) +
# geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
geom_col() +
geom_text(aes(y = 0, label = Player), hjust = 1) +
geom_text(aes(label = Value_lbl), hjust = 0) +
# rest of the code below is unchanged from the question
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
theme(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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
原解:
gap %>%
# for each player, note his the rank from his previous day
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
# for every game day & every rank,
# reduce tile width if there are multiple players sharing that rank,
# sort players in order of who reached that rank first,
# & calculate the appropriate tile midpoint depending on how many players are there
group_by(Gameday, rank) %>%
mutate(n = n_distinct(Player)) %>%
mutate(width = 0.9 / n_distinct(Player)) %>%
arrange(prev.rank) %>%
mutate(x = rank + 0.9 * (seq(1, 2 * n() - 1, by = 2) / 2 / n() - 0.5)) %>%
ungroup() %>%
ggplot(aes(x = x, fill = Player, color = Player)) +
geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
geom_text(aes(y = 0, label = Player), hjust = 1) +
geom_text(aes(y = Goals, label = Value_lbl), hjust = 0) +
# rest of the code below is unchanged from the question
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
theme(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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
注意：这并不完美。我想如果有太多玩家/太多天，上面用于确定同一天/排名的玩家顺序的简单逻辑将不会是理想的，因为它只能向后看一个天.但它适用于这个例子，而且我对足球了解不够（至少我 认为 这就是足球？）来推断你的用例。
一个更简单的解决方案：你只需要排名是目标和球员名字的顺序 （不需要记住上周的排名，也不需要担心玩家的数量——只要他们的名字不同，柱子就不会重叠）
library(tidyverse)
library(gganimate)
theme_set(theme_classic())
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
gap <- df %>%
group_by(Gameday) %>%
mutate(rank1 = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank1==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank1 <=10) %>%
ungroup() %>%
group_by(Gameday) %>%
arrange(rank1, Player) %>%
mutate(rank = seq(1, n())) %>%
ungroup()
p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
fill = as.factor(Player), color = as.factor(Player))) +
geom_tile(aes(y = Goals/2,
height = Goals,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
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(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
p