jamesbang

V1

2022/11/21阅读：28主题：雁栖湖

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

## 22. 用到的包

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

## 33. 示例数据

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

## 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)})``

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

## 55. 日期转换与合并

``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. 整理比赛信息

``dat <- unite(dat, team1, team2, col = "game", sep = " vs ")dat\$match <- factor(dat\$match, levels = unique(dat\$match))head(dat)``

## 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))))``

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

### 7.2 设置比赛信息文本

``text_offset <- 0.05df\$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 <- 2day_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可视化

``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``

### 8.2 添加天数文本

``# Show text for each monthp<-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``

### 8.3 添加月份文本

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

### 8.4 添加比赛信息文本

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

### 8.5 美化细节

``# Don't show axes, appropriately position legendp<-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``

📍 往期精彩

##### jamesbang
V1

wx🔍: Grassssss 卷起来了