library(gridExtra)
library(data.table)
library(vcd)
library(titanic)
library(DT)
<- as.data.table(titanic_train)
data1datatable(data1, options = list(pageLength = 5, rownames = FALSE))
数据可视化期末报告
1 报告要求
期末实验报告由5章节5个图形组成,每个章节需要作一个图形。
每个章节选择作什么图自主选择,作图前补充完整图形标题名称,例如:图形1——多变量条形图。
案例数据自主收集,不同章节可以公用一个数据集。但同学间不允许使用相同数据集。
每个章节的数据集合需要通过
datatable
函数展示,并简要解释数据来源和变量意义。每个输出图形后需要对图形作简要解读,最少需针对图形提出一个观点。
渲染html文件保留代码展示,6月22日前将发布网址提交至共享文档
“8、期末报告”
列中。评分标准:
每章节图形各20分
能有效输出图形和合理解释75%
数据独特性强10%
图形个性化强15%
2 类别数据可视化
2.1 案例数据解释与展示
Pclass:舱位等级,从1到3分别是头等舱、二等舱、三等舱
Sex:性别,分为male男性和female女性
【目标变量】survived:是否生还,0为否,1为是
2.2 图形1——
:= factor(Survived, labels = c("死亡", "生还"))]
data1[, Survived := ifelse(Age < 18, "未成年", "成人")]
data1[, AgeGroup
<-mosaic(~ Sex + Pclass + Survived,
p1data = data1,
main = "泰坦尼克号生还率分析(性别+舱位)",
shade = TRUE,
legend = TRUE,
labeling_args = list(
rot_labels = c(0, 0, 90),
varnames = c(TRUE, TRUE, TRUE)
))
<-mosaic(~ AgeGroup + Sex + Survived,
p2data = data1,
main = "泰坦尼克号生还率分析(年龄+性别)",
shade = TRUE,
legend = TRUE,
labeling_args = list(
rot_labels = c(0, 0, 90),
varnames = c(TRUE, TRUE, TRUE)
))
- 图形解读:该图为马赛克图,图形面积代表该人群比例,颜色深浅代表生还率与期望的偏差,蓝色为高于预期,红色为低于预期。图1维度为性别和舱位对生还率的影响,由图可知女性生还率显著高且头等舱极高,男性生还率较低且三等舱极低,可判断舱位越高级(社会地位越高)生还率越高,且在本次灾难中女性生还率高于男性。图2维度为年龄与性别,未成年生还情况比成人好,可推测本次灾难中女性和未成年为优先救援对象。
3 数据分布可视化
3.1 案例数据解释与展示
mpg:油耗
cyl:气缸数
hp:马力
library(ggplot2)
library(tidyr)
library(dplyr)
<- as.data.table(mtcars)
data2datatable(data2, options = list(pageLength = 5, rownames = FALSE))
3.2 图形2——
ggplot(data2, aes(x = "", y = mpg)) +
geom_violin(fill = "lightblue", color = "blue", alpha = 0.7) +
geom_boxplot(width = 0.1, fill = "white", color = "black") +
labs(title = "油耗(MPG)分布小提琴图",
x = "",
y = "每加仑英里数(MPG)") +
theme_minimal()
ggplot(data2, aes(x = "", y = hp)) +
geom_violin(fill = "salmon", color = "red", alpha = 0.7) +
geom_boxplot(width = 0.1, fill = "white", color = "black") +
labs(title = "马力(HP)分布小提琴图",
x = "",
y = "马力(HP)") +
theme_minimal()
<- data2 %>%
data2_long select(mpg, hp) %>%
pivot_longer(cols = c(mpg, hp),
names_to = "variable",
values_to = "value")
ggplot(data2_long, aes(x = variable, y = value, fill = variable)) +
geom_violin(alpha = 0.7) +
geom_boxplot(width = 0.1, fill = "white", color = "black") +
scale_fill_manual(values = c("mpg" = "lightblue", "hp" = "salmon")) +
labs(title = "油耗与马力分布比较",
x = "变量",
y = "值") +
theme_minimal() +
theme(legend.position = "none")
- 图形解读:该图为小提琴图,宽度表示数据密度,箱线图显示中位线、四分位线、异常值。由图可知该数据集包含的汽车油耗主要分布在15-20MPG,马力在100-150HP。
4 变量关系可视化
4.1 案例数据解释与展示
Ozone:臭氧浓度
Temp:温度
Solar.R:太阳辐射
Wind:风速
library(corrplot)
<- as.data.table(airquality)
data33<- na.omit(data33)
data3datatable(data3, options = list(pageLength = 5, rownames = FALSE))
4.2 图形3——
<- cor(data3[, c("Ozone", "Temp")])
cor_matrix
plot(Ozone ~ Temp, data = data3,
main = "臭氧浓度与温度的关系",
xlab = "温度 (F)",
ylab = "臭氧浓度 (ppb)",
pch = 19, col = "blue")
<- lm(Ozone ~ Temp, data = data3)
model abline(model, col = "red")
pairs(data3[, c("Ozone", "Temp", "Solar.R", "Wind")],
main = "空气质量变量间关系")
<- cor(data3[, -c(5,6)]) # 排除月份和日期
cor_all corrplot(cor_all, method = "circle")
mtext("相关矩阵热力图", side = 2, line = 0, cex = 1.2, font = 2)
- 图形解读:图1为散点图与回归线图,蓝色点代表某天的臭氧浓度和温度,红色直线为回归线,该图直观展示臭氧浓度和温度的线性关系和离散程度。图2为散点图矩阵,展示两两变量间的关系。图3为相关矩阵热图,颜色和圆圈大小表示变量间的pearson相关系数,展示两两变量间的线性相关性,如臭氧浓度和温度(蓝色大圈)强正相关,臭氧浓度和风速(红色小圈)弱负相关。
5 样本相似性可视化
5.1 案例数据解释与展示
Murder:谋杀
Assault:袭击
UrbanPop:城市人口比例
Rape:强奸
行索引为美国各州
<-as.data.table(USArrests)
data44datatable(data44, options = list(pageLength = 5, rownames = FALSE))
library(umap)
library(factoextra)
library(cluster)
library(ggrepel)
library(ggplot2)
library(dplyr)
<- scale(data44)
data4 datatable(data4, options = list(pageLength = 5, rownames = FALSE))
5.2 图形4——
set.seed(123)
<- umap(data4)
umap_result <- data.frame(
umap_df UMAP1 = umap_result$layout[, 1],
UMAP2 = umap_result$layout[, 2],
State = rownames(USArrests)
)
<- 3
k <- kmeans(umap_result$layout, centers = k)
kmeans_result $Cluster <- as.factor(kmeans_result$cluster)
umap_df
<- USArrests %>%
cluster_profiles mutate(Cluster = as.factor(kmeans_result$cluster)) %>%
group_by(Cluster) %>%
summarise(
Murder = mean(Murder),
Assault = mean(Assault),
UrbanPop = mean(UrbanPop),
Rape = mean(Rape)
%>%
) mutate(
Profile = sprintf(
"Cluster %s:\nMurder=%.1f\nAssault=%.1f\nUrbanPop=%.1f\nRape=%.1f",
Cluster, Murder, Assault, UrbanPop, Rape
)
)
<- umap_df %>%
cluster_centers group_by(Cluster) %>%
summarise(
UMAP1 = median(UMAP1),
UMAP2 = median(UMAP2)
%>%
) left_join(cluster_profiles, by = "Cluster")
ggplot(umap_df, aes(x = UMAP1, y = UMAP2, color = Cluster)) +
geom_point(size = 3, alpha = 0.8) +
geom_text_repel(
aes(label = State),
size = 3,
max.overlaps = 20,
box.padding = 0.5
+
) geom_label(
data = cluster_centers,
aes(label = Profile),
size = 3.5,
color = "black",
alpha = 0.8,
fill = "white",
label.padding = unit(0.4, "lines")
+
) labs(
title = "美国各州犯罪模式UMAP聚类分析",
subtitle = "标签显示各聚类平均犯罪率特征",
x = "UMAP维度1",
y = "UMAP维度2",
color = "聚类"
+
) theme_minimal() +
theme(legend.position = "right")
- 图形解读:该图为UMAP聚类分析图,清晰展示三种犯罪模式相似的美国城市聚类以及发生的犯罪模式均值,由图可判断聚类二和三城市化较高,且美国各州袭击率都较其他犯罪模式高。
6 时间序列可视化
6.1 案例数据解释与展示
Time:年份
Sunspots:太阳黑子数量
library(zoo)
library(scales)
<- data.frame(
data5 Time = time(sunspots),
Sunspots = as.vector(sunspots)
)
datatable(
data5,rownames = FALSE,
options = list(pageLength = 10)
)
6.2 图形5——
# 创建数据框
<- data.frame(
data5 Time = time(sunspots),
Sunspots = as.vector(sunspots)
)
# 绘制折线图
ggplot(data5, aes(x = Time, y = Sunspots)) +
geom_smooth(method = "loess", span = 0.1, color = "red", se = FALSE)+
geom_line(color = "steelblue", linewidth = 0.5) +
labs(
title = "太阳黑子数量长期变化 (1749-1983)",
x = "年份",
y = "太阳黑子数量",
+
) scale_x_continuous(breaks = seq(1750, 1980, by = 20)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title = element_text(size = 12),
panel.grid.major = element_line(color = "grey90"),
panel.grid.minor = element_blank()
)
- 图形解读:该图为时间序列折线图,蓝色线显示两百年间太阳黑子数量的变化,红色线为平滑趋势线,由图可知太阳黑子数量变化呈周期性,在30-100之间上下浮动