library(DT)
library(ggplot2)
library(qicharts2)
library(dplyr)
data(diamonds)
pareto_data <- diamonds %>%
group_by(cut) %>%
summarise(total_price = sum(price)) %>%
arrange(desc(total_price)) %>%
mutate(
percent = total_price / sum(total_price),
cum_percent = cumsum(percent)
)
datatable(pareto_data)数据可视化期末报告
1 报告要求
期末实验报告由5章节5个图形组成，每个章节需要作一个图形。
每个章节选择作什么图自主选择，作图前补充完整图形标题名称，例如：图形1——多变量条形图。
案例数据自主收集，不同章节可以公用一个数据集。但同学间不允许使用相同数据集。
每个章节的数据集合需要通过
datatable函数展示，并简要解释数据来源和变量意义。每个输出图形后需要对图形作简要解读，最少需针对图形提出一个观点。
渲染html文件保留代码展示，6月22日前将发布网址提交至共享文档
“8、期末报告”列中。评分标准：
每章节图形各20分
能有效输出图形和合理解释75%
数据独特性强10%
图形个性化强15%
2 类别数据可视化
2.1 案例数据解释与展示
diamonds是R中ggplot2包内置的经典数据集，记录了约 54,000 颗钻石的物理属性和价格信息。数据集包含 10 个变量，4个分类变量，6个数值变量。cut: 切工质量，分为5个等级：Fair（一般）、Good（良好）、Very Good（很好）、Premium（优质）、Ideal（完美），切工越好钻石光泽越强。
price: 钻石价格（美元），反映其综合价值，受carat、cut、color、clarity等因素影响。
2.2 图形1——帕累托图
library(scales) # 确保加载scales包以使用comma()和percent_format()
library(RColorBrewer)
# 绘制条形图
palette<-RColorBrewer::brewer.pal(5,"Set2")
p<-ggplot(pareto_data)+aes(x=cut,y=total_price)+
geom_col(width=0.8,fill=palette,color="grey50")+# 绘制条形图
geom_text(aes(x=cut,y=total_price,label=total_price,vjust=-0.5),size=3,color="gray50")+ # 添加数值标签，垂直调整标签位置
ylab("total_price")+ # 设置y轴标签
theme(axis.text.y=element_text(angle=90,hjust=0.5,vjust=0.5))+ # 调整y轴标签角度
theme(legend.position="none") # 删除图例
p1 <- p +
geom_line(aes(x = as.numeric(cut),
y = cum_percent * max(total_price),
group = 1),
color = "black", size = 0.8) +
geom_point(aes(x = as.numeric(cut),
y = cum_percent * max(total_price)),
size = 3, shape = 21, fill = "white", color = "black") +
geom_text(aes(x = as.numeric(cut),
y = cum_percent * max(total_price),
label = paste0(round(cum_percent * 100, 1), "%")),
vjust = -0.5, color = "black", size = 3.5) +
scale_y_continuous("Total Price",
labels = comma,
sec.axis = sec_axis(~./max(pareto_data$total_price),
name = "Cumulative Percentage",
labels = percent_format(accuracy = 1))) +
theme(axis.title.y.right = element_text(color = "black"),
axis.text.y.right = element_text(color = "black"))
print(p1)
- 图形解读：从柱状图看，切工为Ideal的钻石总价格最高，贡献度最大,其次为Premium、Very Good、Good、Fair。从折线图看，切工为Ideal和切工为Premium这两种钻石占比超过百分之六十，即少数类别贡献了大部分总价格，可以判断出：切工越高级的钻石，其价格会更高。
3 数据分布可视化
3.1 案例数据解释与展示
数据集esoph是一组·管癌病例对照研究数据，用以研究食管癌与酒精、烟草消费的关系。包含 88行*5列，记录不同人群组的病例对照情况，常用于流行病学和风险因素分析的示例数据。agegp：研究对象的年龄分段
alcgp：每日平均酒精摄入量分组（按克数计算）
tobgp：每日平均烟草消费量分组（按克数计算）
ncases：在当前年龄+酒精+烟草组合的分组中，食管癌患者的人数
ncontrols：在与病例组匹配的同一分组中，健康对照的人数
library(tidyr)
data(esoph)
# 将汇总数据转换为长格式的"原始"数据（每行代表一个观察值）
esoph_long <- esoph %>%
uncount(weights = ncases + ncontrols, .id = "id") %>% # 展开为个体数据
mutate(
status = ifelse(id <= ncases, "Case", "Control") # 标记病例/对照
)
datatable(esoph_long )3.2 图形2——镜像直方图
# 绘制镜像直方图（按酒精消费组）
ggplot(esoph_long, aes(x = alcgp, fill = status)) +
# 病例组直方图（正向）
geom_histogram(
data = subset(esoph_long, status == "Case"),
aes(y = ..count..),
stat = "count",
alpha = 0.7,
position = "identity"
) +
# 对照组直方图（负向，实现镜像）
geom_histogram(
data = subset(esoph_long, status == "Control"),
aes(y = -..count..),
stat = "count",
alpha = 0.7,
position = "identity"
) +
# 美化图形
labs(
title = "镜像直方图：食管癌病例与对照的酒精消费分布",
x = "酒精消费量 (g/day)",
y = "人数",
fill = "组别"
) +
scale_y_continuous(
labels = abs, # y轴标签取绝对值
breaks = seq(-100, 100, by = 20)
) +
scale_fill_manual(values = c("Case" = "red", "Control" = "blue")) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.position = "top"
)
- 图形解读：在0-39g/day组别中，对照组人数远超过病例组，说明在低酒精消费人群中，对照组占比高，病例组占比低。在40-79组别中，病例组人数增多，对照组人数减少。可以看出：随着酒精消费量的增高，病例组的占比呈现上升趋势，对照组占比逐渐下降，体现出酒精消费越高，食管癌病例相对越多。
4 变量关系可视化
4.1 案例数据解释与展示
数据集esoph是一组·管癌病例对照研究数据，用以研究食管癌与酒精、烟草消费的关系。包含 88行*5列，记录不同人群组的病例对照情况，常用于流行病学和风险因素分析的示例数据。agegp：研究对象的年龄分段
alcgp：每日平均酒精摄入量分组（按克数计算）
tobgp：每日平均烟草消费量分组（按克数计算）
ncases：在当前年龄+酒精+烟草组合的分组中，食管癌患者的人数
ncontrols：在与病例组匹配的同一分组中，健康对照的人数
data(esoph)
esoph_bubble <- esoph %>%
# 按所有关键变量分组（包括agegp）
group_by(alcgp, tobgp, agegp) %>%
summarise(
total_cases = sum(ncases),
.groups = "drop"
) %>%
filter(total_cases > 0) # 仅保留有病例的记录
datatable(esoph_bubble )4.2 图形3——气泡图
ggplot(esoph_bubble, aes(
x = alcgp, # 酒精消费组
y = tobgp, # 烟草消费组
size = total_cases, # 气泡大小=病例数
color = agegp # 颜色=年龄组
)) +
geom_point(alpha = 0.7) +
scale_size_continuous(
range = c(3, 15), # 气泡大小范围
name = "病例数"
) +
scale_color_brewer(
palette = "Set1", # 颜色方案
name = "年龄组"
) +
labs(
title = "食管癌病例分布：酒精与烟草消费关系",
x = "酒精消费量 (g/day)",
y = "烟草消费量 (g/day)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
- 图形解读：气泡图中，气泡越大，表示病例数越多。从图中可以观察到，酒精40-79g/day和烟草0-9g/day的组合的气泡是最大的，而且包含的年龄段最多，表明该组合下食管癌病例最多，即此烟酒搭配与食管癌关联密切。在酒精40-79g/day和烟草20-29g/day的组合下，65-74年龄段占比最大，即该烟酒搭配下，65-74岁年龄段的人患食管癌风险较高。
5 样本相似性可视化
5.1 案例数据解释与展示
USArrests是1973年美国50个州的刑事逮捕数据，50行 × 4列（每个州一行，无缺失值），包含四个数值型变量，常用于统计分析、聚类分析和数据可视化的示例数据。Murder：每10万人口的谋杀逮捕率
Assault: 每10万人口的袭击逮捕率
UrbanPop: 城市人口占比
Rape：每10万人口的强奸逮捕率
library(ggiraphExtra)
library(ggplot2)
# 准备数据（选择4个州进行对比，并添加州名列）
states_data <- USArrests[c("Alabama", "California", "Colorado", "New York"), ]
states_data$State <- rownames(states_data) # 添加州名列
datatable(states_data)5.2 图形4——雷达图
ggRadar(
data = states_data,
mapping = aes(group = State), # 按州分组
rescale = TRUE, # 自动标准化到0-1范围
legend.position = "right", # 图例位置
size = 1, # 线条粗细
interactive = FALSE, # 设置为TRUE可生成交互式图形
alpha = 0.2 # 填充透明度
) +
labs(title = "美国各州犯罪率雷达图 ") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
legend.text = element_text(size = 10)
)
- 图形解读：观察图形可得：城市人口占比较高的州，如California和New York，部分犯罪率如Assault、Rape也偏高。而不同的州犯罪类型突出点不同，Alabama谋杀案件突出，Assault（袭击）案件处于中间水平；California的Rape(强奸）和Assault（袭击）案件较为突出，Munder（谋杀）案件较少；Colorado则是Rape(强奸）案件突出；New York是Assault（袭击）和Munder（谋杀）案件突出，Rape(强奸）案件较少。
6 时间序列可视化
6.1 案例数据解释与展示
橙树生长数据，来源于经典统计学教材《Applied Regression Analysis》，记录内容了5棵橙树在7个时间点的树干周长测量值，一共有35行 × 3列，每条记录对应一次测量。应用于农业科学、生物统计学领域。
Tree（有序因子）：树木编号（1-5）
age（数值型）：测量时的树龄（天）
circumference（数值型）：树干周长（毫米）
# 加载必要的包
library(ggplot2)
# 使用内置Orange数据集
datatable(Orange)6.2 图形5——合并折线图
ggplot(Orange, aes(x = age, y = circumference,
color = Tree, group = Tree)) +
geom_line(linewidth = 1.2) + # 设置线条粗细
geom_point(size = 3) + # 添加数据点
labs(
title = "橙树生长曲线对比",
x = "树龄（天）",
y = "树干周长（mm）",
color = "树木编号"
) +
scale_color_brewer(palette = "Set1") + # 使用鲜艳的颜色
theme_minimal(base_size = 12) + # 简洁主题
theme(
plot.title = element_text(hjust = 0.5, face = "bold"), # 标题居中加粗
legend.position = "right" # 图例在右侧
)
- 图形解读：观察图形可以看出：随着树龄的增加，树干的周长也增加，到了观察后期，不同树的树干周长差异比较明显。编号为4的树，树干周长的峰值最高，是长得最快最粗的，生长优势较为明显。编号为3的树在后期的增长速度放缓，树干周长在5棵树中最短，生长表现相对较弱。编号为5的树在后期反超编号为1的树，说明编号为5的树在后期的生长优势明显。