在網(wǎng)上偶然間發(fā)現(xiàn)的一個(gè)R語言ggplot2做數(shù)據(jù)可視化的實(shí)例，提供數(shù)據(jù)和代碼混蔼，今天的推文把代碼拆解一下
實(shí)例數(shù)據(jù)下載鏈接
下載這個(gè)數(shù)據(jù)需要注冊kaggle
代碼鏈接
https://github.com/cnicault/30DayChartChallenge/blob/main/day12/day12_strips.Rmd
結(jié)果圖
image.png
這個(gè)圖展示的是法國1980年前后的溫度差異零聚，數(shù)據(jù)里提供很多個(gè)國家的數(shù)據(jù)，可以自己更改成其他國家的數(shù)據(jù)試試
首先是讀取數(shù)據(jù)
這里接觸了兩個(gè)新的R包
vroomhere
climate <- vroom::vroom(here::here("GlobalLandTemperaturesByCountry.csv"))
關(guān)于lubridate包中的函數(shù)的一些用法
lubridate::year("1743-11-01")
lubridate::month("1743-11-01")
lubridate::month("1743-11-01",label = T)
lubridate::month("1743-11-01",label = F)
lubridate::day("1743-11-01")
構(gòu)建作圖的數(shù)據(jù)集
library(tidyverse)
monthly <- climate %>%
filter(Country == "France", !is.na(AverageTemperature)) %>%
mutate(year = lubridate::year(dt),
month = lubridate::month(dt, label = TRUE),
pos = lubridate::month(dt, label = FALSE),
color = ifelse(year > 1980, "Recent", "Past")) %>%
filter(year >=1900)
他這里先做了一個(gè)空白的熱圖
注釋里寫的是為了得到一個(gè)矩形的圖例
library(ggplot2)
ggplot() +
# empty tile to get a legend with rectangle key
geom_tile(data = monthly,
aes(x = 0, y =0, width =0,
height = 0, fill = color))
image.png
接下來是添加線段
seg <- tibble(x = c(0, 0, 10, 0, 9, 3, 8, 5, 6),
xend = c(12.5, 3, 12.5, 5, 12.5, 6, 11, 10, 8),
y = c(0, 5, 5, 10, 10, 15, 15, 20, 25),
yend = c(0, 5, 5, 10, 10, 15, 15, 20, 25))
ggplot() +
# empty tile to get a legend with rectangle key
geom_tile(data = monthly,
aes(x = 0, y =0,
width =0,
height = 0,
fill = color)) +
# y-axis
geom_segment(data = seg,
aes(x = x, xend = xend,
y = y, yend = yend),
color = "red",
linetype = "12")
image.png
添加文本注釋
seg_lab <- tibble(x = c(0, 0, 0, 3, 5, 6),
y = seq(0,25, 5))
ggplot() +
# empty tile to get a legend with rectangle key
geom_tile(data = monthly,
aes(x = 0, y =0,
width =0,
height = 0,
fill = color)) +
# y-axis
geom_segment(data = seg,
aes(x = x, xend = xend,
y = y, yend = yend),
color = "black", linetype = "12") +
geom_text(data = seg_lab, aes(x = x, y = y,
label = glue::glue("{y} °C")),
color = "black", nudge_y = 1,
family = "serif", hjust = 0)
image.png
添加抖動(dòng)的散點(diǎn)
ggplot() +
# empty tile to get a legend with rectangle key
geom_tile(data = monthly,
aes(x = 0, y =0,
width =0,
height = 0,
fill = color)) +
# y-axis
geom_segment(data = seg,
aes(x = x, xend = xend,
y = y, yend = yend),
color = "white",
linetype = "12") +
geom_text(data = seg_lab,
aes(x = x, y = y,
label = glue::glue("{y} °C")),
color = "white", nudge_y = 1,
family = "serif", hjust = 0) +
# show.legend = FALSE to remove the shape of the point in the legend
geom_jitter(data = filter(monthly, color == "Recent"),
aes(x = pos+0.2, y = AverageTemperature,
fill = color), width = 0.15,
height =0, size = 3, shape = 21,
stroke = 0.3, color = "#FFDADC",
show.legend = FALSE) +
geom_jitter(data = filter(monthly, color == "Past"),
aes(x = pos-0.2, y = AverageTemperature,
fill = color), width = 0.15,
height =0, size = 2.5, shape = 21,
stroke = 0.3, color = "#93E2F5",
show.legend = FALSE)
image.png
接下來就是對細(xì)節(jié)的調(diào)整了
axis_labels <- tibble(month = lubridate::month(seq(1,12,1),
label = TRUE),
pos = seq(1,12,1))
txt_clr <- "white"
pal1 <- c("#105182", "#1a7bc5", "#42a2f1", "#E9F1F2", "#ff9193", "#f1434a", "#c91022", "#8d0613", "#4D030A")
monthly_plt <- ggplot() +
# empty tile to get a legend with rectangle key
geom_tile(data = monthly,
aes(x = 0, y =0,
width =0, height = 0,
fill = color)) +
# y-axis
geom_segment(data = seg,
aes(x = x, xend = xend,
y = y, yend = yend),
color = "white", linetype = "12") +
geom_text(data = seg_lab,
aes(x = x, y = y, label = glue::glue("{y} °C")),
color = "white", nudge_y = 1,
family = "serif", hjust = 0) +
# show.legend = FALSE to remove the shape of the point in the legend
geom_jitter(data = filter(monthly, color == "Recent"),
aes(x = pos+0.2, y = AverageTemperature, fill = color),
width = 0.15, height =0, size = 3,
shape = 21, stroke = 0.3, color = "#FFDADC", show.legend = FALSE) +
geom_jitter(data = filter(monthly, color == "Past"),
aes(x = pos-0.2, y = AverageTemperature, fill = color),
width = 0.15, height =0, size = 2.5,
shape = 21, stroke = 0.3, color = "#93E2F5",
show.legend = FALSE) +
# x-axis labels
geom_text(data = axis_labels,
aes(x = pos, y = -2, label = month),
color = "white", vjust = 0,
angle = 90, size = 5, family = "serif")+
# scales
scale_fill_manual(values = c("Recent" = "#f1434a", "Past" = "#1a7bc5"),
labels = c("Recent" = "> 1980", "Past" = "<= 1980")) +
scale_y_continuous(limits = c(-4,26),
breaks = seq(0,25,5)) +
labs(fill = "Observations") +
theme_void() +
guides(fill = guide_legend(label.position = "top",
title.hjust = 0.5,
keyheight = unit(1, "line"),
keywidth = unit(4, "line"),
nrow = 1),
color = FALSE) +
theme(plot.background = element_rect(fill = "grey40", color = NA),
legend.position = c(0.13, 0.85),
legend.text = element_text(face = "bold",
size = 12, color = txt_clr),
legend.title = element_text(face = "bold", size = 14, color = txt_clr))
monthly_plt
image.png
歡迎大家關(guān)注我的公眾號
小明的數(shù)據(jù)分析筆記本
小明的數(shù)據(jù)分析筆記本 公眾號 主要分享：1、R語言和python做數(shù)據(jù)分析和數(shù)據(jù)可視化的簡單小例子勋乾；2、園藝植物相關(guān)轉(zhuǎn)錄組學(xué)嗡善、基因組學(xué)辑莫、群體遺傳學(xué)文獻(xiàn)閱讀筆記；3罩引、生物信息學(xué)入門學(xué)習(xí)資料及自己的學(xué)習(xí)筆記各吨！
