数据可视化期末报告

Author

221527233雷梓杰

1 报告要求

期末实验报告由5章节5个图形组成，每个章节需要作一个图形。
每个章节选择作什么图自主选择，作图前补充完整图形标题名称，例如：图形1——多变量条形图。
案例数据自主收集，不同章节可以公用一个数据集。但同学间不允许使用相同数据集。
每个章节的数据集合需要通过datatable 函数展示，并简要解释数据来源和变量意义。
每个输出图形后需要对图形作简要解读，最少需针对图形提出一个观点。
渲染html文件保留代码展示，6月22日前将发布网址提交至共享文档“8、期末报告” 列中。
评分标准：
- 每章节图形各20分
- 能有效输出图形和合理解释75%
- 数据独特性强10%
- 图形个性化强15%

2 类别数据可视化

2.1 案例数据解释与展示

选用"carData::Chile"（智利民意调查数据），绘制vote的帕累托图

library(tidyverse)
library(dplyr)
library(DT)
library(carData)
library(RColorBrewer)

# 过滤和统计
df <- subset(carData::Chile, !is.na(vote))
df <- as.data.frame(table(df$vote))
names(df) <- c("投票倾向", "人数")
# 按人数降序排列
df <- df[order(-df$人数), ]
# 计算累积百分比
df$累积百分比 <- round(cumsum(df$人数 * 100 / sum(df$人数)), 1)
df <- df[order(-df$人数), ]

# 输出
DT::datatable(df, rownames = FALSE)

2.2 图形1——帕累托图

palette<-rev(brewer.pal(4,"Reds"))        # 设置调色板

# 绘制条形图
p<-ggplot(df)+aes(x=投票倾向,y=人数)+                
  geom_col(width=0.8,fill=palette,color="grey50")+# 绘制条形图
  scale_x_discrete(labels=c("N","Y","U","A"))+ # 将x轴的长标签折行
  geom_text(aes(x=投票倾向,y=人数,label=人数,vjust=-0.5),size=3,color="gray50")+                      # 添加数值标签，垂直调整标签位置
   ylab("人数\n(人)")+               # 设置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(投票倾向),y=累积百分比*max(人数/100)))+                 # 绘制累积百分比曲线
  geom_point(aes(x=as.numeric(投票倾向),y=累积百分比*max(人数/100)),
             size=2.5,shape=23,fill="white")+  # 绘制点
  geom_text(aes(label=累积百分比,x=投票倾向,y=1*累积百分比*max(人数/100),
    hjust=0.6,vjust=-0.95),size=3,colour="blue3")+# 添加百分比数值标签
  scale_y_continuous(sec.axis = sec_axis(~./max(df$人数/100)))# 添加坐标轴
p1+annotate("text",x=4.3,y=700,label="百分比（%）",angle=90,size=3.5)+
   annotate("text",x=3.5,y=900,label="累积百分比曲线",size=3.5)# 添加注释文本

图形解读：从条形图中可以看出投反对票（N）的人数最多，反映出当时历史公投中反对派获胜

3 数据分布可视化

3.1 案例数据解释与展示

选用"airquality"（纽约空气质量数据），绘制Winds的单变量直方图

# 设置图形主题
mytheme<-theme(plot.title=element_text(size="12"), # 设置主标题字体大小
   axis.title=element_text(size=10),               # 设置坐标轴标签字体大小
   axis.text=element_text(size=9),                # 设置坐标轴刻度字体大小
   legend.text=element_text(size="8"))            # 设置图例字体大小

options(DT.options = list(pageLength = 6))
data = airquality
datatable(data,rownames = FALSE)

df1 <- subset(airquality, !is.na(Wind))
df1 <- data.frame(风速 = df1$Wind)
DT::datatable(df1, rownames = FALSE)

3.2 图形2——单变量直方图

library(e1071)        # 用于计算偏度系数和峰度系数
# 作初始直方图
ggplot(data = df1, aes(x = 风速)) + 
  mytheme +
  geom_histogram(aes(y = ..density..), 
                 bins = 30,  # 明确指定分箱数
                 fill = "lightgreen", 
                 color = "gray50") +
  geom_rug(size = 0.2, color = "blue3") +
  geom_density(color = "blue2", size = 0.7) +
  # 添加统计指标
  annotate("text", x = 2.5, y = 0.3, 
           label = paste0("偏度系数 = ", round(skewness(df1$风速), 4)), 
           size = 3) +
  annotate("text", x = 2.5, y = 0.25, 
           label = paste0("峰度系数 = ", round(kurtosis(df1$风速), 4)), 
           size = 3) +
  # 添加均值线
  geom_vline(xintercept = mean(df1$风速),
             linetype = "twodash", 
             size = 0.6, 
             color = "red") +
  annotate("text", x = mean(df1$风速), y = 0.3, 
           label = paste0("均值 = ", round(mean(df1$风速), 2)), 
           size = 3) +
  # 添加中位数点
  geom_point(aes(x = median(风速), y = 0),
             shape = 21, size = 4, fill = "yellow") +
  annotate("text", x = median(df1$风速), y = 0.01, 
           label = "中位数", size = 3, color = "red3") +
  labs(title = "风速分布直方图", x = "风速 (mph)", y = "密度")

图形解读：偏度系数为0.341，表明分布轻微右偏；峰度系数为0.0289远小于3，因此分布不属于正态分布；所有风速的均值为9.96mph；风速主要集中在7-12mph区间；存在少量的高风速值（>15mph）

4 变量关系可视化

4.1 案例数据解释与展示

选用"palmerpenguins"（企鹅体型测量数据），以企鹅的嘴峰长度与体重作为变量探究其关系

# 加载必要的包
library(dplyr)
library(palmerpenguins)
library(DT)
library(ggExtra)

# 加载数据
data(penguins, package = "palmerpenguins")

# 查看原始数据
datatable(penguins, rownames = FALSE)

# 筛选出bill_length_mm和body_mass_g都不为NA的行
df2 <- penguins %>% 
  filter(!is.na(bill_length_mm), !is.na(body_mass_g)) %>%
  select(bill_length_mm, body_mass_g)

# 重命名列并创建新数据框
df2 <- data.frame(
  嘴峰长度_mm = df2$bill_length_mm,
  体重_g = df2$body_mass_g
)

# 显示处理后的数据
datatable(df2, rownames = FALSE)

4.2 图形3——两变量散点图

p1<-ggplot(data=df2,aes(x=嘴峰长度_mm,y=体重_g))+
    geom_point(shape=21,size=1.5,fill="deepskyblue")+  # 设置点的形状、大小和填充颜色
    geom_rug(color="steelblue")+               # 添加地毯图
    stat_smooth(method=lm,color="red",fill="blue",size=0.8)+  # 添加线性拟合线、设置线的颜色和置信带的颜色
    geom_point(aes(x=mean(嘴峰长度_mm),y=mean(体重_g)),shape=21,fill="yellow",size=4)+   # 绘制均值点
    ggtitle("散点图+地毯图+线性拟合+边际图")
p11<-ggMarginal(p1,type="densigram",color="grey50",fill="lightskyblue",alpha=0.5)
p11

图形解读：从红色的线性拟合中可以看出企鹅的嘴峰长度与体重呈正相关的关系，这可能暗示嘴峰长度是影响企鹅体重的一个重要生理特征

5 样本相似性可视化

5.1 案例数据解释与展示

继续选用"palmerpenguins"（企鹅体型测量数据），用企鹅的嘴峰长度、嘴峰深度、鳍状肢长度、体重与不同的品种做平行坐标图

# 加载必要的包
library(dplyr)
library(palmerpenguins)
library(DT)

# 加载数据
data(penguins, package = "palmerpenguins")

# 查看原始数据
datatable(penguins, rownames = FALSE)

# 筛选出所有需要的变量都不为NA的行
df3 <- penguins %>% 
  filter(!is.na(bill_length_mm), !is.na(bill_depth_mm), 
         !is.na(flipper_length_mm), !is.na(body_mass_g)) %>%
  select(species,bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g)

# 重命名列并创建新数据框
df3 <- data.frame(
  Species = df3$species,
  嘴峰长度_mm = df3$bill_length_mm,
  嘴峰深度_mm = df3$bill_depth_mm,
  鳍状肢长度_mm = df3$flipper_length_mm,
  体重_100g = df3$body_mass_g /100
)

# 显示处理后的数据
datatable(df3, rownames = FALSE)

5.2 图形4——平行坐标图

# 加载必要的包
library(dplyr)
library(palmerpenguins)
library(DT)
library(tidyr)     # 用于gather函数
library(ggplot2)   # 用于绘图
library(forcats)   # 用于fct_inorder函数

df <- df3 %>%
  mutate (id = 1:nrow (.)) %>%
  pivot_longer (
    cols = c (嘴峰长度_mm, 嘴峰深度_mm, 鳍状肢长度_mm, 体重_100g),
    names_to = "指标",
    values_to = "数值"
  ) %>%
  mutate (指标 = fct_inorder (指标))

# 绘制平行坐标图
ggplot(df, aes(x = 指标, y = 数值, group = id, color = Species)) +
  geom_line(size = 0.5) +                           # 绘制折线
  geom_point(shape = 21, size = 1.5, fill = "gray50") +   # 绘制点
  scale_x_discrete(guide = guide_axis(n.dodge = 2)) + # 设置x轴标签为2行
  theme(legend.position = c(0.8, 0.8),              # 设置图例位置
        legend.background = element_blank()) +      # 移除图例整体边框
  guides(color = guide_legend(nrow = 3, title = NULL)) + # 图例排成3行,去掉图例标题
  ggtitle("企鹅特征平行坐标图")                  # 添加标题

图形解读：Gentoo 企鹅的线条普遍在右侧坐标轴（体重、鳍状肢长度）上数值较大，而左侧坐标轴（嘴峰长度、深度）相对均衡，显示其体型较大且鳍状肢更长；Adelie 企鹅可能在鳍状肢长度和体重上数值较小，但嘴峰特征更集中，反映其体型更紧凑；可以结合企鹅栖息地和食性数据，可以进一步分析形态特征与环境适应的关系

6 时间序列可视化

6.1 案例数据解释与展示

自行选用数据“北京市空气质量”探究不同污染物（PM2.5, PM10, SO2, CO）浓度对AQI的影响程度

df4<-read_csv("data1.csv",
                  col_types = cols(
                   日期 = col_date(format = "%Y/%m/%d") 
                 )) 
# 显示处理后的数据
  df <- df4 %>%
    select(日期, AQI, PM2.5, PM10, SO2, CO) %>%
    # 将数据转换为长格式，以便于绘图
    filter(日期 >= "2020/1/1" & 日期 <= "2020/1/31") %>%
    pivot_longer(
      cols = c(PM2.5, PM10, SO2, CO),
      names_to = "污染物",
      values_to = "浓度"
    )
  df

# A tibble: 124 × 4
   日期         AQI 污染物  浓度
   <date>     <dbl> <chr>  <dbl>
 1 2020-01-01    81 PM2.5   45  
 2 2020-01-01    81 PM10   111  
 3 2020-01-01    81 SO2     28  
 4 2020-01-01    81 CO       1.5
 5 2020-01-02   145 PM2.5  111  
 6 2020-01-02   145 PM10   168  
 7 2020-01-02   145 SO2     69  
 8 2020-01-02   145 CO       3.4
 9 2020-01-03    74 PM2.5   47  
10 2020-01-03    74 PM10    98  
# ℹ 114 more rows

6.2 图形5——合并折线图

# 设置绘图主题
mytheme <- theme(
  legend.position = c(0.1, 0.8),
  legend.background = element_blank()
)


  
  # 绘制合并折线图
  ggplot(df, aes(x = 日期, y = 浓度, color = 污染物, group = 污染物)) +
    geom_line(size = 1) +
    geom_hline(yintercept = 0, linetype = "twodash") +
    mytheme +
    ggtitle("不同污染物对应的AQI合并折线图")

图形解读：此图展示了不同污染物对空气质量的影响，其中一月中旬PM10、PM2.5有明显提升，可能与天气条件或者污染物排放增加有关；PM2.5与PM10是影响空气质量的关键因素，需加强颗粒物污染控制，推广新能源、限制高排放车辆