ggplot2 | 世界杯赛程的可视化就交给我吧!~
创始人
2024-04-11 08:08:20

11. 写在前面

昨天卡塔尔🇶🇦输了比赛真是让人大跌眼镜啊😱,打破了世界杯东道主必胜的神律,也不知道王子们是怎么想的。🤣
今天是英格兰🏴󠁧󠁢󠁥󠁮󠁧󠁿Vs伊朗🇮🇷,🐷各位好运!~😘
后面的赛事我们就用ggplot画一个赛程图吧😁, 效果图如下:👇

alt

22. 用到的包

rm(list = ls())
library(tidyverse)
library(tmcn)
library(lubridate)
library(RColorBrewer)

33. 示例数据

这里我事先在网上爬了赛程下来,这里就直接读入了。

dat <- read.csv("./Worldcup.csv")
alt

44. 繁体转简体

由于是繁体字,不方便阅读,这里我们转成简体字。🤗

colnames(dat) <- toTrad(colnames(dat),rev = T)

dat <- separate(data = dat, col = 比赛详情, into = c("比赛详情", "小组"), sep = "|") %>%
dplyr::select(., c(6, 1, 2, 3, 4,5))

colnames(dat) <- c( "date", "time", "match", "group", "team1","team2")

dat <- map_df(dat, function(x){toTrad(x, rev = T)})

转成简体字以后,发现还是有2个字没有转换成功,可能是包内没有对应的字体吧。😢

alt

这里我们再手动转一下。🤒

dat <- map_df(dat, function(x){gsub("準", "准", x)})
dat <- map_df(dat, function(x){gsub("佈", "布", x)})

55. 日期转换与合并

接着我们把日期提取出来转换一下,转成标准的yyyy-mm-dd样式。😉

dat$date <- dat$date %>% 
gsub("月","-",.) %>%
gsub("日", "",.) %>%
paste(2022, ., sep = "-") %>%
as.Date()

dat <- unite(dat, date, time, col = "match_time", sep = " ",remove = F)

再生成一下单独的,后面会用到。😏

dat <- dat %>% 
mutate(d = day(.$date),
mon = month(.$date)
)

66. 整理比赛信息

这里我们把比赛信息整理出来,team1对阵team2,再把第x轮比赛转换成factor。😚

dat <- unite(dat, team1, team2, col = "game", sep = " vs ")

dat$match <- factor(dat$match, levels = unique(dat$match))

head(dat)
alt

77. 绘图参数设置

7.1 线段参数

这里我们设置一下线段长度方向。🧐

positions <- c(0.5, -0.5, 1.0, -1.0, 1.5, -1.5)
directions <- c(1, -1)

line_pos <- data.frame(
"date" = unique(dat$date),
"position" = rep(positions, length.out=length(unique(dat$date))),
"direction" = rep(directions, length.out=length(unique(dat$date)))
)

接着我们合并到前面的data.frame里。😗

df <- merge(x=dat, y=line_pos, all = TRUE)

head(df)
alt

7.2 设置比赛信息文本

由于同一天可能有多个比赛,为了不让他们重叠,我们要在纵向上让他们位置稍微错开一下。😁

text_offset <- 0.05

df$date_count <- ave(df$date==df$date, df$date, FUN=cumsum)
df$text_position <- (df$date_count * text_offset * df$direction) + df$position

7.3 设置天数文本

day_buffer <- 2

day_date_range <- seq(min(df$date) - days(day_buffer),
max(df$date) + days(day_buffer),
by='day')

day_format <- day(day_date_range)

day_df <- data.frame(day_date_range, day_format)

7.4 设置月份文本

month_date_range <- seq(min(df$date) - months(1), 
max(df$date) + months(1),
by='month')

month_date_range <- as.Date(
intersect(
ceiling_date(month_date_range, unit="month"),
floor_date(month_date_range, unit="month")
),
origin = "1970-01-15"
)

month_format <- format(month_date_range, '%B')

month_df <- data.frame(month_date_range, month_format)

88. ggplot2可视化

由于涉及到中文显示,这里我们用一下showtext包。🤨

library(showtext)
showtext_auto()

8.1 初步绘图

colorcount <- length(unique(dat$match))

p <- df %>%
ggplot(aes(x = date, y = 0, col = match, label = game)) +
geom_hline(yintercept = 0, color = "black", size = 0.3) +
geom_segment(aes(y=position, yend=0, xend = date),
color='black', size=0.2) +
geom_point(aes(y=0), size=3)+
scale_color_manual(values = colorRampPalette(brewer.pal(8, "Set1"))(colorcount))
p
alt

8.2 添加天数文本

# Show text for each month
p<-p +
geom_text(data = day_df,
aes(x=day_date_range,y=-0.1,label=day_format),
size=2.5,vjust=0.5, color='black', angle = 0)

p
alt

8.3 添加月份文本

# Show year text
p<-p+
geom_text(data=month_df,
aes(x=month_date_range, y = -0.2,
label=month_format,
fontface="bold"),
size=3, color='black')

p
alt

8.4 添加比赛信息文本

# Show text for each milestone
p<-p +
geom_text(aes(y=text_position,label = game),size=2.5)+
theme(text = element_text(family=""))

p
alt

8.5 美化细节

# Don't show axes, appropriately position legend
p<-p+
theme_bw()+
theme(axis.line.y = element_blank(),
axis.text.y=element_blank(),
axis.title.y=element_blank(),
axis.ticks.y=element_blank(),
axis.title.x=element_blank(),
axis.text.x =element_blank(),
axis.ticks.x =element_blank(),
axis.line.x =element_blank(),
panel.grid = element_blank(),
legend.position = "right",
legend.title = element_blank())
p
alt

最后祝大家早日不卷!~

点个在看吧各位~ ✐.ɴɪᴄᴇ ᴅᴀʏ 〰

📍 往期精彩

📍 🤩 ComplexHeatmap | 颜狗写的高颜值热图代码!
📍 🤥 ComplexHeatmap | 你的热图注释还挤在一起看不清吗!?
📍 🤨 Google | 谷歌翻译崩了我们怎么办!?(附完美解决方案)
📍 🤩 scRNA-seq | 吐血整理的单细胞入门教程
📍 🤣 NetworkD3 | 让我们一起画个动态的桑基图吧~
📍 🤩 RColorBrewer | 再多的配色也能轻松搞定!~
📍 🧐 rms | 批量完成你的线性回归
📍 🤩 CMplot | 完美复刻Nature上的曼哈顿图
📍 🤠 Network | 高颜值动态网络可视化工具
📍 🤗 boxjitter | 完美复刻Nature上的高颜值统计图
📍 🤫 linkET | 完美解决ggcor安装失败方案(附教程)
📍 ......

本文由 mdnice 多平台发布

相关内容

热门资讯

埃菲尔铁塔在哪 中国仿建埃菲尔... 2019年4月26日,广西南宁市,街头惊现一座巨型山寨版埃菲尔铁塔,高约20米,白色塔身,造型逼真,...
苗族的传统节日 贵州苗族节日有... 【岜沙苗族芦笙节】岜沙,苗语叫“分送”,距从江县城7.5公里,是世界上最崇拜树木并以树为神的枪手部落...
北京的名胜古迹 北京最著名的景... 北京从元代开始,逐渐走上帝国首都的道路,先是成为大辽朝五大首都之一的南京城,随着金灭辽,金代从海陵王...
长白山自助游攻略 吉林长白山游... 昨天介绍了西坡的景点详细请看链接:一个人的旅行,据说能看到长白山天池全凭运气,您的运气如何?今日介绍...
应用未安装解决办法 平板应用未... ---IT小技术,每天Get一个小技能!一、前言描述苹果IPad2居然不能安装怎么办?与此IPad不...
脚上的穴位图 脚面经络图对应的... 人体穴位作用图解大全更清晰直观的标注了各个人体穴位的作用,包括头部穴位图、胸部穴位图、背部穴位图、胳...
猫咪吃了塑料袋怎么办 猫咪误食... 你知道吗?塑料袋放久了会长猫哦!要说猫咪对塑料袋的喜爱程度完完全全可以媲美纸箱家里只要一有塑料袋的响...
demo什么意思 demo版本... 618快到了,各位的小金库大概也在准备开闸放水了吧。没有小金库的,也该向老婆撒娇卖萌服个软了,一切只...
世界上最漂亮的人 世界上最漂亮... 此前在某网上,选出了全球265万颜值姣好的女性。从这些数量庞大的女性群体中,人们投票选出了心目中最美...
埃菲尔铁塔在哪 中国仿建埃菲尔... 2019年4月26日,广西南宁市,街头惊现一座巨型山寨版埃菲尔铁塔,高约20米,白色塔身,造型逼真,...
苗族的传统节日 贵州苗族节日有... 【岜沙苗族芦笙节】岜沙,苗语叫“分送”,距从江县城7.5公里,是世界上最崇拜树木并以树为神的枪手部落...
北京的名胜古迹 北京最著名的景... 北京从元代开始,逐渐走上帝国首都的道路,先是成为大辽朝五大首都之一的南京城,随着金灭辽,金代从海陵王...
长白山自助游攻略 吉林长白山游... 昨天介绍了西坡的景点详细请看链接:一个人的旅行,据说能看到长白山天池全凭运气,您的运气如何?今日介绍...
世界上最漂亮的人 世界上最漂亮... 此前在某网上,选出了全球265万颜值姣好的女性。从这些数量庞大的女性群体中,人们投票选出了心目中最美...
应用未安装解决办法 平板应用未... ---IT小技术,每天Get一个小技能!一、前言描述苹果IPad2居然不能安装怎么办?与此IPad不...
脚上的穴位图 脚面经络图对应的... 人体穴位作用图解大全更清晰直观的标注了各个人体穴位的作用,包括头部穴位图、胸部穴位图、背部穴位图、胳...
demo什么意思 demo版本... 618快到了,各位的小金库大概也在准备开闸放水了吧。没有小金库的,也该向老婆撒娇卖萌服个软了,一切只...
猫咪吃了塑料袋怎么办 猫咪误食... 你知道吗?塑料袋放久了会长猫哦!要说猫咪对塑料袋的喜爱程度完完全全可以媲美纸箱家里只要一有塑料袋的响...