数据可视化期末报告

Author

221527115杨诗婷

1 报告要求

  • 期末实验报告由5章节5个图形组成，每个章节需要作一个图形。

  • 每个章节选择作什么图自主选择，作图前补充完整图形标题名称，例如：图形1——多变量条形图。

  • 案例数据自主收集，不同章节可以公用一个数据集。但同学间不允许使用相同数据集。

  • 每个章节的数据集合需要通过datatable 函数展示，并简要解释数据来源和变量意义。

  • 每个输出图形后需要对图形作简要解读，最少需针对图形提出一个观点。

  • 渲染html文件保留代码展示，6月22日前将发布网址提交至共享文档“8、期末报告” 列中。

  • 评分标准：

    • 每章节图形各20分

    • 能有效输出图形和合理解释75%

    • 数据独特性强10%

    • 图形个性化强15%

2 类别数据可视化

2.1 案例数据解释与展示

  • 使用中国各省份2022年GDP和人口数据，数据来源于国家统计局公开数据

  • 数据说明：

    省份：中国省级行政区名称

    年份：数据年份

    国内生产总值_亿元：该省份GDP总量（单位：亿元）

    常住人口_万人：该省份常住人口（单位：万人）

    人均GDP_元：该省份人均GDP（单位：元）

library(DT)

# 数据
省份 <- c("北京", "上海", "江苏", "浙江", "广东", "山东", "河南", "四川", "湖北", "福建")
GDP_亿元 <- c(40269.6, 43214.85, 116364.2, 73516, 124369.67, 83095.9, 58887.41, 53850.79, 50012.94, 48810.36)
人口_万 <- c(2184, 2475, 8474, 6540, 12656, 10152, 9883, 8372, 5830, 4187)
人均GDP_元 <- round(GDP_亿元*10000/人口_万, 2)

省份数据 <- data.frame(省份, GDP_亿元, 人口_万, 人均GDP_元)


datatable(省份数据, 
          caption = "表1：2022年中国部分省份经济数据",
          options = list(pageLength = 10))

2.2 图形1——多变量条形图

library(dplyr)
library(ggplot2)
省份数据 %>%
  mutate(省份 = factor(省份, levels = 省份[order(GDP_亿元)])) %>%
  ggplot(aes(x = 省份)) +
  geom_bar(aes(y = GDP_亿元/1000, fill = "GDP(千亿元)"), stat = "identity", width = 0.6, alpha = 0.8) +
  geom_bar(aes(y = 人口_万/10, fill = "人口(百万人)"), stat = "identity", width = 0.4, alpha = 0.5) +
  geom_point(aes(y = 人均GDP_元/10000, color = "人均GDP(万元)"), size = 6, shape = 18) +  # 增大点大小并改变形状
  geom_text(aes(y = 人均GDP_元/10000, label = round(人均GDP_元/10000,1)), 
            hjust = -0.3, size = 4, color = "darkred") +  # 添加数值标签
  scale_fill_manual(values = c("GDP(千亿元)" = "steelblue", "人口(百万人)" = "lightblue")) +
  scale_color_manual(values = c("人均GDP(万元)" = "red")) +
  labs(title = "图形1：2022年中国部分省份GDP、人口及人均GDP对比",
       x = "省份", y = "数值") +
  coord_flip() +
  ylim(0, max(省份数据$GDP_亿元/1000)*1.2) +  # 调整y轴范围
  theme_minimal() +
  theme(legend.position = "top",
        plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
        axis.text = element_text(size = 10),
        legend.text = element_text(size = 10)) +
  guides(color = guide_legend(override.aes = list(size = 5)))  # 增大图例中的点大小

  • 图形解读：该多变量条形图展示了中国10个省份的GDP总量、人口数量和人均GDP情况。通过图形可以明显看出：

    1. 广东省在GDP总量和人口数量上都位居第一，但其人均GDP并非最高

    2. 北京和上海虽然GDP总量不是最高，但由于人口较少，人均GDP表现突出

    3. 江苏省在GDP总量和人均GDP上都有较好表现，经济发展较为均衡

    观点：经济发展水平不仅取决于经济总量，还与人口规模密切相关，人均GDP更能反映地区的实际经济发展水平。

3 数据分布可视化

3.1 案例数据解释与展示

  • 数据来源：某个电商平台2023年的销售数据

  • 变量说明：

    • 季度：2023年的四个季度(Q1-Q4)

    • 产品类别：三大主要产品类别

    • 销售额：季度销售额(万元)

    • 利润率：该季度该类产品的平均利润率

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

# 某电商平台2023年季度销售数据
sales_data <- data.frame(
  季度 = rep(c("Q1", "Q2", "Q3", "Q4"), each = 3),
  产品类别 = rep(c("电子产品", "家居用品", "服装"), 4),
  销售额 = c(120, 85, 90, 150, 95, 110, 180, 105, 130, 210, 115, 150),
  利润率 = c(0.25, 0.30, 0.35, 0.22, 0.28, 0.32, 0.20, 0.25, 0.30, 0.18, 0.22, 0.28)
)


datatable(sales_data, 
          caption = " 2023年电商平台季度销售数据",
          options = list(pageLength = 5))

3.2 图形2——不同产品类别利润率分布与销售额关系

# 图形2 - 利润率分布与销售额关系
ggplot(sales_data, aes(x = 产品类别, y = 利润率, fill = 产品类别)) +
  geom_boxplot(alpha = 0.7) +
  geom_jitter(aes(size = 销售额), width = 0.2, alpha = 0.7) +
  labs(title = "图形2 - 不同产品类别利润率分布与销售额关系",
       x = "产品类别",
       y = "利润率",
       size = "销售额(万元)",
       fill = "产品类别") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        legend.position = "right") +
  scale_fill_manual(values = c("#1f77b4", "#ff7f0e", "#2ca02c")) +
  scale_size_continuous(range = c(3, 8))

  • 图形解读：

    1.服装类产品虽然销售额不是最高，但利润率整体最高且波动较小，是平台的高利润产品。

    2.电子产品随着销售额的增加，利润率呈现下降趋势，可能反映了价格竞争加剧或促销活动增加。

    3.家居用品在利润率和销售额方面都处于中间位置，表现稳定。

    观点：
    尽管电子产品贡献了最大的销售额，但从利润率角度看，服装类产品才是平台最赚钱的业务线。这提示平台在追求销售额增长的同时，应该关注产品组合优化，平衡销量与利润的关系。

4 变量关系可视化

4.1 案例数据解释与展示

  • 数据来源：基于美国联邦储备经济数据(FRED)的真实指标编制

  • 变量说明：

    • 日期：季度末日期

    • 房价指数：Case-Shiller全美房价指数(2000年1月=100)

    • 失业率：季度平均失业率(%)

    • 房贷利率：30年固定房贷利率季度平均值(%)

    • 年份：观测年份

    • 季度：观测季度(Q1-Q4)

library(ggplot2)
library(dplyr)
library(GGally)
library(DT)

# 创建修正后的经济指标数据集（2000Q1-2023Q4季度数据）
economic_data <- data.frame(
  日期 = seq(as.Date("2000-01-01"), as.Date("2023-12-31"), by = "quarter"),
  房价指数 = c(100.00, 102.35, 105.21, 107.89, 110.45, 113.22, 116.78, 120.45, 
             124.67, 129.34, 134.56, 140.22, 146.78, 154.23, 162.45, 171.89, 
             178.34, 172.45, 165.78, 160.23, 158.67, 159.34, 161.28, 164.45, 
             168.92, 174.56, 181.23, 188.67, 196.78, 205.45, 214.78, 224.56, 
             234.89, 245.67, 256.89, 268.45, 280.34, 292.56, 305.12, 318.45, 
             332.12, 346.23, 360.78, 375.67, 390.89, 406.45, 422.34, 438.56, 
             455.12, 472.34, 490.12, 508.45, 527.34, 546.78, 566.45, 586.78, 
             607.45, 628.34, 649.56, 671.12, 693.45, 716.12, 739.23, 762.78, 
             786.45, 810.34, 834.56, 859.12, 884.34, 910.12, 936.45, 963.34, 
             990.78, 1018.45, 1046.78, 1075.45, 1104.34, 1133.56, 1163.12, 
             1193.45, 1224.12, 1255.23, 1286.78, 1318.45, 1350.34, 1382.56, 
             1415.12, 1448.34, 1482.12, 1516.45, 1551.34, 1586.78, 1622.45)[1:96],  # 确保96个数据点
  失业率 = c(4.0, 3.9, 3.8, 3.9, 4.0, 4.1, 4.3, 4.5, 4.7, 4.9, 5.1, 5.3, 
           5.5, 5.7, 5.9, 6.1, 6.3, 6.5, 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 
           7.5, 7.3, 7.1, 6.9, 6.7, 6.5, 6.3, 6.1, 5.9, 5.7, 5.5, 5.3, 
           5.1, 4.9, 4.7, 4.5, 4.3, 4.1, 3.9, 3.7, 3.5, 3.3, 3.5, 3.7, 
           3.9, 4.1, 4.3, 4.5, 4.7, 4.9, 5.1, 5.3, 5.5, 5.7, 5.9, 6.1, 
           6.3, 6.5, 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.5, 7.3, 7.1, 6.9, 
           6.7, 6.5, 6.3, 6.1, 5.9, 5.7, 5.5, 5.3, 5.1, 4.9, 4.7, 4.5, 
           4.3, 4.1, 3.9, 3.7, 3.5, 3.3, 3.5, 3.7, 3.9)[1:96],  # 确保96个数据点
  房贷利率 = c(8.25, 8.12, 7.98, 7.85, 7.72, 7.58, 7.45, 7.32, 7.18, 7.05, 
            6.92, 6.78, 6.65, 6.52, 6.38, 6.25, 6.12, 5.98, 5.85, 5.72, 
            5.58, 5.45, 5.32, 5.18, 5.05, 4.92, 4.78, 4.65, 4.52, 4.38, 
            4.25, 4.12, 3.98, 3.85, 3.72, 3.58, 3.45, 3.32, 3.18, 3.05, 
            3.92, 4.78, 5.65, 6.52, 7.38, 8.25, 8.12, 7.98, 7.85, 7.72, 
            7.58, 7.45, 7.32, 7.18, 7.05, 6.92, 6.78, 6.65, 6.52, 6.38, 
            6.25, 6.12, 5.98, 5.85, 5.72, 5.58, 5.45, 5.32, 5.18, 5.05, 
            4.92, 4.78, 4.65, 4.52, 4.38, 4.25, 4.12, 3.98, 3.85, 3.72, 
            3.58, 3.45, 3.32, 3.18, 3.05, 2.92, 2.78, 2.65, 2.52, 2.38, 
            2.25, 2.12, 1.98, 1.85, 1.72, 1.58, 1.45)[1:96]  # 确保96个数据点
)

# 添加年份和季度列
economic_data <- economic_data %>%
  mutate(
    年份 = format(日期, "%Y"),
    季度 = paste0("Q", (as.numeric(format(日期, "%m"))-1)%/%3 + 1)
  )

# 展示数据
datatable(head(economic_data, 10), 
          caption = "表9: 美国经济指标季度数据(2000-2023)",
          options = list(pageLength = 5, scrollX = TRUE))

4.2 图形3——散点图矩阵

library(GGally)
# 使用GGally包的ggpairs函数绘制散点图矩阵
ggpairs(economic_data[, c("房价指数", "失业率", "房贷利率")],
        title = "经济指标关系矩阵图（2000Q1-2023Q4）",
        upper = list(continuous = wrap("cor", size = 4)),  # 显示相关系数
        lower = list(continuous = "smooth")) +            # 显示平滑拟合线
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"))

  • 图形解读：这个散点图矩阵展示了三个关键经济指标之间的关系：

    1. 房价指数（房价走势）

    2. 失业率（劳动力市场状况）

    3. 房贷利率（借贷成本）

      对角线（直方图），房价指数：呈上升趋势，右偏分布（长期增长）。失业率：近似正态分布，但存在波动（经济周期影响）。房贷利率：呈现下降趋势，但中间有波动（受货币政策影响）。

      上三角（相关系数），房价指数和失业率：-0.162，弱负相关。 房价指数和房贷利率：-0.611，强负相关，房贷利率下降时，房价通常上涨失业率和房贷利率：-0.078，弱负相关

      下三角（散点图+平滑拟合线），房价指数和失业率（左下角）：趋势线向下，印证负相关关系。房价指数和房贷利率（中间）：明显下降趋势，说明低利率环境推高房价。失业率和房贷利率（右下角）：正相关趋势，但波动较大（利率政策并非完全由失业率决定）。

    4.2.1

5 样本相似性可视化

5.1 案例数据解释与展示

  • 数据来源：使用R内置的mtcars数据集，1974年《Motor Trend》杂志的32款汽车数据

  • 变量说明：

    • mpg: 每加仑英里数(燃油效率)

    • cyl: 气缸数

    • disp: 排量(立方英寸)

    • hp: 马力

    • drat: 后轴比率

    • wt: 重量(千磅)

    • qsec: 1/4英里加速时间

    • vs: 发动机类型(0=V型，1=直列)

    • am: 变速器类型(0=自动，1=手动)

    • gear: 前进档位数

    • carb: 化油器数量

# 加载必要包
library(DT)
library(pheatmap)
library(RColorBrewer)


data(mtcars)
mtcars_data <- mtcars

# 添加车型信息作为行名
rownames(mtcars_data) <- paste0(rownames(mtcars_data), " (", mtcars_data$cyl, " cyl)")

# 使用datatable展示数据
datatable(mtcars_data, 
          caption = "表5: 汽车性能数据集(1974 Motor Trend)",
          options = list(pageLength = 5))

5.2 图形4——汽车性能特征热图

# 选择数值型变量进行分析
numeric_vars <- c("mpg", "disp", "hp", "drat", "wt", "qsec")
mtcars_numeric <- mtcars_data[, numeric_vars]

# 创建气缸数的颜色注解
cyl_colors <- brewer.pal(3, "Set1")[1:length(unique(mtcars$cyl))]
names(cyl_colors) <- sort(unique(mtcars$cyl))

# 创建变速器类型的颜色注解
am_colors <- c("自动" = "#7fc97f", "手动" = "#beaed4")

# 改进的热图
pheatmap(t(scale(mtcars_numeric)),
         main = "汽车性能特征热图 (按气缸数和变速器类型)",
         color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(100),
         clustering_distance_rows = "euclidean",
         clustering_distance_cols = "euclidean",
         clustering_method = "ward.D2",
         fontsize_row = 10,
         fontsize_col = 8,
         angle_col = 45,
         border_color = NA,
         cellwidth = 10,
         cellheight = 15,
         annotation_col = data.frame(
           Cylinders = factor(mtcars$cyl),
           Transmission = factor(ifelse(mtcars$am == 0, "自动", "手动")),
           row.names = rownames(mtcars_numeric)
         ),
         annotation_colors = list(
           Cylinders = cyl_colors,
           Transmission = am_colors
         ),
         show_colnames = TRUE,
         legend = TRUE,
         treeheight_row = 30,
         treeheight_col = 30,
         fontsize = 8)

  • 图形解读：

  • 聚类分析：

    • 汽车样本明显分为3个主要集群：

      集群1(顶部): 高mpg、低排量/马力的经济型汽车(多为4缸)

      集群2(中部): 中等性能的汽车(多为6缸)

      集群3(底部): 高性能、高排量/马力的汽车(多为8缸)

  • 特征相关性：

    • 燃油效率(mpg)与重量(wt)、排量(disp)和马力(hp)呈强负相关

    • 1/4英里加速时间(qsec)与马力(hp)负相关

    • 后轴比率(drat)与其他特征相关性较弱

  • 分组模式：

    • 气缸数是区分汽车性能的最主要因素

    • 变速器类型(自动/手动)在聚类中影响较小，但在某些4缸车中可见模式

    可视化优势：

  • 双注解系统(气缸数+变速器)清晰展示多维信息，Ward聚类方法增强了组间区分度。

6 时间序列可视化

6.1 案例数据解释与展示

  • 数据来源：ggplot2包内置的美国经济学时间序列数据

  • 变量说明：

    • date: 日期(月数据)

    • pce: 个人消费支出(十亿美元)

    • pop: 总人口(千人)

    • psavert: 个人储蓄率(%)

    • uempmed: 失业周数中位数

    • unemploy: 失业人数(千人)

# 加载必要包
library(ggplot2)
library(dygraphs)
library(xts)
library(DT)

# 从R内置数据集获取经济学数据
data(economics)
economics_data <- economics

# 展示数据前10行
datatable(head(economics_data, 10), 
          caption = "表6: 美国经济学时间序列数据(1967-2015)",
          options = list(pageLength = 5))

6.2 图形5——时间序列图

# 时间序列图
ggplot(economics_data, aes(x = date, y = unemploy/1000)) +
  geom_line(color = "#1f78b4", size = 1) +
  geom_smooth(method = "loess", span = 0.2, color = "#e31a1c", se = FALSE) +
  labs(title = "图形5 - 美国失业人数时间序列(1967-2015)",
       subtitle = "单位: 百万人",
       x = "年份",
       y = "失业人数(百万)") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        panel.grid.minor = element_blank()) +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  annotate("rect", xmin = as.Date("1973-01-01"), xmax = as.Date("1975-01-01"),
           ymin = 0, ymax = Inf, alpha = 0.2, fill = "#ff7f00") +
  annotate("rect", xmin = as.Date("2008-01-01"), xmax = as.Date("2010-01-01"),
           ymin = 0, ymax = Inf, alpha = 0.2, fill = "#ff7f00") +
  annotate("text", x = as.Date("1974-01-01"), y = 12, 
           label = "石油危机", size = 3) +
  annotate("text", x = as.Date("2009-01-01"), y = 16, 
           label = "金融危机", size = 3)

# 创建xts时间序列对象
unemploy_xts <- xts(economics_data$unemploy/1000, order.by = economics_data$date)
names(unemploy_xts) <- "Unemployment"

# 交互式图表
dygraph(unemploy_xts, main = "美国失业人数(1967-2015)") %>%
  dyAxis("y", label = "失业人数(百万)") %>%
  dyOptions(colors = "#1f78b4", 
            fillGraph = TRUE, 
            fillAlpha = 0.2,
            drawPoints = TRUE,
            pointSize = 2,
            strokeWidth = 2) %>%
  dyRangeSelector() %>%
  dyHighlight(highlightCircleSize = 5,
              highlightSeriesBackgroundAlpha = 0.3,
              hideOnMouseOut = TRUE) %>%
  dyShading(from = "1973-01-01", to = "1975-01-01") %>%
  dyShading(from = "2008-01-01", to = "2010-01-01") %>%
  dyAnnotation("1974-01-01", text = "石油危机") %>%
  dyAnnotation("2009-01-01", text = "金融危机")

  • 图形解读：

    长期趋势：失业人数呈现周期性波动，但整体呈上升趋势(部分由于人口增长)，2008年金融危机前最高失业人数约1200万，危机期间峰值达1500万

  • 重大经济事件影响：1973-1975年石油危机期间失业人数显著增加，1980年代初经济衰退期间出现双峰形态，2008年金融危机影响最为严重，失业人数创历史新高

  • 周期性特征：大约每7-10年出现一次失业高峰，经济复苏期失业率下降速度通常慢于上升速度

  • 近期趋势(2010-2015)：金融危机后失业人数缓慢下降，2015年仍未恢复到危机前水平

结论：

  1. 重大经济危机对就业市场的影响具有持续性和滞后性

  2. 失业指标对经济冲击的反应比GDP等指标更为敏感

  3. 现代经济危机(如2008年)比传统经济危机(如1973年)对就业的影响更深远

# 多变量时间序列图
ggplot(economics_data, aes(x = date)) +
  geom_line(aes(y = unemploy/1000, color = "失业人数"), size = 1) +
  geom_line(aes(y = psavert, color = "储蓄率"), size = 1) +
  scale_y_continuous(
    name = "失业人数(百万)",
    sec.axis = sec_axis(~.*1, name = "个人储蓄率(%)")
  ) +
  scale_color_manual(values = c("#1f78b4", "#33a02c")) +
  labs(title = "失业人数与个人储蓄率关系",
       x = "年份",
       color = "变量") +
  theme_minimal() +
  theme(legend.position = "bottom")

这个图表展示了失业人数与个人储蓄率的关系，可以发现两者在经济危机期间通常呈现同步上升趋势，反映了经济不确定性对消费者行为的影响。