Economics on 格物堂

使用机器学习模型(xgboost）来预测纳斯达克 100 指数

Mon, 14 Jul 2025 00:00:00 +0000

引言

XGBoost（eXtreme Gradient Boosting）是一种高效的梯度提升算法，在数据科学和机器学习领域广泛应用，尤其擅长处理结构化数据的回归和分类问题。以下从数学原理、发展历程、使用方法和竞争算法四个方面进行详细介绍：

一、数学原理

XGBoost 是梯度提升框架（Gradient Boosting）的优化实现，其核心思想是迭代地训练多个弱学习器（通常是决策树），并将它们组合成一个强学习器。

具体数学原理如下：

1.目标函数

XGBoost 的目标函数由两部分组成：

损失函数：衡量模型预测值与真实值之间的误差（如均方误差 MSE、对数损失 log loss 等）。 正则化项：控制模型复杂度，防止过拟合，包括树的数量、深度、叶子节点数等。

目标函数表达式：

\[ \text{Obj}(\theta) = \sum_{i=1}^n L(y_i, \hat{y}_i) + \sum_{k=1}^K \Omega(f_k) \]

其中：

\(L(y_i, \hat{y}_i)\) 是样本 \(i\) 的损失函数，\(\hat{y}_i\) 是预测值，\(y_i\) 是真实值。
\(\Omega(f_k)\) 是第 \(k\) 棵树的正则化项，通常包括树的复杂度（如叶子节点数、叶子节点权重的 L2 正则化）。

2.梯度提升迭代

XGBoost 通过迭代方式逐步优化目标函数：

初始化模型为常数预测： \(\hat{y}_i^{(0)} = \text{argmin}_c \sum_{i=1}^n L(y_i, c)\) 。

对于每一轮迭代 \(t\) ：

计算损失函数关于当前预测值的梯度（一阶导数）和海森矩阵（二阶导数）。
训练一棵新的决策树 \(f_t\) ，拟合这些梯度（即预测梯度方向）。
更新预测值：\(\hat{y}_i^{(t)} = \hat{y}_i^{(t-1)} + \eta f_t(x_i)\) ，其中 \(\eta\) 是学习率（控制每次迭代的步长）。

3.决策树优化

XGBoost 在构建决策树时采用了以下优化策略：

精确贪心算法：通过枚举所有特征的所有可能分割点，找到最优分割。
近似算法：对于大规模数据，使用直方图近似快速找到分割点。
缺失值处理：自动学习缺失值的最优分裂方向。
正则化剪枝：通过正则化项控制树的复杂度，避免过拟合。

二、发展历程

2014 年：陈天奇（Tianqi Chen）在华盛顿大学读博期间开发了 XGBoost 的原型，最初作为研究项目用于解决大规模机器学习问题。
2015 年：XGBoost 作为开源项目发布，因其在 Kaggle 竞赛中的优异表现迅速走红，成为数据科学领域的主流算法之一。
2016 年：陈天奇加入微软，带领团队进一步优化 XGBoost，支持分布式计算和云计算平台。
2017 年至今：XGBoost 持续更新，增加了更多功能（如 DART、GPU 加速、特征重要性分析等），并被集成到多种编程语言和工具中（如 Python、R、Scala 等）。

三、如何使用

我们将用联邦基金有效利率和失业率为输入参数，按照 xgboost 模型对纳斯达克 100 指数月度数据进行建模。

# 加载必要的R包
library(tidyquant) # 获取数据

## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo

## ── Attaching core tidyquant packages ────────────────── tidyquant 1.0.11.9000 ──
## ✔ PerformanceAnalytics 2.0.8 ✔ TTR 0.24.4
## ✔ quantmod 0.4.28 ✔ xts 0.14.1
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidyverse) # 数据处理与可视化的核心包集合

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks xts::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidymodels) # 机器学习建模框架

## ── Attaching packages ────────────────────────────────────── tidymodels 1.3.0 ──
## ✔ broom 1.0.8 ✔ rsample 1.3.0
## ✔ dials 1.4.0 ✔ tune 1.3.0
## ✔ infer 1.0.9 ✔ workflows 1.2.0
## ✔ modeldata 1.4.0 ✔ workflowsets 1.1.1
## ✔ parsnip 1.3.2 ✔ yardstick 1.3.2
## ✔ recipes 1.3.1 
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks xts::first()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks xts::last()
## ✖ dials::momentum() masks TTR::momentum()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()

library(modeltime) # 时间序列建模与预测

## 
## Attaching package: 'modeltime'
## 
## The following object is masked from 'package:TTR':
## 
## growth

library(timetk) # 时间序列数据处理工具

## 
## Attaching package: 'timetk'
## 
## The following object is masked from 'package:tidyquant':
## 
## FANG

# 获取失业率数据 (UNRATE)
df_unrate <- 
 tq_get("UNRATE", get = "economic.data") %>% 
 select(date, unrate = price) # 重命名价格列为unrate

# 获取联邦基金有效利率数据 (FEDFUNDS)
df_fedfunds <- 
 tq_get("FEDFUNDS", get = "economic.data") %>% 
 select(date, fedfunds = price) # 重命名价格列为fedfunds

# 获取纳斯达克100指数数据
df_nasdaq <- 
 tq_get("^NDX") %>% 
 tq_transmute(select = close, # 选择收盘价
 mutate_fun = to.monthly, # 转换为月度数据
 col_rename = "nasdaq") %>% # 重命名列
 mutate(date = as.Date(date)) # 确保日期格式正确

# 合并三个数据集
df_merged <- 
 df_unrate %>% 
 left_join(df_fedfunds) %>% 
 left_join(df_nasdaq) %>% 
 drop_na() # 删除包含缺失值的行

## Joining with `by = join_by(date)`
## Joining with `by = join_by(date)`

# 时间序列数据分割
splits <- 
 time_series_split(
 df_merged,
 assess = "1 year", # 测试集为1年数据
 cumulative = TRUE # 训练集包含所有历史数据
 )

## Using date_var: date

df_train <- training(splits) # 提取训练集
df_test <- testing(splits) # 提取测试集

# 创建机器学习预处理配方
recipe_ml <- 
 recipe(nasdaq ~ ., df_train) %>% # 以nasdaq为目标变量
 step_date(date, features = "month", ordinal = FALSE) %>% # 从日期提取月份特征
 step_dummy(all_nominal_predictors(), one_hot = TRUE) %>% # 将分类变量转为虚拟变量
 step_mutate(date_num = as.numeric(date)) %>% # 将日期转换为数值型
 step_normalize(all_numeric_predictors()) %>% # 标准化数值预测变量
 step_rm(date) # 移除原始日期列

# 定义XGBoost提升树模型规格，设置超参数为待调优
mod_spec <- 
 boost_tree(trees = tune(), # 树的数量
 min_n = tune(), # 节点最小样本量
 tree_depth = tune(), # 树的最大深度
 learn_rate = tune()) %>% # 学习率
 set_engine("xgboost") %>% # 使用xgboost引擎
 set_mode("regression") # 设置为回归模式

# 提取模型的超参数集
mod_param <- extract_parameter_set_dials(mod_spec)

# 设置随机种子确保结果可复现
set.seed(1234)

# 创建随机超参数网格（50种组合）
model_tbl <- 
 mod_param %>% 
 grid_random(size = 50) %>%
 create_model_grid(
 f_model_spec = boost_tree,
 engine_name = "xgboost",
 mode = "regression"
 )

# 从网格中提取模型列表
model_list <- model_tbl$.models

# 创建工作流集，将预处理配方与不同模型规格组合
model_wfset <- 
 workflow_set(
 preproc = list(recipe_ml), # 使用之前定义的预处理配方
 models = model_list, # 使用超参数网格生成的模型列表
 cross = TRUE # 交叉组合配方和模型
 )

# 使用并行计算加速模型训练
model_parallel_tbl <- 
 model_wfset %>%
 modeltime_fit_workflowset(
 data = df_train, # 使用训练集数据
 control = control_fit_workflowset(
 verbose = TRUE, # 显示训练进度
 allow_par = TRUE # 允许并行计算
 )
 )

## ℹ Fitting Model: 1
## ✔ Model Successfully Fitted: 1
## ℹ Fitting Model: 2
## ✔ Model Successfully Fitted: 2
## ℹ Fitting Model: 3
## ✔ Model Successfully Fitted: 3
## ℹ Fitting Model: 4
## ✔ Model Successfully Fitted: 4
## ℹ Fitting Model: 5
## ✔ Model Successfully Fitted: 5
## ℹ Fitting Model: 6
## ✔ Model Successfully Fitted: 6
## ℹ Fitting Model: 7
## ✔ Model Successfully Fitted: 7
## ℹ Fitting Model: 8
## ✔ Model Successfully Fitted: 8
## ℹ Fitting Model: 9
## ✔ Model Successfully Fitted: 9
## ℹ Fitting Model: 10
## ✔ Model Successfully Fitted: 10
## ℹ Fitting Model: 11
## ✔ Model Successfully Fitted: 11
## ℹ Fitting Model: 12
## ✔ Model Successfully Fitted: 12
## ℹ Fitting Model: 13
## ✔ Model Successfully Fitted: 13
## ℹ Fitting Model: 14
## ✔ Model Successfully Fitted: 14
## ℹ Fitting Model: 15
## ✔ Model Successfully Fitted: 15
## ℹ Fitting Model: 16
## ✔ Model Successfully Fitted: 16
## ℹ Fitting Model: 17
## ✔ Model Successfully Fitted: 17
## ℹ Fitting Model: 18
## ✔ Model Successfully Fitted: 18
## ℹ Fitting Model: 19
## ✔ Model Successfully Fitted: 19
## ℹ Fitting Model: 20
## ✔ Model Successfully Fitted: 20
## ℹ Fitting Model: 21
## ✔ Model Successfully Fitted: 21
## ℹ Fitting Model: 22
## ✔ Model Successfully Fitted: 22
## ℹ Fitting Model: 23
## ✔ Model Successfully Fitted: 23
## ℹ Fitting Model: 24
## ✔ Model Successfully Fitted: 24
## ℹ Fitting Model: 25
## ✔ Model Successfully Fitted: 25
## ℹ Fitting Model: 26
## ✔ Model Successfully Fitted: 26
## ℹ Fitting Model: 27
## ✔ Model Successfully Fitted: 27
## ℹ Fitting Model: 28
## ✔ Model Successfully Fitted: 28
## ℹ Fitting Model: 29
## ✔ Model Successfully Fitted: 29
## ℹ Fitting Model: 30
## ✔ Model Successfully Fitted: 30
## ℹ Fitting Model: 31
## ✔ Model Successfully Fitted: 31
## ℹ Fitting Model: 32
## ✔ Model Successfully Fitted: 32
## ℹ Fitting Model: 33
## ✔ Model Successfully Fitted: 33
## ℹ Fitting Model: 34
## ✔ Model Successfully Fitted: 34
## ℹ Fitting Model: 35
## ✔ Model Successfully Fitted: 35
## ℹ Fitting Model: 36
## ✔ Model Successfully Fitted: 36
## ℹ Fitting Model: 37
## ✔ Model Successfully Fitted: 37
## ℹ Fitting Model: 38
## ✔ Model Successfully Fitted: 38
## ℹ Fitting Model: 39
## ✔ Model Successfully Fitted: 39
## ℹ Fitting Model: 40
## ✔ Model Successfully Fitted: 40
## ℹ Fitting Model: 41
## ✔ Model Successfully Fitted: 41
## ℹ Fitting Model: 42
## ✔ Model Successfully Fitted: 42
## ℹ Fitting Model: 43
## ✔ Model Successfully Fitted: 43
## ℹ Fitting Model: 44
## ✔ Model Successfully Fitted: 44
## ℹ Fitting Model: 45
## ✔ Model Successfully Fitted: 45
## ℹ Fitting Model: 46
## ✔ Model Successfully Fitted: 46
## ℹ Fitting Model: 47
## ✔ Model Successfully Fitted: 47
## ℹ Fitting Model: 48
## ✔ Model Successfully Fitted: 48
## ℹ Fitting Model: 49
## ✔ Model Successfully Fitted: 49
## ℹ Fitting Model: 50
## ✔ Model Successfully Fitted: 50
## Total time | 22.065 seconds

# 评估模型在测试集上的准确性
model_parallel_tbl %>% 
 modeltime_calibrate(new_data = df_test) %>% # 校准模型
 modeltime_accuracy() %>% # 计算准确性指标
 table_modeltime_accuracy() # 以表格形式展示结果

## Warning: There were 12 warnings in `dplyr::mutate()`.
## The first warning was:
## ℹ In argument: `.nested.col = purrr::map(...)`.
## Caused by warning:
## ! A correlation computation is required, but `estimate` is constant and has 0
## standard deviation, resulting in a divide by 0 error. `NA` will be returned.
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 11 remaining warnings.

# 选择表现最好的模型（这里假设是RECIPE_BOOST_TREE_27）
# 并在测试集上进行校准
calibration_tbl <- 
 model_parallel_tbl %>%
 filter(.model_desc == "RECIPE_BOOST_TREE_27") %>% 
 modeltime_calibrate(df_test)

# 生成预测并绘制预测区间
calibration_tbl %>% 
 modeltime_forecast(
 new_data = df_test, # 在测试集上进行预测
 actual_data = df_merged %>%
 filter(date >= as.Date("2024-07-01")) # 实际数据从2024-07-01开始
 ) %>%
 plot_modeltime_forecast(
 .interactive = FALSE, # 生成静态图表
 .legend_show = FALSE, # 不显示图例
 .line_size = 1.5, # 设置线条粗细
 .color_lab = "", # 设置颜色标签
 .title = "NASDAQ 100" # 设置图表标题
 ) +
 # 添加副标题（使用markdown格式）
 labs(subtitle = "<span style = 'color:dimgrey;'>预测区间</span><br><span style = 'color:red;'>机器学习模型</span>") + 
 # 设置x轴（日期）格式
 scale_x_date(
 expand = expansion(mult = c(.1, .15)), # 设置x轴扩展
 labels = scales::label_date(format = "%b'%y") # 设置日期标签格式
 ) +
 # 设置y轴（纳斯达克指数）格式为货币格式
 scale_y_continuous(labels = scales::label_currency()) +
 # 设置图表主题
 theme_minimal(base_family = "Roboto Slab", base_size = 20) +
 theme(
 legend.position = "none", # 不显示图例
 plot.background = element_rect(fill = "azure", color = "azure"), # 设置背景颜色
 plot.title = element_text(face = "bold"), # 设置标题字体为粗体
 axis.text = element_text(face = "bold"), # 设置坐标轴标签字体为粗体
 plot.subtitle = ggtext::element_markdown(face = "bold") # 设置副标题为markdown格式并加粗
 )

## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf

四、竞争算法

XGBoost 的主要竞争对手包括：

1. LightGBM

开发者：微软（2017 年发布）。

特点：

基于直方图的决策树构建，速度比 XGBoost 更快。
支持 Leaf-wise（按叶子生长）的树生长策略，而不是 XGBoost 的 Level-wise（按层生长）。
内存占用更小，适合大规模数据集。
适用场景：超大规模数据集、需要快速迭代的场景。

2. CatBoost

开发者：Yandex（2017 年发布）。

特点：

自动处理类别特征（无需手动编码）。
采用对称树结构，减少过拟合风险。
支持 GPU 加速和分布式训练。

适用场景：包含大量类别特征的数据集（如推荐系统、广告点击预测）。

3. Random Forest

特点：

基于 Bagging 思想的集成学习算法，并行训练多棵决策树。
对异常值和过拟合更鲁棒。
计算复杂度较低，但预测精度可能低于 Boosting 算法。

适用场景：快速 baseline 模型、对解释性要求较高的场景。

4. Neural Networks（神经网络）

特点：

适用于非结构化数据（如图像、文本、语音）。
需要大量数据才能表现良好。
计算资源消耗大，训练时间长。

适用场景：深度学习擅长的领域（如计算机视觉、自然语言处理）。

五、算法选择建议

数据规模较小：可尝试 Random Forest 或 CatBoost（处理类别特征更方便）。
数据规模中等：XGBoost 和 LightGBM 均可，XGBoost 更成熟，LightGBM 速度更快。
包含大量类别特征：优先使用 CatBoost。
追求极致速度：选择 LightGBM。
非结构化数据：考虑神经网络（如 CNN、Transformer）。

XGBoost 的优势在于其高效性、灵活性和广泛的应用场景，尤其在 Kaggle 竞赛和工业界的结构化数据分析中表现突出。

货币的省际贬值

Wed, 01 Feb 2012 00:00:00 +0000

回老家之后发现老家的烧饼是0.5元一个，而北京的烧饼是1元一个。也即，同样的1元钱在河南和在北京的购买力是不一样的，且相差了1倍。倘若将河南和北京各视为一个国家的话，根据购买力平价理论，则两地的汇率应当是1:2。然而，由于河南和北京同属一个国家，从而汇率问题，准确的说货币的购买力不等问题被忽略了。

在上述问题被忽略的基础上，富有想象力的人们产生了一种美好的愿望，即在北京挣钱、回老家去花。然而，由于两地之间路途遥远，这是不现实的。但是，这并无碍于人们实现这个美好愿望的心理，你可以将挣来的钱，寄给家里的父母花。

对于个体而言，上面的做法是个不错的解决方案，从某种意义上讲，较好的实现了货币的购买力。然而，站在更好的一个角度来看，这是一种比较恶劣的做法。试想，北京的钱被源源不断地被输往河南，而河南的烧饼供给量并不会随之增加，久而久之会出现什么效果？河南的烧饼价格会上涨，如果将烧饼看做河南生产的唯一消费品的话，河南产生了通货膨胀！没错，我相信这是通胀在省际之间转移的重要途径之一。这也就解释了为什么眼下太康县的物价水平跟北京有的一拼。长远来看，这种做法严重损伤了固守在河南工作的人们的利益。

套利与排队

Sun, 11 Dec 2011 00:00:00 +0000

某次跟同事吃饭遇到排队，便聊到排队这件事情中个体应当如何选择自己的最佳行为。聊到最后愕然发现，“排队现象”与金融是很相像的。两者中最重要的一个概念都是“套利”。

为了简便起见，我们虚构一个故事：假如A到一个餐厅，该餐厅有三个窗口，每个窗口都有若干人排队，问A应该去哪个队？

正常情况下，A可以任选一队，因为任何一队比其他队都没有任何优势。如果有优势的话，那先前必然已经出现一些人自动转向那个优势队来抵消优势队的优势，这个过程就是典型的“套利”过程。在金融中，“套利”过程最重要的结果是导致了“平价”，在排队中，“平价”表现为最终所有的队伍长度是一样的。

严格的分析过程等我有时间，我再写在这里。

**备注：**本来今天想写一写函数型数据与货币政策制定之间的关系的，因为弄丢了一个材料，所以只能改天再写。该文章名是《函数型数据分析手段或在政策制定中大有可为》。

尊严是人的固定成本

Wed, 07 Dec 2011 00:00:00 +0000

昨天吃午饭的时候，几个人谈到“西单磕头王”都“羡慕”不已。据说这个人在北京拥有四辆车和数套房产。这些财富在我们看来短时间内是可望而不可及的，而他竟然通过“磕头乞讨”就得到了。

其中一人说，这些人比我们好多了。我们辛辛苦苦工作，脑力劳动加体力劳动到头来也没人家挣的多。另一个人则持有相反观点，他认为这个人付出挺多的，最重要的是他为此付出了自己的尊严。

我在思考一个问题：大部分人不去乞讨的原因是什么？

从经济学角度来讲，是因为道德教育导致了我们对自己的尊严估值甚高，高到让我们觉得无论什么东西都不足以与其等值交换。结果大部分人都守着一个无法变现的尊严。而“西单磕头王”所做的事情概括起来有两部分来构成：

重估自己的尊严。在这过程中，他重估自己的尊严，并且适当的调低了自己对尊严的估值，这样使得世界上有些东西可以与尊严等值交换。
把重估的尊严进行变现。也就是说，他卖出了自己的尊严来换取金钱，当然还有随之而来的负面评价。

有了这个基础，我们便可以研究尊严在经济学中到底处于什么地位了。

我认为对于任何一个乞讨的人而言，他第一次放下尊严是一个重大的举动。因为从此之后，尊严就成为了他乞讨事业中的“固定成本”。也就说，一旦一个人放下尊严，那么第二次、第三次放下尊严并不会使他付出更大的代价了（从道德角度来讲，一旦一个人决定不要脸，那么已经不可能是他更觉得羞耻了）。

这就可以很好的解释为什么有些人愿意乞讨为生了。我们可以从他乞讨的成本和收益来进行分析。

乞讨的成本。

乞讨的成本分为两部分，即固定成本和变动成本。固定成本就是一个人的尊严，这构成乞讨成本的最大一部分。变动成本则包括乞讨过程中的吃、穿、道具、交通费等东西。

乞讨的收益。

从乞讨过程中得到的金钱和物品。

由于尊严是固定成本的最大部分，变动成本在成本中所占比例甚少，再加上一旦开始乞讨，尊严作为固定成本则随即沉没无法收回。而乞讨的收益则是日益增加，由此推出乞讨的平均成本是日益递减的。那么，作为一个理性人，乞讨者没有理由自动终结乞讨过程。

一价定律

Tue, 29 Nov 2011 00:00:00 +0000

一价定律即绝对购买力平价理论，它是由的货币学派的代表人物弗里德曼(1953)提出的。

一价定律认为在没有运输费用和官方贸易壁垒的自由竞争市场上，一件同质商品在不同国家（地点）出售，如果以同一种货币计价，其价格应是相等的。即，通过汇率折算之后的标价是应当是一致的。如果情况不是这样，或者更专业的说，如果在各国间存在价格差异，则会发生商品套购。直到价差被消除，贸易停止，这时达到商品市场的均衡状态。举个例子：

一颗苹果在中国卖2RMB，那么，根据即期汇率6.48来换算的话，它在美国的售价应该是 \(2/6.48=0.3086\) 。如果苹果在美国的售价是0.4美元的话，你就可以拿着钱来中国买苹果，再回美国去卖，从而谋利。

当然了，结果会出现为数众多的你来进行套购，最终苹果在美国的售价将回归至0.3068美元。

当然，这个理论是在严格的假设下得出来的，其中比较重要的几个假设是：

1.对比国家都实行了同等程度的货币自由兑换，货币、商品、劳务和资本流通是完全自由的； 2.自由贸易，关税为0; 3.信息是完全的； 4.易成本为零。

因此，一价定律理论上非常完美，但现实中并非如此。

索罗模型模拟

Sat, 25 Dec 2010 00:00:00 +0000

索罗模型

索罗模型是宏观经济学中的基础模型，用于解释经济体长期经济增长的原因，索罗模型的主要关注集中在资本积累、人口增长和技术进步。

索罗模型的模拟

基于R语言写一段模拟索罗模型的应用。

library(shiny)
library(ggplot2)
library(deSolve)

# 索罗模型微分方程
solow_model <- function(time, state, parameters) {
 with(as.list(c(state, parameters)), {
 dk <- s * (k^alpha) * (A * L)^(1-alpha) - (delta + n + g) * k
 list(dk)
 })
}

ui <- fluidPage(
 titlePanel("索罗经济增长模型模拟器"),
 sidebarLayout(
 sidebarPanel(
 sliderInput("s", "储蓄率 (s)", 0.1, 0.5, 0.25, 0.01),
 sliderInput("delta", "折旧率 (δ)", 0.01, 0.15, 0.05, 0.01),
 sliderInput("n", "人口增长率 (n)", 0.0, 0.05, 0.02, 0.001),
 sliderInput("g", "技术进步率 (g)", 0.0, 0.05, 0.01, 0.001),
 sliderInput("alpha", "资本产出弹性 (α)", 0.2, 0.8, 0.3, 0.05),
 numericInput("k0", "初始人均资本", 0.1, min = 0.01, max = 10),
 actionButton("run", "运行模拟")
 ),
 
 mainPanel(
 tabsetPanel(
 tabPanel("资本动态", plotOutput("capital_plot")),
 tabPanel("稳态分析", 
 plotOutput("phase_diagram"),
 htmlOutput("steady_state"))
 ),
 h4("模型说明:"),
 uiOutput("model_desc")
 )
 )
)

server <- function(input, output) {
 observeEvent(input$run, {
 parameters <- c(s = input$s,
 delta = input$delta,
 n = input$n,
 g = input$g,
 alpha = input$alpha,
 A = 1, # 初始技术水平
 L = 1) # 初始劳动力
 
 state <- c(k = input$k0)
 times <- seq(0, 100, by = 1)
 
 # 解微分方程
 out <- ode(y = state, times = times, func = solow_model, parms = parameters)
 
 # 处理结果
 df <- data.frame(
 Time = out[,1],
 Capital = out[,2],
 Output = (out[,2]^input$alpha) * (parameters["A"] * exp((parameters["n"]+parameters["g"])*out[,1]))^(1-input$alpha),
 Consumption = (1 - input$s) * (out[,2]^input$alpha) * (parameters["A"] * exp((parameters["n"]+parameters["g"])*out[,1]))^(1-input$alpha)
 )
 
 # 资本动态图
 output$capital_plot <- renderPlot({
 ggplot(df, aes(Time, Capital)) +
 geom_line(color = "darkblue", size = 1.2) +
 geom_hline(yintercept = (input$s/(input$delta + input$n + input$g))^(1/(1-input$alpha)), 
 linetype = "dashed", color = "red") +
 labs(title = "人均资本动态路径",
 subtitle = "红色虚线表示理论稳态值",
 y = "人均资本 (k)") +
 theme_minimal()
 })
 
 # 相位图
 output$phase_diagram <- renderPlot({
 ggplot(df, aes(Capital, Output)) +
 geom_path(color = "darkgreen", size = 1.2) +
 geom_point(aes(x = tail(Capital,1), y = tail(Output,1)), 
 color = "red", size = 3) +
 labs(title = "资本-产出相位图",
 x = "人均资本 (k)",
 y = "人均产出 (y)") +
 theme_minimal()
 })
 
 # 稳态计算
 output$steady_state <- renderUI({
 k_star <- (input$s/(input$delta + input$n + input$g))^(1/(1-input$alpha))
 y_star <- k_star^input$alpha
 c_star <- (1 - input$s) * y_star
 
 HTML(paste(
 "<h4>稳态值计算:</h4>",
 paste0("人均资本 k* = ", round(k_star, 3)),
 paste0("人均产出 y* = ", round(y_star, 3)),
 paste0("人均消费 c* = ", round(c_star, 3)),
 sep = "<br/>"
 ))
 })
 })
 
 output$model_desc <- renderUI({
 HTML("<p>标准索罗模型设定：</p>
 <ul>
 <li>生产函数：Y = K<sup>α</sup>(AL)<sup>1-α</sup></li>
 <li>资本积累：dk/dt = sY - (δ + n + g)K</li>
 <li>稳态条件：sy = (δ + n + g)k</li>
 </ul>")
 })
}

shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents

一些说明

可以互动调整以下参数：

储蓄率 (s)
资本折旧率 (δ)
人口增长率 (n)
技术进步率 (g)
资本产出弹性 (α)

可视化展示

资本积累动态路径
资本-产出相位图
理论稳态值标记
实时稳态值计算

技术实现

使用deSolve包进行微分方程求解
ggplot2生成动态图表
响应式编程实现实时更新
HTML输出格式化显示结果

使用方法：

确保已安装所需包：

install.packages(c("shiny", "ggplot2", "deSolve"))

shiny::runApp("app.R") # 假设代码保存为app.R

应用场景

展示储蓄率变化对稳态的影响
观察人口老龄化（降低n）的经济效应
演示技术进步如何提升长期增长路径
比较不同生产函数参数的影响
这个应用可以帮助学生直观理解：
- 经济收敛到稳态的动态过程
- 参数变化对长期均衡的影响
- 投资与消费的权衡关系
- 增长核算的基本原理

基于GRACH模型计算VaR

Thu, 23 Dec 2010 00:00:00 +0000

一、引言

风险价值（VaR）是衡量金融资产潜在损失的核心指标，但传统方法假设收益率服从独立同分布的正态分布，难以捕捉金融时间序列的 “波动聚类”（volatility clustering）和 “尖峰厚尾” 特性。

ARCH（自回归条件异方差）模型及扩展的 GARCH（广义自回归条件异方差）模型通过刻画波动率的动态变化，能更精准地拟合收益率分布，从而提升 VaR 估计的可靠性。

本文以特斯拉（TSLA）股票收益率为例，详细介绍 GARCH 模型的构建、参数估计及 VaR 计算流程，并通过 R 语言quantmod和rgarch包实现实证分析。

二、GARCH 模型理论

ARCH 模型基础

ARCH 模型假设资产收益率的条件方差依赖于过去的平方残差，其核心是波动率的动态性。

均值方程：

\[ r_t = \mu + \epsilon_t \tag{1} \]

其中，

\(r_t\) 为 t 时刻的收益率，

\(\mu\) 为常数均值，

\(\epsilon_t\) 为随机扰动项，且 \(\epsilon_t = \sigma_t \cdot z_t\) （ \(z_t\) )为独立同分布的随机变量，通常假设 \(z_t \sim N(0,1)\) ）。

条件方差方程（ARCH (q)）：

\[\sigma_t^2 = \omega + \alpha_1 \epsilon_{t-1}^2 + \alpha_2 \epsilon_{t-2}^2 + ... + \alpha_q \epsilon_{t-q}^2 \tag{2} \]

其中，\(\sigma_t^2\) 为 t 时刻的条件方差，\(\omega > 0\) ，\(\alpha_i \geq 0\) （保证方差非负），q为 ARCH 阶数。

GARCH 模型扩展

GARCH 模型在 ARCH 基础上引入过去的条件方差项，简化了高阶 ARCH 模型的参数估计。最常用的 GARCH (p,q) 模型形式为：

均值方程：同式（1）

条件方差方程（GARCH (p,q)）：

\[ \sigma_t^2 = \omega + \sum_{i=1}^p \beta_i \sigma_{t-i}^2 + \sum_{j=1}^q \alpha_j \epsilon_{t-j}^2 \tag{3} \]

其中，p为 GARCH 阶数（滞后条件方差项），q为 ARCH 阶数（滞后平方残差项），且 \(\omega > 0\) ， \(\beta_i \geq 0\) ， \(\alpha_j \geq 0\) ， \(\sum_{i=1}^p \beta_i + \sum_{j=1}^q \alpha_j < 1\) （保证方差平稳）。

实际应用中，GARCH (1,1) 模型因简洁且拟合效果好而被广泛使用：

\[ \sigma_t^2 = \omega + \beta_1 \sigma_{t-1}^2 + \alpha_1 \epsilon_{t-1}^2 \tag{4} \]

模型扩展与分布假设变种模型：通过修改条件方差方程可得到 EGARCH（指数 GARCH，捕捉杠杆效应）、IGARCH（积分 GARCH，非平稳波动率）等。

分布假设：为捕捉 “尖峰厚尾”，可假设扰动项 \(z_t\) 服从学生 t 分布（GARCH-t）、广义误差分布（GARCH-GED）等，而非正态分布。

基于 GARCH 模型的 VaR 计算

给定置信水平 \(1-\alpha\) （如 95%、99%），VaR 定义为：

\[ VaR_t = \mu_t + \sigma_t \cdot z_\alpha \tag{5} \]

其中：

\(\mu_t\) 为 t 时刻的条件均值（通常假设为 0 或常数）；

\(\sigma_t\) 为 GARCH 模型预测的条件标准差；

\(z_\alpha\) 为扰动项分布的 \(\alpha\) 分位数（如正态分布下 95% 置信水平的 \(z_\alpha = -1.645\) ）。

三、R 语言实证分析（TSLA 数据）

数据准备与预处理使用 quantmod 获取 TSLA 股票数据并计算对数收益率：

# 安装并加载包
if (!require("quantmod")) install.packages("quantmod")
if (!require("rugarch")) install.packages("rugarch")
if (!require("ggplot2")) install.packages("ggplot2")
library(quantmod)
library(rugarch)
library(ggplot2)

# 获取TSLA数据（2018-2023年）
getSymbols("TSLA", from = "2018-01-01", to = "2023-12-31")

## [1] "TSLA"

tsla_close <- TSLA$TSLA.Close # 提取收盘价
ret <- diff(log(tsla_close)) # 计算对数收益率
ret <- na.omit(ret) # 去除缺失值
colnames(ret) <- "TSLA_Return"

拟合 GARCH 模型以 GARCH (1,1) 为例，分别假设正态分布、t 分布和 GED 分布：

# 定义模型规范（正态分布）
garch_spec_norm <- ugarchspec(
 variance.model = list(model = "sGARCH", garchOrder = c(1,1)), # 标准GARCH(1,1)
 mean.model = list(armaOrder = c(0,0)), # 均值模型为常数（无ARMA项）
 distribution.model = "norm" # 正态分布
)

# 拟合模型
garch_fit_norm <- ugarchfit(spec = garch_spec_norm, data = ret)
print(garch_fit_norm) # 输出参数估计结果

## 
## *---------------------------------*
## * GARCH Model Fit *
## *---------------------------------*
## 
## Conditional Variance Dynamics 	
## -----------------------------------
## GARCH Model	: sGARCH(1,1)
## Mean Model	: ARFIMA(0,0,0)
## Distribution	: norm 
## 
## Optimal Parameters
## ------------------------------------
## Estimate Std. Error t value Pr(>|t|)
## mu 0.001551 0.000945 1.6407 0.100852
## omega 0.000080 0.000025 3.1932 0.001407
## alpha1 0.066008 0.013489 4.8936 0.000001
## beta1 0.883325 0.026129 33.8057 0.000000
## 
## Robust Standard Errors:
## Estimate Std. Error t value Pr(>|t|)
## mu 0.001551 0.001042 1.4883 0.136684
## omega 0.000080 0.000041 1.9324 0.053305
## alpha1 0.066008 0.020564 3.2098 0.001328
## beta1 0.883325 0.040170 21.9898 0.000000
## 
## LogLikelihood : 2784.519 
## 
## Information Criteria
## ------------------------------------
## 
## Akaike -3.6877
## Bayes -3.6736
## Shibata -3.6877
## Hannan-Quinn -3.6824
## 
## Weighted Ljung-Box Test on Standardized Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.02525 0.8737
## Lag[2*(p+q)+(p+q)-1][2] 0.92656 0.5227
## Lag[4*(p+q)+(p+q)-1][5] 2.41996 0.5230
## d.o.f=0
## H0 : No serial correlation
## 
## Weighted Ljung-Box Test on Standardized Squared Residuals
## ------------------------------------
## statistic p-value
## Lag[1] 0.06154 0.8041
## Lag[2*(p+q)+(p+q)-1][5] 1.91852 0.6378
## Lag[4*(p+q)+(p+q)-1][9] 3.32230 0.7048
## d.o.f=2
## 
## Weighted ARCH LM Tests
## ------------------------------------
## Statistic Shape Scale P-Value
## ARCH Lag[3] 0.1339 0.500 2.000 0.7144
## ARCH Lag[5] 0.1515 1.440 1.667 0.9765
## ARCH Lag[7] 1.3871 2.315 1.543 0.8437
## 
## Nyblom stability test
## ------------------------------------
## Joint Statistic: 0.7741
## Individual Statistics: 
## mu 0.1583
## omega 0.1017
## alpha1 0.1429
## beta1 0.0778
## 
## Asymptotic Critical Values (10% 5% 1%)
## Joint Statistic: 	 1.07 1.24 1.6
## Individual Statistic:	 0.35 0.47 0.75
## 
## Sign Bias Test
## ------------------------------------
## t-value prob sig
## Sign Bias 0.1675 0.8670 
## Negative Sign Bias 0.3152 0.7527 
## Positive Sign Bias 0.5054 0.6134 
## Joint Effect 0.4957 0.9198 
## 
## 
## Adjusted Pearson Goodness-of-Fit Test:
## ------------------------------------
## group statistic p-value(g-1)
## 1 20 99.19 7.510e-13
## 2 30 112.84 7.843e-12
## 3 40 122.45 1.505e-10
## 4 50 129.67 3.238e-09
## 
## 
## Elapsed time : 0.1193922

# 扩展：拟合GARCH-t和GARCH-GED
garch_spec_t <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1,1)),
 mean.model = list(armaOrder = c(0,0)),
 distribution.model = "std") # 学生t分布
garch_fit_t <- ugarchfit(spec = garch_spec_t, data = ret)

garch_spec_ged <- ugarchspec(variance.model = list(model = "sGARCH", garchOrder = c(1,1)),
 mean.model = list(armaOrder = c(0,0)),
 distribution.model = "ged") # GED分布
garch_fit_ged <- ugarchfit(spec = garch_spec_ged, data = ret)

模型参数解读

GARCH (1,1) 模型的核心参数为：

\(\omega\) ：常数项（长期方差水平）；

\(\alpha_1\) ：ARCH 项系数（过去平方残差的影响）；

\(\beta_1\) ：GARCH 项系数（过去波动率的影响）；

若 \(\alpha_1 + \beta_1 < 1\) ，说明波动率平稳。

计算 VaR基于拟合模型预测条件波动率，并计算不同置信水平的 VaR：

# 提取条件标准差（在样内预测）
sigma_norm <- sigma(garch_fit_norm) # 正态分布GARCH的条件标准差

# 定义分位数函数（计算z_alpha）
quantile_fun <- function(conf_level, dist) {
 alpha <- 1 - conf_level
 if (dist == "norm") {
 return(qnorm(alpha)) # 正态分布分位数
 } else if (dist == "std") {
 nu <- coef(garch_fit_t)["shape"] # 学生t分布自由度
 return(qt(alpha, df = nu))
 } else if (dist == "ged") {
 nu <- coef(garch_fit_ged)["shape"] # GED分布形状参数
 return(qged(alpha, shape = nu))
 }
}

# 计算95%和99%置信水平的VaR（以正态分布为例）
conf_levels <- c(0.95, 0.99)
z_95 <- quantile_fun(0.95, "norm")
z_99 <- quantile_fun(0.99, "norm")

vaR_95_norm <- 0 + sigma_norm * z_95 # 假设条件均值为0
vaR_99_norm <- 0 + sigma_norm * z_99

# 整理结果（取绝对值，损失为正）
vaR_df <- data.frame(
 Date = index(ret),
 Return = as.numeric(ret),
 VaR_95 = abs(vaR_95_norm),
 VaR_99 = abs(vaR_99_norm)
)

结果可视化与回测

# 可视化收益率与VaR
ggplot(vaR_df, aes(x = Date)) +
 geom_line(aes(y = Return, color = "收益率"), alpha = 0.7) +
 geom_line(aes(y = VaR_95, color = "95% VaR"), linetype = "dashed") +
 geom_line(aes(y = VaR_99, color = "99% VaR"), linetype = "dashed") +
 labs(title = "TSLA收益率与GARCH模型VaR",
 y = "收益率/损失", x = "日期", color = "指标") +
 theme_minimal()

# 回测：计算失败率（实际损失超过VaR的比例）
fail_95 <- mean(vaR_df$Return < -vaR_df$VaR_95, na.rm = TRUE)
fail_99 <- mean(vaR_df$Return < -vaR_df$VaR_99, na.rm = TRUE)
cat("95% VaR失败率：", round(fail_95 * 100, 2), "%\n")

## 95% VaR失败率： 4.64 %

cat("99% VaR失败率：", round(fail_99 * 100, 2), "%\n")

## 99% VaR失败率： 1.59 %

不同模型的 VaR 对比

可对比 GARCH-t、GARCH-GED 与正态 GARCH 的 VaR 结果，通常非正态分布假设下的 VaR 更大，更保守：

# 计算GARCH-t的VaR（95%置信水平）
sigma_t <- sigma(garch_fit_t)
z_95_t <- quantile_fun(0.95, "std")
vaR_95_t <- abs(sigma_t * z_95_t)

四、结论

GARCH 模型通过捕捉波动率的动态变化，显著提升了 VaR 估计的准确性，尤其在市场波动剧烈时期（如 TSLA 股价大幅波动阶段）。

实证显示：TSLA 收益率存在明显的波动聚类特性，GARCH (1,1) 能有效拟合；基于 t 分布或 GED 分布的 GARCH 模型计算的 VaR 更能反映尾部风险，失败率更接近理论置信水平；实际应用中可根据资产特性选择模型变种（如 EGARCH 捕捉杠杆效应）或分布假设。

未来可结合滚动窗口预测或压力测试，进一步优化 VaR 的动态跟踪能力。

注：代码中rugarch包的ugarchspec和ugarchfit函数需注意模型收敛性，若不收敛可调整初始值或模型阶数；回测失败率若显著偏离理论值（如 95% 置信水平下失败率 > 7%），需重新调整模型。