ggplot2 | 世界杯赛程的可视化就交给我吧!~

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 多平台发布

  • 1
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值