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

11. 写在前面

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

22. 用到的包

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

33. 示例数据

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

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

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)})
1

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

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

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

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)
1

再生成一下单独的月和天，后面会用到。😏

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

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)
1

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)))
)
1

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

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

head(df)
1

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
1

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)
1

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)

1

88. ggplot2可视化

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

library(showtext)
showtext_auto()
1

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
1

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
1

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
1

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
1

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
1

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