关于 Full-empirical-analysis-skill-R
面向应用经济学家及其他实证研究者的 R 技能,将数据处理、因果分析和报告整理为八步工作流。它涵盖经济学、流行病学和因果机器学习模式,并规定可复现的 R、Quarto 实践及表图输出。
主要功能
- 01八步实证分析工作流
- 02经济学、流行病学与因果机器学习模式
- 03基于 tidyverse 和 fixest 的 R 方法
- 04可复现脚本与 Quarto 工作流
- 05论文表格与图形输出
- 06分析修改的验证关卡
适用场景
- 01构建应用经济学论文分析
- 02运行流行病学或因果机器学习流程
- 03准备可复现的 R 与 Quarto 分析
- 04验证实证分析设定的修改
安装
复制下面的命令,在终端中运行。
npx skills add https:/ / github.com/ brycewang-stanford/ auto-empirical-research-skills --skill full-empirical-analysis-skill-r安装后在 Claude Code 中输入/full-empirical-analysis-skill-r确认已加载。
包含的文件
除 SKILL.md 外,安装时一起下载的参考资料和脚本。
README.mdreferences/03-descriptive-stats.md01-data-cleaning.md08-tables-plots.md06-robustness.md02-data-transformation.md04-statistical-tests.md05-modeling.md07-further-analysis.md详细介绍
完整实证分析 — 经典 R 工作流
此技能是应用经济学家处理每篇实证论文时采用的标准 8 步流程,使用现代 tidyverse + 计量经济学 R 生态系统编写:dplyr/tidyr/haven 用于数据处理,fixest 作为面板/IV/DID 主力工具,did/bacondecomp/HonestDiD 用于现代 DID,rdrobust/rddensity 用于 RD,Synth/gsynth/synthdid 用于合成控制,MatchIt/WeightIt/cobalt/ebal 用于匹配,grf/DoubleML 用于机器学习因果分析,mediation 用于因果中介分析,marginaleffects 用于估计后分析,modelsummary/kableExtra/gt 用于发表级表格,ggplot2/iplot/binsreg 用于图表。
配套技能:这是 00-StatsPAI_skill(Python DSL)、00.1-Full-empirical-analysis-skill(显式 Python)和 00.2-Full-empirical-analysis-skill_Stata(Stata .do)的 R 版本。四者都在各自的生态系统中实现相同的 8 个步骤。
理念
- Tidyverse + fixest,现代 R 惯用写法。 使用
feols(... | unit + year, cluster = ~unit),而不是拼凑式的lm(y ~ x + factor(unit) + factor(year))。 - 可复现脚本 / Quarto。 以下每个示例都可直接粘贴运行。使用
renv锁定软件包;使用Quarto(.qmd)整合叙述、代码、表格和图表。 - 将 8 个步骤作为核心。 R 用户历来过度投入第 5 步;此技能将第 1–4 步和第 6–8 步也视为核心。
- 丰富的输出。 每个步骤至少生成一个表格或图表 — tex/docx/png/pdf。
- 渐进式披露。
SKILL.md提供每个步骤的标准调用;references/包含针对不同变体的深入内容。
SkillOpt 风格的执行关卡
将这份详尽指南用作种子技能,而不是需要穷尽执行的脚本。遵循 SkillOpt 准则:将每项本地 R/Quarto 更改视为候选补丁,只有通过选择集检查并经受留出集检查后,才能将其作为可复用样板。在编写或修订 R 脚本/Quarto 工作流前,将用户请求压缩为任务专属的 best_skill 卡片:
best_skill: <mode + design + artifact target>
train_signal: <current failure, user goal, or missing evidence>
selection_split: <focal dataset/spec/output used to judge the candidate>
heldout_gate: <checks the patch must pass beyond the focal example>
accepted_patterns: <rules to reuse after validation>
rejected_patterns: <failed shortcuts not to retry without new evidence>
patch_scope: <one estimator/sample/export/robustness change>
reject_if: <conditions that force rollback to the last passing spec>
- 路由卡片:记录模式(
econ、epi或ml-causal)、估计目标、识别设计、核心结果变量/处理变量、R 软件包系列以及所需产物。 - 有限范围的编辑:每次只更改一个决策(样本规则、估计量、聚类方式、导出格式或稳健性检查)。优先采用能够通过验证的最小补丁。
- 选择集划分准则:将用户当前遇到的问题或请求的产物视为选择集。至少保留一个备选结果变量、样本窗口、估计量系列或导出目标作为留出关卡。
- 留出关卡:运行代码前定义检查项:行数、
distinct()键唯一性、处理变量支持度、缺失值阈值、预期的表格/图表文件,以及至少一项非核心稳健性/规格检查,确保更改不会导致其失败。 - 拒绝缓冲区:如果候选规格未通过关卡,在
analysis_log.md中记录失败情况、R/Quarto 差异和关卡输出;恢复到上一个通过的规格,并且不要重试相同的未经检查模式。 - 慢速/元更新:任务结束时,根据执行过程写下
accepted_patterns和rejected_patterns。不要仅凭一次通过的运行就扩展标准项目模板。 - 仅在验证后推广:一次性修复只有通过当前数据以及至少一个备选结果变量/样本/规格的验证后,才能转为可复用的项目样板。
三种领域模式(默认 = AER 经济学;备选 = 流行病学和 ML 因果推断)
上面的默认操作手册采用 AER 风格的应用计量经济学——AEA 惯例:写出估计方程、识别假设、设计方案对比、完整的稳健性检验。此技能还提供了另外两种主要因果推断传统对应的并行子流程;它们都复用相同的步骤 1–4(清理/构造/表 1/诊断)和步骤 8(表格/图表)——只有步骤 5(估计器)和步骤 6/7 会切换套件:
| 模式 | 读者惯例 | 步骤 5 估计器栈 | 报告栈 | 跳转到 |
|---|---|---|---|---|
| 默认 — 应用经济学(AER / QJE / AEJ) | “展示方程 + 识别假设 + 设计方案对比;控制变量清晰可见;聚类标准误” | DID / IV / RD / SCM / 匹配 / fixest::feols HDFE | AER 风格的多列 modelsummary + kableExtra / gt / flextable + 8 节论文布局 | 步骤 1 → 8(下方完整操作手册) |
| 模式 A — 流行病学/公共卫生 | “STROBE / TRIPOD-AI;目标试验方案;双重稳健估计目标;绝对和相对风险;KM 生存分析” | 目标试验模拟 · IPTW(WeightIt / PSweight)· g-公式(gfoRmula)· TMLE(tmle / ltmle)· 孟德尔随机化(MendelianRandomization / TwoSampleMR / MRPRESSO)· KM / Cox / AFT(survival / survminer / flexsurv) | 相同的 modelsummary + 风险差/风险比/E-value 行 | §A. 流行病学流程 |
| 模式 B — ML 因果推断 | “DML / 元学习器 / 因果森林 / DR-learner;CATE 分布;策略价值” | DML(DoubleML)· S/T/X/R/DR-Learner(causalweight / grf)· GRF 因果森林(grf::causal_forest)· BART/BCF(bartCause / bcf)· 矩阵补全(MCPanel) | modelsummary ML 方案对比 + grf CATE 图 + 策略价值表 + conformalInference PI | §B. ML 因果推断流程 |
如何调用非默认模式(Claude / Agent 会根据用户的措辞选择模式):
| 用户说…… | 此技能切换到的模式 |
|---|---|
| “运行 DID / IV / RD / 事件研究”、“AER 表格”、“应用微观经济学” | 默认(AER 经济学)— 步骤 1 → 8 |
| “目标试验模拟”、“g-公式”、“IPTW”、“TMLE”、“孟德尔随机化”、“STROBE / TRIPOD”、“公共健康 / 流行病学”、“流行病学流程”、“RWE 研究”、“队列研究”、“病例对照” | 模式 A(流行病学)— §A |
| “DML”、“双重机器学习”、“因果森林”、“元学习器”、“CATE”、“BCF”、“policytree”、“策略学习”、“保形因果推断”、“公平性审计”、“ML 因果推断”、“提升建模”、“因果机器学习” | 模式 B(ML 因果推断)— §B |
| “混合”(例如“估计 DID,然后对异质性运行 ML CATE”) | 依次运行默认模式 + 模式 B——每个估计器都会生成一对系数 + 标准误,将它们全部放进一个 modelsummary(...),用于方案对比列 |
三种模式共用相同的步骤 1–4 清理/表 1/诊断框架、相同的步骤 8 导出栈,以及相同的 DAG 优先识别逻辑——切换模式只会改变你选择的步骤 5 估计器系列,不会改变周边的论文结构。如果你只需要描述性统计/表 1/平衡性检验,那么步骤 3 中的 AER gtsummary::tbl_summary / modelsummary::datasummary_balance 调用在三种模式下完全相同。
默认输出规范 — 经济学实证论文
此技能默认采用应用经济学论文惯例。除非用户明确要求只提供单个点估计,否则每次运行都会生成下方完整、可直接用于发表的输出集。将其视为步骤 8 的约定——必须执行,而非可选项。
必须生成的表格(始终生成)
| # | 表格 | R 来源 | 保存到 |
|---|---|---|---|
| T1 | 汇总统计与平衡性(处理组与对照组,含 SMD / p 值) | gtsummary::tbl_summary + add_p + add_difference(步骤 3) | tables/table1_balance.xlsx + .docx + .tex |
| T2 ★ | 主要结果——多列回归 M1→M6(逐步加入控制变量 + 固定效应) | fixest::feols × 6 个设定 → modelsummary(步骤 5–6) | tables/table2_main.xlsx + .docx + .tex |
| T3 | 机制 / 结果阶梯——相同处理变量,至少 3 个结果并列展示 | 循环对 y ∈ {Y1, Y2, Y3, Y_main} 运行 feols → modelsummary(步骤 7) | tables/table3_mechanism.xlsx + .docx + .tex |
| T4 | 异质性——子组 × 主要系数(性别、年龄、地区等) | 子组 feols × linearHypothesis → modelsummary(步骤 7) | tables/table4_heterogeneity.xlsx + .docx + .tex |
| T5 | 稳健性检验组——替代 SE / 聚类 / 样本 / 安慰剂,全部放在同一张表中 | feols × 不同变体 → modelsummary(步骤 6) | tables/table5_robustness.xlsx + .docx + .tex |
★ 表 2 是每篇经济学论文的核心。 这是一张多列回归表,展示从原始相关性(M1)到完全设定的研究设计(M6:双向固定效应 + 交互固定效应 + 聚类稳健 SE)的逐步过程。不要将其合并为单列。不要只报告核心系数。逐步变化本身就是可信度论证:如果 M1→M6 单调且稳定,那么该设计可能具有识别能力;如果加入固定效应后结果消失,那么这就是结果。
标准的 6 列,按以下顺序排列:
- M1 原始双变量回归(
feols(y ~ treat, data))- M2 + 人口统计变量(
+ age + edu)- M3 + 行业控制变量(
+ tenure / firm_size)- M4 + 个体固定效应(
| worker_id)- M5 + 双向固定效应(
| worker_id + year)- M6 + 交互固定效应(
| worker_id + year + industry^year),并设置cluster = ~ worker_id
必须生成的图表(始终生成)
| # | 图表 | R 来源 | 保存到 |
|---|---|---|---|
| F1 | 趋势 / 研究动机——处理组与对照组随时间的变化,含政策时间线 | dplyr 分组均值 → ggplot + geom_line(步骤 3) | figures/fig1_trend.png(300 dpi,必须导出 PNG)+ .pdf |
| F2 | 带 95% 置信区间的事件研究系数,基期为 –1 | fixest::sunab() / did::ggdid / iplot(步骤 5) | figures/fig2_event_study.png(300 dpi,必须导出 PNG)+ .pdf |
| F3 | M1→M6 不同设定的系数图 | modelsummary::modelplot()(步骤 8) | figures/fig3_coefplot.png(300 dpi,必须导出 PNG)+ .pdf |
| F4 | 稳健性 / 敏感性分析——bacondecomp::bacon 图、HonestDiD::createSensitivityPlot 或设定曲线 | 根据具体场景确定(步骤 6) | figures/fig4_sensitivity.png(300 dpi,必须导出 PNG)+ .pdf |
输出文件布局(默认)
project/
├── tables/ table1_balance.xlsx/.docx/.tex table2_main.xlsx/.docx/.tex
│ table3_mechanism.xlsx/.docx/.tex table4_heterogeneity.xlsx/.docx/.tex
│ table5_robustness.xlsx/.docx/.tex
└── figures/ fig1_trend.png(300dpi)+.pdf fig2_event_study.png(300dpi)+.pdf
fig3_coefplot.png(300dpi)+.pdf fig4_sensitivity.png(300dpi)+.pdf
关键输出规则(必须遵守):
- 图片格式:所有图片必须同时导出 PNG 格式(≥300 dpi) 和 PDF 格式(用于 LaTeX 排版)
- 表格格式:所有回归表格必须同时导出 Excel(.xlsx)、Word(.docx) 和 LaTeX(.tex) 三种格式
- PNG 用于幻灯片、Markdown 文档、邮件等场景;PDF 用于学术论文排版
何时偏离默认要求
- 单次快速估计——只生成相关单元格,但需提醒用户标准交付内容是上述完整集合,并主动提出运行完整流程。
- 研究设计不适用于某张图(横截面研究 → 无事件研究图)——跳过该图时,必须打印一条说明原因的
message();不得悄然省略。 - 处理组单位数 N=1(
Synth/synthdid)——将 F1/F2 替换为 SCM 轨迹图 + 安慰剂分布;T1–T5 仍然适用。
必需软件包
# Run once on a fresh R install:
install.packages(c(
# Data
"tidyverse", "haven", "readxl", "data.table", "janitor",
"naniar", "VIM", "mice", "validate",
# Description / tables
"gtsummary", "tableone", "modelsummary", "kableExtra", "gt",
"stargazer", "texreg", "flextable", "psych", "summarytools",
# Tests
"lmtest", "sandwich", "car", "tseries", "urca", "plm",
"clubSandwich", "fwildclusterboot",
# Modeling — workhorses
"fixest", # panel/IV/DID with HD FE — primary
"AER", # ivreg
"ivreg", # alternative IV
# Modern DID
"did", # Callaway–Sant'Anna
"didimputation", # Borusyak–Jaravel–Spiess
"fixest", # sunab() for Sun–Abraham
"synthdid", # Synthetic DID
"bacondecomp", "HonestDiD",
"DIDmultiplegtDYN", # de Chaisemartin–D'Haultfœuille
# RD
"rdrobust", "rddensity", "rdmulti",
# Synthetic control
"Synth", "gsynth", "tidysynth",
# Matching / weighting
"MatchIt", "WeightIt", "cobalt", "ebal",
# ML causal
"grf", "DoubleML",
# Mediation / SEM
"mediation", "lavaan",
# Robustness / inference
"robomit", # Oster delta
"ri2", "ritools", # randomization inference
"multcomp",
# Margins / post-estimation
"marginaleffects",
# Plotting
"ggplot2", "ggpubr", "cowplot", "patchwork",
"binsreg",
"ggdist", "ggrepel"
))
# fixest's iplot, esttex, etable are bundled.
8 个步骤——规范流程(对应 AER 论文各章节)
┌──────────────────────────────────────────────────────────────────────┐
│ Step −1 Pre-Analysis Plan (PAP) pwr / WebPower / DeclareDesign │
│ Step 0 Sample log + data contract sample_log/stopifnot/jsonlite │
│ Step 1 Data import & cleaning read_csv/read_dta/janitor/naniar/mice│
│ Step 2 Variable construction mutate/across/winsorize/lag/group_by │
│ Step 2.5 Empirical strategy equation × ID assumption + pre-reg │
│ Step 3 Descriptive statistics gtsummary/datasummary_balance/cor_pmat│
│ Step 3.5 Identification graphics iplot/binsreg/rdplot/cobalt/Synth │
│ Step 4 Diagnostic tests shapiro/bptest/dwtest/vif/adf/kpss │
│ Step 5 Baseline modeling feols/ivreg/att_gt/synthdid/MatchIt │
│ Step 6 Robustness battery bacondecomp/HonestDiD/fwildclusterboot│
│ Step 7 Further analysis marginaleffects/mediation/grf │
│ Step 8 Tables & figures modelsummary/iplot/ggplot2/cowplot │
└──────────────────────────────────────────────────────────────────────┘
这 8 个步骤对应应用类 AER / QJE / AEJ 论文的规范章节。每个步骤对应论文中的一个章节,并在磁盘上生成一份可直接用于论文的产物:
Paper section Step R moves
─────────────────────────── ───── ────────────────────────────────────────────────
Pre-Analysis Plan −1 pwr / WebPower / DeclareDesign + freeze pap.json
§1. Data 0 sample_log + 5-check stopifnot → JSON via jsonlite
§1. Data 1 haven::read_dta · janitor::clean_names · naniar/mice
§1. Data 2 mutate/across/Winsorize/lag/lead/diff · CPI deflate
§1.1 Descriptives (Table 1) 3 gtsummary::tbl_summary · datasummary_balance
§2. Empirical Strategy 2.5 write equation + ID assumption → strategy.md
§3. Identification graphics 3.5 fixest::iplot · binsreg · rdplot · cobalt::love.plot · Synth
§3.5 Diagnostics 4 bptest · dwtest · car::vif · urca::ur.df · phtest
§4. Main Results (Table 2) 5 fixest::feols progressive (m1...m6) · modelsummary
§5. Heterogeneity (Table 3) 7 feols(... + i(.):X) · marginaleffects::avg_slopes
§6. Mechanisms / Channels 7 mediation::mediate · lavaan · outcome ladder
§7. Robustness gauntlet 6 bacondecomp · HonestDiD · robomit · fwildclusterboot · ri2
§8. Replication package 8 modelsummary("...tex") · gt → docx · result.json
以下是每个步骤的规范调用。所有示例都使用同一条贯穿全文的叙事线——劳动经济学面板数据,其中 training(处理变量)影响 log_wage(结果变量),协变量为 age、edu、tenure,面板键为 worker_id/firm_id/year。变量名和参数值均为示例。
当某个步骤有多种变体(5 种交错实施 DID 估计量;4 种异质性检验)时,SKILL.md 会介绍首选方案;更深入的变体见
references/NN-<topic>.md。
按章节列出的论文级图表清单(需要制作的内容)
一篇现代 AER 论文通常包含 5–7 张图和 3–5 张主表,以及一张附录稳健性表。下面的每一步都会在磁盘上至少生成一个带编号的文件。默认文件名假设同时导出 .tex / .docx / .xlsx(Agent 应生成这三种格式,以便合作者在 Word 中编辑、构建系统使用 LaTeX,以及编辑在 Excel 中修改原始数值)。所有图片必须同时保存为 PNG(≥300 dpi)和 PDF 两种格式。
| § | 文件 | R 原语 | 文件名 |
|---|---|---|---|
| §1 | 图 1:原始趋势 / 处理推广 | df %>% group_by(year, treat) %>% summarise(mean(y)) %>% ggplot() | figures/fig1_trend.png(300dpi)+.pdf |
| §1 | 表 1:汇总统计量(总体 / 处理组 / 对照组 + Δ + SMD) | gtsummary::tbl_summary · modelsummary::datasummary_balance | tables/table1_balance.xlsx/.docx/.tex |
| §3 | 图 2:识别图示(事件研究 / 第一阶段 / McCrary / RD 散点图 / SCM 轨迹) | fixest::iplot(es) · binsreg · rdrobust::rdplot · rddensity · Synth::path.plot | figures/fig2_event_study.png(300dpi)+.pdf |
| §4 | 表 2:主要结果——逐步增加控制变量 M1→M6 | modelsummary(list("(1)"=m1,...,"(6)"=m6)) · fixest::etable | tables/table2_main.xlsx/.docx/.tex |
| §4 | 表 2-bis:设计方法比较(OLS / IV / DID / DML) | modelsummary(list("OLS"=ols, "2SLS"=iv, "CS-DID"=cs, "DML"=dml)) | tables/table2b_designs.xlsx/.docx/.tex |
| §4 | 图 3:不同规格下的系数图 | modelplot(list(m1,...,m6), coef_map="training") | figures/fig3_coefplot.png(300dpi)+.pdf |
| §5 | 表 3:分组异质性 | modelsummary(g_full, g_male, g_fem, g_q1, ..., g_q4) | tables/table3_heterogeneity.xlsx/.docx/.tex |
| §5 | 图 4:剂量反应 / CATE | marginaleffects::plot_predictions · grf::plot.causal_forest | figures/fig4_cate.png(300dpi)+.pdf |
| §6 | 表 4:机制 / 结果指标序列 | 对各结果变量循环运行 feols → modelsummary | tables/table4_mechanism.xlsx/.docx/.tex |
| §7 | 表 A1:稳健性汇总表(每项检验占一列) | modelsummary(list(base, no99, balpan, dropearly, wfe, cl2way, logy, ihsy, psm, ebal)) | tables/tableA1_robustness.xlsx/.docx/.tex |
| §7 | 图 5:规格曲线 | specr::specr() + plot_specs(或手动编写 purrr::pmap) | figures/fig5_spec_curve.png(300dpi)+.pdf |
| §7 | 图 6:敏感性分析(HonestDiD / Oster / E-value) | HonestDiD::createSensitivityPlot · robomit::o_test · EValue | figures/fig6_sensitivity.png(300dpi)+.pdf |
| §8 | 复现套件:将所有表格汇集到一份文档中 | modelsummary(..., output="docx") · gt::gtsave() · Quarto / Rmd | replication/paper_tables.xlsx/.docx/.tex |
上述每个 R 估计器(
fixest::feols/AER::ivreg/did::att_gt/grf::causal_forest/synthdid_estimate)都会返回一个结果对象,可直接传给modelsummary(...)/modelplot(...)/etable(...)。不要用kable()手动编写 LaTeX,也不要直接通过flextable渲染 Word——modelsummary、etable和gtsummary会自动应用三线表边框、AER 星号和正确的标准误标签。如需了解更深入的导出方法,请参阅references/08-tables-plots.md。
导出指南 — 在一个区块中导出 LaTeX / Word / Excel
关键规则(必须遵守):每个表格必须同时导出三种格式——Excel(.xlsx)、Word(.docx)、LaTeX(.tex)。每个图片必须同时保存PNG(≥300dpi)和PDF两种格式。
R 在三种语言中拥有最完善的出版级表格生态系统。分为三个层级,按范围选择:
| 层级 | 适用场景 | API | 常用参数 |
|---|---|---|---|
| 1. 单个多列式表格 | 导出一个包含渐进式列的表 2 / 表 3 / 表 A1 | `modelsummary(list("(1)"=m1,...,"(N)"=mN), output="tables/tab.tex", stars=c(""=.1,""=.05,""=.01), gof_omit="BIC | AIC |
| 2. 多面板论文格式(表 2 + 表 3 + 表 A1 + 表 A2 合并为一个文件) | 生成论文表格区块——将主结果、异质性分析、稳健性分析和安慰剂检验整合到一个文档中 | 将 modelsummary 与 gt::gt_group() 链式组合,以生成带有分节标题的单个文档;或者使用 Quarto .qmd,在文字内容之间渲染多个 modelsummary 调用 | gt_group(modelsummary(...), modelsummary(...)) · quarto render paper.qmd |
3. 完整会话包(相当于 Stata 的 collect / Python 的 Stargazer + pylatex) | 将汇总统计、平衡性检验、多个回归表、标题和文字内容合并到一个文件中的复现附录 | Quarto 是 R 原生的现代解决方案。master.qmd 在文字内容之间穿插生成 modelsummary / gtsummary / ggplot2 输出的代码块;一次 quarto render 即可生成 .pdf / .docx / .html | YAML 前置元数据通过 format: [pdf, docx, html] 设置三种输出格式 |
期刊格式——选择合适的 stars 和标准误标签。 AEA 惯例是 c("*"=.1, "**"=.05, "***"=.01),并使用 notes = "Cluster-robust standard errors in parentheses..."。在 master.R 顶部定义一个包装函数:
# Top of master.R — journal house-style wrapper
# 输出三格式:.xlsx(编辑)、.docx(Word)、.tex(LaTeX)
aer_table <- function(models, output, headers = NULL, coef_map = NULL) {
base <- tools::file_path_sans_ext(output)
for (ext in c(".xlsx", ".docx", ".tex")) {
output_file <- paste0(base, ext)
fmt <- if (ext == ".xlsx") "html" else if (ext == ".docx") "docx" else "latex"
modelsummary(
models,
output = output_file,
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
gof_omit = "BIC|AIC|F|Log|Adj",
coef_map = coef_map,
notes = paste("Cluster-robust standard errors in parentheses.",
"* p<0.10, ** p<0.05, *** p<0.01."),
output_format = fmt
)
}
}
多面板 .docx / .xlsx 和 Quarto 指南(单文件论文表格包)请参阅 references/08-tables-plots.md。
步骤 −1 — 预分析计划(接触数据前;AEA RCT Registry 风格)
在接触数据之前,先写下 (a) 总体、(b) 研究设计,以及 (c) 在计划样本量和 α=0.05、β=0.20 条件下的最小可检测效应(MDE)。将结果保存为 pap.json,以便审稿人确认研究设计在看到数据之前就已具备足够的统计功效,而不是之后才如此。
library(pwr) # classical power calculations
library(WebPower) # cluster RCT, longitudinal, mixed designs
library(jsonlite)
# Two-sample MDE for a continuous outcome (Cohen's d framing)
pwr.t.test(d = 0.20, power = 0.80, sig.level = 0.05,
type = "two.sample", alternative = "two.sided")
# → required n per arm
# Solve for MDE given fixed n
pwr.t.test(n = 2000, power = 0.80, sig.level = 0.05,
type = "two.sample")$d
# → minimum detectable Cohen's d
# Cluster-randomized RCT — design effect
# Solve via WebPower::wp.crt2arm(...) for clusters / per-cluster size / power triangle
WebPower::wp.crt2arm(f = 0.20, J = NULL, n = 50, icc = 0.05, power = 0.80,
alpha = 0.05, alternative = "two.sided")
# → required clusters per arm
# DID power (Frison-Pocock / Bloom 1995): use WebPower::wp.kanova() or simulate
# RD power: simulate via DeclareDesign — see references/05-modeling.md §5.5
# Persist the protocol — referee will ask whether design was powered ex ante
pap <- list(
population = "manufacturing workers, 2010–2020",
treatment = "training (binary, staggered adoption)",
outcome = "log_wage",
estimand = "ATT",
design = "staggered DID, Callaway-Sant'Anna",
alpha = 0.05,
power_target = 0.80,
mde_d = 0.20,
n_planned = 12000,
frozen_at = "2026-01-15T09:00:00Z",
git_sha = "<paste>"
)
write_json(pap, "artifacts/pap.json", pretty = TRUE, auto_unbox = TRUE)
如需更丰富的、考虑 DAG 的功效分析(写下 DAG、声明估计目标、模拟研究设计),请使用 DeclareDesign——它是 R 原生的 EGAP 预分析流程等效方案。
在步骤 1 之前,将 artifacts/pap.json 提交到代码库。AEA RCT Registry / OSF 预注册工具会将其作为分析计划附件接受。
步骤 0 — 样本构建日志与五项检查数据契约
AER §1 数据部分有三项任务:(a) 描述数据来源,(b) 记录所有样本限制(即“脚注 4”样本日志),(c) 锁定面板结构。
0.1 样本构建日志(脚注 4)
library(tidyverse); library(jsonlite)
sample_log <- tibble::tibble(step = character(), n = integer())
df_raw <- read_dta("raw/panel.dta") %>% janitor::clean_names()
sample_log <- sample_log %>% add_row(step = "0. raw", n = nrow(df_raw))
df1 <- df_raw %>% drop_na(wage)
sample_log <- sample_log %>% add_row(step = "1. drop missing wage", n = nrow(df1))
df2 <- df1 %>% filter(between(age, 18, 65))
sample_log <- sample_log %>% add_row(step = "2. drop age outside 18-65", n = nrow(df2))
df3 <- df2 %>% filter(industry %in% c("manuf", "construction", "transport"))
sample_log <- sample_log %>% add_row(step = "3. keep target industries", n = nrow(df3))
df <- df3
print(sample_log)
write_json(sample_log, "artifacts/sample_construction.json", pretty = TRUE)
将打印出的 tibble 原样粘贴为论文脚注 4。
0.2 五项检查数据契约(继续 / 停止关卡)
library(validate); library(assertr)
data_contract <- function(df, y, treatment, id = NULL, time = NULL, covariates = c()) {
keys <- c(y, treatment, id, time, covariates)
contract <- list(
n_obs = nrow(df), # 1. shape
dtypes = sapply(df[keys], function(x) class(x)[1]), # 2. dtypes
n_missing = sapply(df[keys], function(x) sum(is.na(x))), # 3. missingness
n_dupes_on_keys = if (!is.null(id) && !is.null(time))
sum(duplicated(df[, c(id, time)])) else 0, # 4. duplicates
panel_balanced = NULL,
cohort_sizes = NULL
)
if (!is.null(id) && !is.null(time)) {
bal <- df %>% count(.data[[id]])
contract$panel_balanced <- all(bal$n == max(bal$n)) # 5. balance
contract$n_dropped_by_balance <- sum(bal$n != max(bal$n))
if ("first_treat" %in% names(df)) {
contract$cohort_sizes <- df %>% distinct(.data[[id]], .keep_all = TRUE) %>%
count(first_treat) %>% deframe()
}
}
contract$y_range <- range(df[[y]], na.rm = TRUE)
contract$treatment_share <- mean(df[[treatment]], na.rm = TRUE)
# MCAR sniff test (Rubin) — if missing(y) is associated with covariates,
# listwise deletion biases the estimate. Use mice / IPW instead.
miss_y <- is.na(df[[y]])
contract$mcar_hint <- "likely MCAR (listwise OK)"
if (any(miss_y) && any(!miss_y)) {
for (cov in covariates) {
if (is.numeric(df[[cov]])) {
p <- t.test(df[[cov]][miss_y], df[[cov]][!miss_y])$p.value
if (p < 0.05) {
contract$mcar_hint <- sprintf("NOT MCAR (y-miss differs on %s, p=%.3f) → use mice / IPW",
cov, p)
break
}
}
}
}
contract
}
contract <- data_contract(df, y = "wage", treatment = "training",
id = "worker_id", time = "year",
covariates = c("age", "edu", "tenure"))
stopifnot(contract$n_dupes_on_keys == 0)
stopifnot(all(contract$n_missing == 0))
write_json(contract, "artifacts/data_contract.json",
pretty = TRUE, auto_unbox = TRUE)
如果任何 stopifnot 被触发,立即停止,先在 dplyr 中修复。R 的估计器会在后续步骤中静默删除 NA 行——这份契约是防范审稿人提出“为什么 N 从表 1 的 12,000 降到表 2 的 9,800?”之类问题的最低成本保障。
步骤 1 — 数据导入与清理
更深入的模式请参阅:references/01-data-cleaning.md——涵盖所有格式(haven/readxl/data.table::fread/arrow::read_parquet/DBI)、janitor::clean_names、naniar 缺失情况可视化、使用 mice 对 MCAR/MAR/MNAR 进行分类,以及使用 validate/assertr 进行验证和面板结构检查。
library(tidyverse)
library(haven) # .dta / .sav / .sas7bdat
library(janitor) # clean_names()
library(naniar) # missing-data viz
library(skimr) # one-line dataset summary
# 1a. Load + first look
df <- read_dta("raw/panel.dta") %>%
clean_names() # standardize to snake_case
skim(df) # rich one-line-per-var summary
naniar::miss_var_summary(df)
naniar::vis_miss(df) # missingness heatmap
# 1b. Dtypes
df <- df %>%
mutate(
year = as.integer(year),
wage = as.numeric(wage),
gender = as.factor(gender),
date = as.Date(date)
)
# 1c. Missing values — decide PER VARIABLE
key_vars <- c("wage", "training", "worker_id", "year")
df <- df %>%
drop_na(all_of(key_vars))
cat("After dropping NA on keys:", nrow(df), "rows\n")
df <- df %>%
mutate(
tenure_missing = is.na(tenure),
tenure = if_else(is.na(tenure), median(tenure, na.rm = TRUE), tenure),
union = fct_explicit_na(as.factor(union), na_level = "unknown")
)
# 1d. Outliers — flag, don't drop yet
df <- df %>%
mutate(wage_z = scale(wage)[,1],
outlier_z4 = abs(wage_z) > 4)
cat("|z|>4 on wage:", sum(df$outlier_z4, na.rm = TRUE), "\n")
# 1e. Deduplicate panel key
stopifnot(nrow(df %>% distinct(worker_id, year)) == nrow(df))
# 1f. Merge with assertion
firm_chars <- read_dta("raw/firm_chars.dta")
n_before <- nrow(df)
df <- df %>%
left_join(firm_chars, by = "firm_id", relationship = "many-to-one")
stopifnot(nrow(df) == n_before) # no row inflation
# 1g. Panel structure
df %>% count(year) # per-year
df %>% count(worker_id) %>% summary() # per-unit
核心原则:使用 dplyr + 明确的 stopifnot() 断言。后续步骤中不得静默删除行。
步骤 2 — 变量构造与转换
深入模式:references/02-data-transformation.md — 通过 MASS::boxcox 进行对数/IHS/Box–Cox 转换,使用 dplyr 进行分组缩尾处理,使用 scale() 和 bestNormalize,因子处理,使用 dplyr::lag 进行滞后/超前处理,面板数据时间设定。
library(DescTools) # Winsorize()
df <- df %>%
mutate(
# 2a. Log / IHS
log_wage = log(pmax(wage, 1)),
ihs_assets = asinh(assets),
# 2b. Winsorize 1/99
wage_w1 = DescTools::Winsorize(wage, probs = c(0.01, 0.99), na.rm = TRUE),
# 2c. Standardize
age_std = as.numeric(scale(age)),
# 2d. Polynomial / interaction (or use formula syntax in fixest)
age_sq = age^2,
trt_x_edu = training * edu
) %>%
# 2e. Within-group winsorize
group_by(industry, year) %>%
mutate(wage_w1_iy = DescTools::Winsorize(wage, probs = c(0.01, 0.99),
na.rm = TRUE)) %>%
ungroup() %>%
# 2f. Panel operators (always arrange first to make lag deterministic)
arrange(worker_id, year) %>%
group_by(worker_id) %>%
mutate(
log_wage_l1 = lag(log_wage, 1),
log_wage_f1 = lead(log_wage, 1),
d_log_wage = log_wage - lag(log_wage, 1),
wage_mean_i = mean(log_wage, na.rm = TRUE),
log_wage_dm = log_wage - wage_mean_i
) %>%
ungroup() %>%
# 2g. Staggered-DID timing
group_by(worker_id) %>%
mutate(first_treat = ifelse(any(training == 1),
min(year[training == 1]), NA_real_)) %>%
ungroup() %>%
mutate(rel_time = year - first_treat,
never_treated = is.na(first_treat))
# 2h. CPI deflation
cpi <- read_csv("raw/cpi.csv")
df <- df %>%
left_join(cpi, by = "year") %>%
mutate(cpi_base = cpi[year == 2010][1],
wage_real = wage * cpi_base / cpi,
log_wage_real = log(pmax(wage_real, 1)))
步骤 2.5 — 实证策略(写出方程和识别假设)
这是 AER 论文的核心。编写任何代码之前,先明确写出方程并陈述识别假设。含糊的识别表述是审稿人拒绝应用论文最常见的原因。将策略保存为 strategy.md,使其成为带日期且受版本控制的文档——而不是看到系数后才写下的事后合理化解释。
方程 × 识别假设 × R 估计器(决策表)
| 设计 | 估计方程 | 识别假设 | R 估计器 |
|---|---|---|---|
| 2×2 DID | Y_it = α_i + λ_t + β·D_it + X'γ + ε_it | 条件于 X 的平行趋势 | `feols(y ~ i(treated, post, ref=0) |
| 事件研究(CS / SA) | Y_it = α_i + λ_t + Σ_{e≠-1} β_e · 1{t-G_i = e} + ε_it | 无预期效应 + 组别—时间平行趋势 | `feols(y ~ sunab(G, t) |
| 2SLS | Y_i = α + β·D_i + X'γ + ε_i; D_i = π·Z_i + X'δ + u_i | 排除性 + 相关性 + 单调性 | `feols(y ~ X |
| 尖锐 RD | Y_i = α + β·1{X_i ≥ c} + f(X_i) + ε_i(局部多项式) | E[Y(0)|X] 在 c 处连续,且不存在操纵 | rdrobust::rdrobust(y, x, c=0)(+ rddensity) |
| SCM | Ŷ_1t(0) = Σ_j ŵ_j Y_jt,τ_t = Y_1t − Ŷ_1t(0),其中 t≥T_0 | 处理前拟合 + 插值有效性 | Synth::synth · gsynth::gsynth · synthdid::synthdid_estimate · tidysynth |
| 可观测变量选择(匹配/IPW/DML) | Y_i = m(X_i) + β·D_i + ε_i(Robinson 部分化) | 无混杂 + 重叠性 | MatchIt::matchit + lm · WeightIt · DoubleML::DoubleMLPLR · grf::causal_forest |
设计选择器(用户不确定时)
┌─ running var + cutoff ───────────────── RDD (rdrobust)
│
├─ exogenous instrument Z ─────────────── IV/2SLS (feols / AER::ivreg)
data + question ─┤
├─ pre/post × treat/control ─┬ 2 periods ── 2×2 DID (feols + i())
│ └ staggered ── CS / SA / BJS (att_gt / sunab / did_imputation)
│
├─ 1 treated unit + donor pool + long pre ── SCM (Synth / gsynth / synthdid)
│
├─ high-dim X, selection-on-observables ── ML causal (DoubleML / grf — see §B)
│
└─ none of the above ──────────────────── matching + sensitivity (MatchIt + EValue)
预注册 strategy.md 模板
strategy <- "\\
# Empirical Strategy (pre-registration)
**Frozen**: 2026-01-15 (Git SHA: <paste>)
**Population**: manufacturing workers, 2010–2020, balanced panel
**Treatment**: training (binary, staggered adoption)
**Outcome**: log_wage (CPI-deflated 2010 USD)
**Estimand**: ATT on the treated, dynamic horizon -4..+4
## Estimating equation (paste from §2.5 row that matches the design)
log_wage_it = α_i + λ_t + Σ_{e≠-1} β_e · 1{t - G_i = e} + ε_it
## Identifying assumption
1. No anticipation: E[Y_it(0) | t < G_i] = E[Y_it(0) | never-treated]
2. Group-time PT: Δ E[Y_it(0)] is the same across treatment cohorts
## Auto-flagged threats (must defend in §2)
- Selection of G_i on Y_i(0) → bacondecomp + HonestDiD sensitivity
- Spillover within firm → cluster at firm_id, also try firm_id × year
- Anticipation in pre-period → include lead in event study
## Fallback estimators (Step 6 robustness)
- Sun–Abraham via `feols(y ~ sunab(G, t) | i + t, data)`
- Borusyak-Jaravel-Spiess via `didimputation::did_imputation`
- Synthetic DID via `synthdid::synthdid_estimate`
"
writeLines(strategy, "artifacts/strategy.md")
在运行步骤 5 / 步骤 6 之前,将 artifacts/strategy.md 提交到仓库。该文件的 git log 就是分析计划。
步骤 3 — 描述性统计与表 1
深入模式:references/03-descriptive-stats.md — gtsummary::tbl_summary(现代表 1 标准)、使用 SMD 的 modelsummary::datasummary_balance、tableone::CreateTableOne、通过 corrplot / psych::corr.test 计算并检验显著性的相关矩阵,以及通过 ggplot2 绘制分布图。
library(gtsummary)
library(modelsummary)
# 3a. Full-sample summary — one line, publication ready
df %>%
select(log_wage, age, edu, tenure, training) %>%
datasummary_skim()
# Or
df %>%
select(log_wage, age, edu, tenure, training) %>%
tbl_summary(
type = list(all_continuous() ~ "continuous2"),
statistic = all_continuous() ~ c("{N_nonmiss}", "{mean} ({sd})",
"{min} – {median} – {max}")
) %>%
bold_labels() %>%
as_kable_extra() %>%
kableExtra::save_kable("tables/table1_full.tex")
# 3b. Stratified Table 1 (treated vs control, with SMDs + p-values)
df %>%
select(log_wage, age, edu, tenure, female, training) %>%
tbl_summary(by = training, missing = "ifany") %>%
add_p() %>%
add_difference() %>%
add_n() %>%
modify_header(label = "**Variable**") %>%
bold_labels() %>%
as_gt() %>%
gt::gtsave("tables/table1_balance.html")
# Or via modelsummary (writes LaTeX/Word/HTML)
datasummary_balance(~ training,
data = df %>% select(training, age, edu, tenure, female),
output = "tables/table1_balance.tex")
# 3c. Correlation matrix with stars
library(corrplot); library(psych)
corr_obj <- corr.test(df %>% select(log_wage, age, edu, tenure, training),
method = "pearson")
corrplot(corr_obj$r, method = "color", type = "upper",
p.mat = corr_obj$p, sig.level = 0.05, insig = "blank",
addCoef.col = "black", number.cex = 0.7,
tl.col = "black", tl.srt = 45,
col = colorRampPalette(c("#B2182B","white","#2166AC"))(200))
# 3d. Distribution plots
library(ggplot2)
p1 <- ggplot(df, aes(log_wage, fill = factor(training))) +
geom_density(alpha = 0.5) +
scale_fill_manual(values = c("0" = "darkred", "1" = "navy"),
labels = c("Control", "Treated"), name = "") +
labs(x = "Log wage", y = "Density",
title = "Log-wage density by treatment") +
theme_classic()
p2 <- ggplot(df, aes(sample = log_wage)) +
stat_qq() + stat_qq_line() +
labs(title = "Normal Q-Q") + theme_classic()
cowplot::plot_grid(p1, p2, labels = "auto") %>%
ggsave("figures/distributions.pdf", plot = ., width = 10, height = 4)
# 3e. Time-trend (DID motivation)
df %>%
group_by(year, training) %>%
summarise(mean_log_wage = mean(log_wage, na.rm = TRUE), .groups = "drop") %>%
ggplot(aes(year, mean_log_wage, color = factor(training))) +
geom_line(linewidth = 1) + geom_point(size = 2) +
geom_vline(xintercept = policy_year, linetype = "dashed") +
scale_color_manual(values = c("0" = "darkred", "1" = "navy"),
labels = c("Control","Treated"), name = "") +
labs(x = "Year", y = "Mean log wage") + theme_classic()
ggsave("figures/trend_did.pdf", width = 7, height = 4)
步骤 3.5 — 识别图形(“识别,图形证据”章节)
AER 惯例:识别图先于回归表。 在要求读者相信点估计之前,应先让他们看到图形证据,证明平行趋势成立/第一阶段足够强/RD 跳跃清晰。
3.5.1 事件研究图 + 数值前趋势检验(DID 识别)
处理前系数 ≈ 0(以 −1 期为参照期并标准化为 0)是平行趋势的可视化证据。将图形与数值前趋势检验配对,免得审稿人只能凭目测判断。
library(fixest); library(ggplot2)
# (a) Sun-Abraham via fixest::sunab — the modern primary for staggered DID
es <- feols(log_wage ~ sunab(first_treat, year) | worker_id + year,
data = df, cluster = ~ worker_id)
# (b) Coefficient figure
iplot(es,
xlab = "Years relative to treatment",
ylab = "Coefficient (ATT, 95% CI)",
main = "Figure 2a. Event-study coefficients (95% CI; ref. e = -1)")
ggsave("figures/fig2a_event_study.pdf", width = 7, height = 4)
ggsave("figures/fig2a_event_study.png", width = 7, height = 4, dpi = 300)
# (c) Numerical pre-trends Wald test (joint zero on the leads)
pre_idx <- grep("year::-", names(coef(es)))[!grepl("ref", names(coef(es)))]
W <- wald(es, names(coef(es))[pre_idx])
cat(sprintf("Pre-trends Wald χ² = %.2f, p = %.3f\n", W$stat, W$p))
# (d) Bacon decomposition (Goodman-Bacon 2021) — TWFE diagnostic
library(bacondecomp)
bd <- bacon(log_wage ~ training, data = df,
id_var = "worker_id", time_var = "year")
ggplot(bd, aes(weight, estimate, color = type, shape = type)) +
geom_point(size = 2) +
labs(title = "Figure 2a-bis. Goodman-Bacon decomposition",
x = "Weight", y = "Estimate")
ggsave("figures/fig2a_bacon.pdf", width = 7, height = 4)
# (e) Callaway-Sant'Anna dynamic ATT (when att_gt is the main estimator)
library(did)
cs <- att_gt(yname = "log_wage", tname = "year", idname = "worker_id",
gname = "first_treat", data = df,
control_group = "nevertreated", est_method = "dr",
clustervars = "firm_id")
ggdid(aggte(cs, type = "dynamic")) +
labs(title = "Figure 2a-ter. Dynamic ATT (Callaway-Sant'Anna)")
ggsave("figures/fig2a_csdid.pdf", width = 7, height = 4)
3.5.2 第一阶段 F 统计量 + 散点图(IV 识别)
经验法则:OLS 式推断要求第一阶段 F ≥ 10;AR 等效推断要求 F ≥ 23(Stock–Yogo / Lee 2022)。fixest::feols 会自动报告 F;AER::ivreg 则需要使用 summary(..., diagnostics = TRUE)。
iv <- feols(log_wage ~ age + edu | training ~ Z1 + Z2,
data = df, cluster = ~ firm_id)
summary(iv, stage = 1)
fitstat(iv, ~ ivf + ivwald + sargan + cd) # CD / KP / Sargan / first-stage F
# Binscatter for the first-stage scatter (residualized on age + edu)
library(binsreg)
binsreg(y = df$training, x = df$Z1, w = df[, c("age","edu")],
nbins = 20, polyreg = 2, ci = c(3, 3))
ggsave("figures/fig2b_first_stage.pdf", width = 7, height = 4)
3.5.3 RD:McCrary 密度检验 + 规范 RD 图
RD 的标志性图形是 rdplot(CCT 风格的分箱散点图,两侧分别拟合局部多项式),并配合 McCrary 操纵检验。
library(rdrobust); library(rddensity)
# (a) Canonical RD plot — binned means + local poly on each side
rdplot(y = df$outcome, x = df$running_var, c = 0,
p = 4, kernel = "triangular", binselect = "esmv",
title = "Figure 2c. RD plot")
ggsave("figures/fig2c_rdplot.pdf", width = 7, height = 4)
# (b) McCrary density (Cattaneo-Jansson-Ma 2018)
rdd <- rddensity(X = df$running_var, c = 0)
print(summary(rdd))
rdplotdensity(rdd, X = df$running_var,
title = "Figure 2c-bis. McCrary density (manipulation test)")
ggsave("figures/fig2c_mccrary.pdf", width = 7, height = 4)
3.5.4 匹配:love 图(匹配前后的标准化差异)
library(MatchIt); library(cobalt)
m.out <- matchit(training ~ age + edu + tenure + firm_size,
data = df, method = "nearest", ratio = 1)
love.plot(m.out, threshold = 0.10,
var.order = "unadjusted", abs = TRUE,
title = "Figure 2d. Love plot — |SMD| pre vs post matching")
ggsave("figures/fig2d_loveplot.pdf", width = 7, height = 4)
3.5.5 SCM:合成控制轨迹图 + 差距图
对于合成控制设计,规范的图 2 是处理组与合成组的时间序列图,并标注处理时间。
library(tidysynth)
sc <- df %>%
synthetic_control(outcome = log_wage, unit = unit_id, time = year,
i_unit = "treated_unit_name", i_time = 2015) %>%
generate_predictor(time_window = 2010:2014,
mean_age = mean(age, na.rm = TRUE),
mean_edu = mean(edu, na.rm = TRUE)) %>%
generate_weights() %>% generate_control()
plot_trends(sc); ggsave("figures/fig2e_synth_trajectory.pdf", width = 7, height = 4)
plot_differences(sc); ggsave("figures/fig2e_synth_gap.pdf", width = 7, height = 4)
# Synthetic DID
library(synthdid)
sdid_setup <- panel.matrices(df, unit = "worker_id", time = "year",
outcome = "log_wage", treatment = "training")
sdid_fit <- synthdid_estimate(sdid_setup$Y, sdid_setup$N0, sdid_setup$T0)
plot(sdid_fit, control.name = "Synthetic DiD")
ggsave("figures/fig2e_sdid.pdf", width = 7, height = 4)
特定于识别策略的检查(DID 的 PT、弱 IV 的 F 值、RD 的密度、匹配的共同支撑)也会在第 5 步估计器内部自动运行——这里不要重复计算数值,但务必生成图表:审稿人会先查看图表。
第 4 步——诊断性统计检验
更多模式:references/04-statistical-tests.md——涵盖所有经典检验。lmtest/sandwich/car/tseries/urca/plm。
library(lmtest)
library(sandwich)
library(car)
library(tseries)
library(urca)
# Fit baseline OLS for diagnostics
ols <- lm(log_wage ~ training + age + edu + tenure, data = df)
# 4a. Normality of residuals
shapiro.test(sample(residuals(ols), min(5000, length(residuals(ols)))))
tseries::jarque.bera.test(residuals(ols))
# 4b. Heteroskedasticity
bptest(ols) # Breusch-Pagan
bptest(ols, ~ I(fitted(ols)^2) + ., data = df) # White-style
# 4c. Autocorrelation (time series / panel)
dwtest(ols) # Durbin-Watson
bgtest(ols, order = 4) # Breusch-Godfrey
Box.test(residuals(ols), lag = 8, type = "Ljung-Box")
# Panel-specific
library(plm)
pdata <- pdata.frame(df, index = c("worker_id", "year"))
plm_fe <- plm(log_wage ~ training + age + edu, data = pdata, model = "within")
pbgtest(plm_fe) # Wooldridge serial correlation
pcdtest(plm_fe, test = "cd") # Pesaran cross-sectional dependence
# 4d. Multicollinearity
vif(ols) # VIFs
kappa(model.matrix(ols), exact = TRUE) # condition number
# 4e. Stationarity (time series — assumes a single y over time)
adf.test(df$log_wage, k = 4) # ADF
kpss.test(df$log_wage, null = "Level") # KPSS
# 4f. Hausman (FE vs RE)
plm_re <- plm(log_wage ~ training + age + edu, data = pdata, model = "random")
phtest(plm_fe, plm_re)
# 4g. Specification — RESET
resettest(ols, power = 2:3, type = "fitted")
决策表:
| 检验 | 原假设 | 拒绝原假设时的操作 |
|---|---|---|
shapiro.test / jarque.bera.test | 残差服从正态分布 | 如果 N 较小,则使用 Bootstrap 置信区间 |
bptest | 同方差 | 使用 HC3:coeftest(ols, vcov = vcovHC(ols, "HC3")),或使用聚类 |
dwtest / bgtest | 不存在自相关 | 使用 HAC 标准误(vcovHAC)或按单位聚类 |
pbgtest(面板) | 不存在面板自相关 | 按实体聚类 |
pcdtest | 不存在截面相关性 | 使用 Driscoll–Kraay(vcovDC) |
vif > 10 | — | 删除或合并 |
| ADF 拒绝 + KPSS 不拒绝 | 平稳 | 使用水平值 |
| ADF 不拒绝 | 单位根 | 一阶差分 |
phtest | RE 一致 | 使用 FE |
第 5 步——基准实证建模(第 4 节:主要结果)
更多模式:references/05-modeling.md——涵盖所有估计器。fixest 是主力工具。
这是应用论文中最为密集的部分。现代 AER 第 4 节通常包含 2–3 个多回归表和一张系数图:
- 表 2(主要结果):逐步加入控制变量,4–6 列——见下文模式 A
- 表 2-bis(设计方法比较):OLS / IV / DID / DML 下的同一系数——见模式 B
- 表 2-ter(多结果变量):相同处理,对多个结果变量并排展示——见模式 C
- 图 3(系数图):跨设定直观概括 β̂ 和 95% 置信区间
估计器选择(请牢记——选错可能会悄无声息地产生荒谬结果):
- 无 FE / 单个低维 FE →
feols(y ~ X, data, cluster = ~i)- 高维 FE →
feols(y ~ X | fe1 + fe2, data, cluster = ~i)- 双向聚类 →
feols(..., cluster = ~ firm_id + year)- 2SLS / IV →
feols(y ~ X | D ~ Z, data, cluster = ~ firm_id)(或使用AER::ivreg进行诊断)- DID / 事件研究 →
feols(y ~ sunab(G, t) | i + t, data)(SA)·did::att_gt(CS)·didimputation::did_imputation(BJS)
按识别策略选择:
Cross-section, selection on observables → feols | MatchIt + lm | WeightIt
Panel + policy shock + parallel trends → feols / did::att_gt / sunab / didimputation / synthdid
Exogenous instrument → feols(... | endog ~ z) | AER::ivreg
Discontinuity → rdrobust + rddensity + rdmc
N=1 treated, long panel → Synth / gsynth / synthdid
Selection on observables + heterogeneity → WeightIt + cobalt; grf::causal_forest
Binary outcome → feglm or glm(family=binomial)
Count outcome → fepois
规范调用(下文的八种模式 A–H 是 AER 表格实践指南——modelsummary(...) 和 fixest::etable(...) 是两大主力工具,相当于 Stata 的 outreg2/esttab 和 Python 的 pf.etable/Stargazer)。
5.A 模式 A——逐步加入控制变量(规范的表 2)
各列中的 β̂ 保持稳定 ⇒ 不太需要担心估计结果是由可观测变量选择所驱动的(Oster 2019 的选择稳定性逻辑;将在第 6 步量化)。
library(fixest); library(modelsummary)
m1 <- feols(log_wage ~ training, data = df, cluster = ~ firm_id)
m2 <- feols(log_wage ~ training + age + edu, data = df, cluster = ~ firm_id)
m3 <- feols(log_wage ~ training + age + edu + tenure + firm_size, data = df, cluster = ~ firm_id)
m4 <- feols(log_wage ~ training + age + edu + tenure + firm_size | industry + year,
data = df, cluster = ~ firm_id)
m5 <- feols(log_wage ~ training + age + edu + tenure + firm_size | worker_id + year,
data = df, cluster = ~ firm_id)
m6 <- feols(log_wage ~ training + age + edu + tenure + firm_size | worker_id + year + industry^year,
data = df, cluster = ~ firm_id)
modelsummary(
list("(1) Baseline" = m1,
"(2) +Demog" = m2,
"(3) +Labor-mkt" = m3,
"(4) Ind×Yr FE" = m4,
"(5) Worker FE" = m5,
"(6) Worker FE+Ind×Yr" = m6),
output = "tables/table2_main.tex",
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
gof_omit = "BIC|AIC|F|Log|Adj",
coef_map = c("training" = "Job training",
"age" = "Age", "edu" = "Education",
"tenure" = "Tenure", "firm_size" = "Firm size"),
notes = c("Cluster-robust SE in parentheses, clustered at firm_id.",
"* p<0.10, ** p<0.05, *** p<0.01.")
)
modelsummary(list("(1)"=m1,"(2)"=m2,"(3)"=m3,"(4)"=m4,"(5)"=m5,"(6)"=m6),
output = "tables/table2_main.docx")
AER 惯例:展示所有控制变量(以及截距)。 不传入
keep =或coef_omit =,以显示每个参数。仅在有意制作只展示核心系数的表格时(交互项形式的异质性分析、IV 第一阶段三联表),使用coef_map = c("training" = "Training")(单一映射);仅当出于论文排版考虑想隐藏常数项时,使用coef_omit = "Intercept"。
5.B 模式 B——设计方法比较(表 2-bis)
展示不同识别策略下关注的同一系数。这是 AER 提升可信度的关键做法:通过采用不同识别假设的设计,获得相互印证的证据。
library(fixest); library(AER); library(did); library(MatchIt); library(WeightIt)
ols <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df, cluster = ~ firm_id)
iv <- feols(log_wage ~ age + edu + tenure | training ~ Z1 + Z2,
data = df, cluster = ~ firm_id)
cs <- att_gt(yname = "log_wage", tname = "year", idname = "worker_id",
gname = "first_treat", data = df,
control_group = "nevertreated", est_method = "dr",
clustervars = "firm_id")
psm <- matchit(training ~ age + edu + tenure, data = df,
method = "nearest", ratio = 1)
psm_lm <- lm(log_wage ~ training + age + edu + tenure,
data = match.data(psm), weights = weights)
ebal <- weightit(training ~ age + edu + tenure, data = df, method = "ebal")
ebal_lm <- lm(log_wage ~ training + age + edu + tenure,
data = df, weights = ebal$weights)
modelsummary(
list("(1) OLS+FE" = ols,
"(2) 2SLS" = iv,
"(3) CS-DID" = aggte(cs, type = "simple"),
"(4) PSM" = psm_lm,
"(5) Entropy bal." = ebal_lm),
output = "tables/table2b_designs.tex",
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
coef_map = c("training" = "Job training (β̂)"),
gof_omit = "BIC|AIC|F|Log|Adj",
notes = "Convergent evidence: same β̂ under five identification strategies."
)
5.C 模式 C——多结果变量表(相同的 X,多个 Y)
ys <- c("log_wage", "weeks_employed", "left_firm", "promoted")
multi_y <- lapply(ys, function(y)
feols(as.formula(paste(y, "~ training + age + edu + tenure | industry + year")),
data = df, cluster = ~ firm_id))
names(multi_y) <- ys
modelsummary(multi_y,
output = "tables/table2c_multi_outcome.tex",
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
coef_map = c("training" = "Training"),
notes = "Each column is a separate regression on the labelled outcome.")
5.D 模式 D——堆叠面板 A / 面板 B 表
相同模型族,采用两个时间跨度(短期 / 长期)或两个样本。使用 gt::gt_group() 堆叠两个 modelsummary 区块,并添加面板标题。
library(gt)
panelA <- list(
"(1) Industry FE" = feols(wage_t1 ~ training + X | industry + year, data = df, cluster = ~ firm_id),
"(2) Worker FE" = feols(wage_t1 ~ training + X | worker_id + year, data = df, cluster = ~ firm_id))
panelB <- list(
"(1) Industry FE" = feols(wage_t5 ~ training + X | industry + year, data = df, cluster = ~ firm_id),
"(2) Worker FE" = feols(wage_t5 ~ training + X | worker_id + year, data = df, cluster = ~ firm_id))
ms_A <- modelsummary(panelA, output = "gt") %>%
tab_header(title = "Panel A. Short-run (1 year)")
ms_B <- modelsummary(panelB, output = "gt") %>%
tab_header(title = "Panel B. Long-run (5 years)")
gt_group(ms_A, ms_B) %>%
gtsave("tables/table2d_horizons.tex")
gt_group(ms_A, ms_B) %>%
gtsave("tables/table2d_horizons.docx")
5.E 模式 E — IV 报告三联表(第一阶段 / 简化式 / 2SLS)
教科书式的 AER IV 表格将第一阶段、简化式和 2SLS 分列展示,方便读者核验 Wald 比率 = RF / FS。
fs <- feols(training ~ Z + age + edu | industry + year, data = df, cluster = ~ firm_id)
rf <- feols(log_wage ~ Z + age + edu | industry + year, data = df, cluster = ~ firm_id)
iv2 <- feols(log_wage ~ age + edu | training ~ Z, data = df, cluster = ~ firm_id)
modelsummary(
list("(1) First stage" = fs,
"(2) Reduced form" = rf,
"(3) 2SLS" = iv2),
output = "tables/table2e_iv_triplet.tex",
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
coef_map = c("Z" = "Instrument Z", "training" = "Training (endog.)"),
gof_map = list(list(raw = "ivf", clean = "First-stage F", fmt = 2)),
notes = "Wald ratio: $\\hat\\beta_{2SLS} = \\hat\\beta_{RF} / \\hat\\pi_{FS}$."
)
**IV 三联表有意突出核心内容:**仅展示 Z + 内生回归变量,方便读者一眼看出 Wald 比率。只有在审稿人要求提供完整系数列表时,才移除
coef_map=。
5.F 模式 F — 通过 did::att_gt / synthdid / grf::causal_forest 运行因果编排器主分析
对于 DID / SCM / 匹配 / 森林主分析,现代 R 估计器会返回完整的估计结果,以及自动生成的安慰剂检验 / 前趋势 / 重叠诊断。通过自动 tidy 方法将结果传入 modelsummary。
# CS-DID with full diagnostics
cs <- att_gt(yname = "log_wage", tname = "year", idname = "worker_id",
gname = "first_treat", data = df,
control_group = "nevertreated", est_method = "dr",
clustervars = "firm_id")
print(aggte(cs, type = "group")) # ATT(g) summary
print(aggte(cs, type = "dynamic", min_e = -4, max_e = 4)) # event-study aggregation
# Synthetic DID
library(synthdid)
sdid_setup <- panel.matrices(df, unit="worker_id", time="year",
outcome="log_wage", treatment="training")
sdid_fit <- synthdid_estimate(sdid_setup$Y, sdid_setup$N0, sdid_setup$T0)
print(summary(sdid_fit))
# Causal forest with overlap + variable importance
library(grf)
cf <- causal_forest(X = as.matrix(df[, c("age","edu","tenure","firm_size")]),
Y = df$log_wage, W = df$training, num.trees = 4000)
average_treatment_effect(cf, target.sample = "treated")
test_calibration(cf)
variable_importance(cf)
5.G 模式 G — 子组 modelsummary(表 3,见步骤 7)
每个子组一列。详细代码见 §步骤 7 — 异质性。
5.H 模式 H — 稳健性总表(表 A1,见步骤 6)
将每个稳健性设定与基准设定并列展示。详细代码见 §步骤 6。
标准估计器命令(底层原语)
library(fixest)
# 5a. OLS with cluster-robust SEs — feols is the modern primary
ols <- feols(log_wage ~ training + age + edu + tenure,
data = df, cluster = ~ firm_id)
summary(ols)
# 5b. Two-way FE — single line
fe <- feols(log_wage ~ training + age + edu + tenure | worker_id + year,
data = df, cluster = ~ worker_id)
# Multi-way clustering
fe_mw <- feols(log_wage ~ training | worker_id + year,
data = df, cluster = ~ worker_id + firm_id)
# High-dim interaction FE
fe_hd <- feols(log_wage ~ training | worker_id + industry^year,
data = df, cluster = ~ firm_id)
# 5c. 2×2 DID
did22 <- feols(log_wage ~ i(treated, post, ref = 0) + age + edu,
data = df, cluster = ~ worker_id)
# Or with absorbed FE:
did22 <- feols(log_wage ~ i(treated, post, ref = 0) | worker_id + year,
data = df, cluster = ~ worker_id)
# 5d. Event study — base period at -1
es <- feols(log_wage ~ i(rel_time, ref = -1) | worker_id + year,
data = df %>% filter(!is.na(first_treat)),
cluster = ~ worker_id)
iplot(es,
xlab = "Years relative to treatment",
main = "Event study")
# 5e. Staggered DID — modern estimators (see references/05-modeling.md §5.4)
library(did)
cs <- att_gt(yname = "log_wage", tname = "year", idname = "worker_id",
gname = "first_treat", data = df,
control_group = "nevertreated",
est_method = "dr",
clustervars = "firm_id")
ggdid(cs) # event-study plot
# Sun & Abraham via fixest::sunab
sa <- feols(log_wage ~ sunab(first_treat, year) | worker_id + year,
data = df, cluster = ~ worker_id)
iplot(sa, sub.title = "Sun-Abraham (2021)")
# Borusyak–Jaravel–Spiess (didimputation)
library(didimputation)
bjs <- did_imputation(data = df, yname = "log_wage", gname = "first_treat",
tname = "year", idname = "worker_id",
horizon = 0:5, pretrends = -5:-1,
cluster_var = "worker_id")
# Synthetic DID
library(synthdid)
sdid_setup <- synthdid::panel.matrices(df, unit = "worker_id", time = "year",
outcome = "log_wage", treatment = "training")
sdid_fit <- synthdid_estimate(sdid_setup$Y, sdid_setup$N0, sdid_setup$T0)
# 5f. IV / 2SLS
iv <- feols(log_wage ~ age + edu | training ~ draft_lottery + z2,
data = df, cluster = ~ firm_id)
summary(iv, stage = 1)
fitstat(iv, ~ ivf + ivwald + sargan) # first-stage F + Wald + overid
# Or via AER:
library(AER)
iv_aer <- ivreg(log_wage ~ training + age + edu |
draft_lottery + z2 + age + edu, data = df)
summary(iv_aer, vcov. = sandwich, diagnostics = TRUE)
# 5g. Sharp RD
library(rdrobust); library(rddensity)
rd <- rdrobust(y = df$outcome, x = df$running_var, c = 0,
kernel = "triangular", bwselect = "mserd")
summary(rd)
rdplot(y = df$outcome, x = df$running_var, c = 0)
rddensity(X = df$running_var, c = 0) # manipulation test
# 5h. Binary outcome
logit <- feglm(employed ~ training + age + edu | firm_id + year,
data = df, family = binomial(link = "logit"),
cluster = ~ firm_id)
library(marginaleffects)
avg_slopes(logit, variables = "training") # AME
# 5i. Count w/ HD FE
pois <- fepois(citations ~ training + age | firm_id + year,
data = df, cluster = ~ firm_id)
步骤 6 — 稳健性检验组
深入模式:references/06-robustness.md — 使用 modelsummary 处理 M1–M6;使用 clubSandwich/fwildclusterboot;使用 bacondecomp/HonestDiD/robomit;使用 ri2 进行随机化推断。
library(modelsummary)
library(fixest)
# 6a. Progressive specs (M1 → M6)
m1 <- feols(log_wage ~ training, data = df, cluster = ~ firm_id)
m2 <- feols(log_wage ~ training + age + edu, data = df, cluster = ~ firm_id)
m3 <- feols(log_wage ~ training + age + edu + tenure | worker_id,
data = df, cluster = ~ worker_id)
m4 <- feols(log_wage ~ training + age + edu + tenure | worker_id + year,
data = df, cluster = ~ worker_id)
m5 <- feols(log_wage ~ training + age + edu + tenure | worker_id + year + region,
data = df, cluster = ~ worker_id)
m6 <- feols(log_wage ~ training + age + edu + tenure | worker_id + year + industry^year,
data = df, cluster = ~ worker_id)
modelsummary(list("(1)" = m1, "(2)" = m2, "(3)" = m3,
"(4)" = m4, "(5)" = m5, "(6)" = m6),
stars = c('*' = .1, '**' = .05, '***' = .01),
gof_omit = "BIC|AIC|F|Log",
coef_map = c("training" = "Training",
"age" = "Age", "edu" = "Education", "tenure" = "Tenure"),
output = "tables/table_main.tex")
# 6b. Alternative cluster levels
for (cl in c("worker_id", "firm_id", "industry", "state")) {
fit <- feols(log_wage ~ training | worker_id + year, data = df,
cluster = as.formula(paste0("~", cl)))
cat(cl, ": b=", coef(fit)["training"], " se=", se(fit)["training"], "\n")
}
# 6c. Wild cluster bootstrap (when few clusters)
library(fwildclusterboot)
boot <- boottest(m4, param = "training", clustid = "state",
B = 9999, seed = 42)
summary(boot)
# 6d. Subsample splits
splits <- list(
"Female=0" = df %>% filter(female == 0),
"Female=1" = df %>% filter(female == 1),
"Young (<40)" = df %>% filter(age < 40),
"Old (>=40)" = df %>% filter(age >= 40)
)
sub_fits <- imap(splits, ~ feols(log_wage ~ training | worker_id + year,
data = .x, cluster = ~ worker_id))
modelsummary(sub_fits, stars = TRUE)
# 6e. Placebo — fake timing
df_placebo <- df %>%
mutate(fake_first = first_treat - 3,
fake_post = year >= fake_first) %>%
filter(year < first_treat)
feols(log_wage ~ fake_post | worker_id + year,
data = df_placebo, cluster = ~ worker_id)
# 6f. Randomization inference
library(ri2)
ri_out <- conduct_ri(formula = log_wage ~ training + age + edu,
declaration = randomizr::declare_ra(N = nrow(df),
prob = mean(df$training)),
assignment = "training",
sharp_hypothesis = 0,
data = df,
sims = 1000)
summary(ri_out); plot(ri_out)
# 6g. TWFE bias diagnosis
library(bacondecomp)
bacon_out <- bacon(log_wage ~ training,
data = df, id_var = "worker_id", time_var = "year")
ggplot(bacon_out, aes(weight, estimate, color = type)) + geom_point()
ggsave("figures/bacon.pdf")
# 6h. Parallel-trends sensitivity
library(HonestDiD)
honest_out <- createSensitivityResults(betahat = es$coefficients,
sigma = vcov(es),
numPrePeriods = 5, numPostPeriods = 5,
Mbarvec = seq(0, 0.5, by = 0.05))
createSensitivityPlot(honest_out, originalResults = honest_out$mainResult)
ggsave("figures/honestdid.pdf")
# 6i. Oster (2019) δ*
library(robomit)
o_test(y = "log_wage", x = "training",
con = "age + edu + tenure | worker_id + year",
id = "worker_id", time = "year",
data = df, R2max = 1.3 * fitstat(m6, "r2"), beta = 0)
# ============================================================
# 6j. Pattern H — Robustness master table (Table A1, one column per check)
# ============================================================
library(modelsummary); library(MatchIt); library(WeightIt)
base <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df, cluster = ~ firm_id)
no99 <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df %>% filter(wage < quantile(wage, 0.99, na.rm = TRUE)),
cluster = ~ firm_id)
balpan <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df %>% group_by(worker_id) %>%
filter(n_distinct(year) == max(n_distinct(year))) %>% ungroup(),
cluster = ~ firm_id)
dropearly <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df %>% filter(first_treat > 2008), cluster = ~ firm_id)
wfe <- feols(log_wage ~ training + age + edu + tenure | worker_id + year,
data = df, cluster = ~ firm_id)
cl2way <- feols(log_wage ~ training + age + edu + tenure | industry + year,
data = df, cluster = ~ firm_id + year)
logy <- feols(log(wage + 1) ~ training + age + edu + tenure | industry + year,
data = df, cluster = ~ firm_id)
ihsy <- feols(asinh(wage) ~ training + age + edu + tenure | industry + year,
data = df, cluster = ~ firm_id)
m_psm <- matchit(training ~ age + edu + tenure + firm_size, data = df, method = "nearest")
psm_lm <- lm(log_wage ~ training + age + edu + tenure, data = match.data(m_psm), weights = weights)
ebal_w <- weightit(training ~ age + edu + tenure + firm_size, data = df, method = "ebal")
ebal_lm <- lm(log_wage ~ training + age + edu + tenure, data = df, weights = ebal_w$weights)
modelsummary(
list("(1) Baseline" = base,
"(2) Drop top 1%" = no99,
"(3) Balanced" = balpan,
"(4) Drop early" = dropearly,
"(5) Worker FE" = wfe,
"(6) 2-way cluster" = cl2way,
"(7) log Y" = logy,
"(8) IHS Y" = ihsy,
"(9) PSM" = psm_lm,
"(10) Entropy bal." = ebal_lm),
output = "tables/tableA1_robustness.tex",
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01),
coef_map = c("training" = "Training (β̂)"),
gof_omit = "BIC|AIC|F|Log|Adj",
notes = "Each column is one robustness check. β̂ on training is the focal coefficient."
)
# ============================================================
# 6k. Specification curve (Simonsohn-Simmons-Nelson 2020) via `specr`
# ============================================================
library(specr); library(ggplot2)
specs <- setup(data = df,
y = c("log_wage", "ihs_wage"),
x = "training",
model = c("feols"),
controls = c("age", "edu", "tenure", "firm_size"),
subsets = list(industry = c("manuf", "construction", "transport")))
results <- specr(specs)
plot(results, choices = c("x", "y", "controls", "subsets"))
ggsave("figures/fig5_spec_curve.pdf", width = 10, height = 6)
ggsave("figures/fig5_spec_curve.png", width = 10, height = 6, dpi = 300)
# Hand-rolled alternative when `specr` doesn't fit (with custom FE / SE):
# spec_grid <- expand.grid(controls = list(c("age"), c("age","edu"), c("age","edu","tenure")),
# ytrans = c("log_wage", "ihs_wage"),
# sample = c("all", "manuf", "no99"),
# cluster = c("firm_id", "firm_id+year"))
# Loop, run feols, collect b/se, ggplot::geom_pointrange.
# ============================================================
# 6l. Sensitivity dashboard — HonestDiD + Oster + E-value
# ============================================================
# (a) HonestDiD — Rambachan-Roth (2023): bound on β̂ under bounded PT violation
library(HonestDiD)
es_pre <- coef(es)[grep("year::-", names(coef(es)))]
es_post <- coef(es)[grep("year::[0-9]", names(coef(es)))]
honest_out <- createSensitivityResults(betahat = c(es_pre, es_post),
sigma = vcov(es)[c(names(es_pre), names(es_post)),
c(names(es_pre), names(es_post))],
numPrePeriods = length(es_pre),
numPostPeriods = length(es_post),
Mbarvec = seq(0, 0.5, by = 0.05))
createSensitivityPlot(honest_out, originalResults = honest_out$mainResult)
ggsave("figures/fig6_honestdid.pdf", width = 7, height = 4)
# (b) Oster δ — `robomit::o_test` (already shown in 6i)
# (c) E-value (VanderWeele-Ding 2017) — for risk-ratio outcomes
library(EValue)
evalue(RR(1.45), lo = 1.10, hi = 1.91)
# → reports the minimum strength of unmeasured confounding to nullify the result.
步骤 7 — 进一步分析
深入模式:references/07-further-analysis.md — marginaleffects 是后估计分析的主力工具;使用 mediation::mediate 进行 Imai 中介分析;使用 lavaan 进行 SEM;使用 grf::causal_forest 估计 CATE。
library(marginaleffects)
library(fixest)
# 7a. Heterogeneity via interaction
het <- feols(log_wage ~ i(female, training, ref = 0) + age + edu | worker_id + year,
data = df, cluster = ~ worker_id)
summary(het)
iplot(het) # visualize interaction
# Continuous moderator + marginsplot
het_c <- feols(log_wage ~ training * tenure + age + edu | worker_id + year,
data = df, cluster = ~ worker_id)
plot_slopes(het_c, variables = "training",
condition = list(tenure = seq(0, 20, by = 2))) +
geom_hline(yintercept = 0, linetype = "dashed") +
labs(x = "Tenure", y = "Marginal effect of training")
ggsave("figures/het_tenure.pdf", width = 6, height = 4)
# 7b. Triple difference
ddd <- feols(log_wage ~ treated * post * high_exposure | worker_id + year,
data = df, cluster = ~ firm_id)
# 7c. Outcome ladder
out_ladder <- list()
for (y in c("hours_worked", "productivity", "log_wage")) {
out_ladder[[y]] <- feols(as.formula(paste(y, "~ training | worker_id + year")),
data = df, cluster = ~ worker_id)
}
modelsummary(out_ladder, stars = TRUE,
coef_map = c("training" = "Training"),
output = "tables/outcome_ladder.tex")
# 7d. Mediation — Imai et al. (2010)
library(mediation)
med_M <- lm(hours_worked ~ training + age + edu, data = df)
med_Y <- lm(log_wage ~ training + hours_worked + age + edu, data = df)
med <- mediate(med_M, med_Y, treat = "training", mediator = "hours_worked",
boot = TRUE, sims = 1000)
summary(med); plot(med)
# Sensitivity to unobserved M-Y confounding
medsens <- medsens(med, rho.by = 0.05, effect.type = "indirect")
plot(medsens)
# 7e. CATE via causal forest
library(grf)
cf <- causal_forest(X = as.matrix(df %>% select(age, edu, tenure, firm_size)),
Y = df$log_wage, W = df$training,
num.trees = 2000, min.node.size = 5)
df$tau_hat <- predict(cf)$predictions
variable_importance(cf)
average_treatment_effect(cf, target.sample = "all")
# Plot CATE by a moderator
ggplot(df, aes(tenure, tau_hat)) +
geom_smooth(method = "loess", se = TRUE) +
labs(x = "Tenure", y = "Estimated CATE")
ggsave("figures/cate_tenure.pdf")
# 7f. Dose-response — splines
library(splines)
dr <- feols(log_wage ~ ns(training_hours, df = 4) + age + edu | worker_id + year,
data = df, cluster = ~ worker_id)
plot_predictions(dr, condition = "training_hours")
步骤 8 — 发表用表格和图表
此步骤为必做项——每次分析运行都会生成本技能顶部 默认输出规范 中定义的全部 5 张必需表格(T1–T5)和全部 4 张必需图表(F1–F4)。不要因为“回归已经跑完了”就跳过步骤 8。没有表格和图表的系数,不是应用经济学传达研究结果的方式。
深入模式:references/08-tables-plots.md — modelsummary 是现代默认工具(一次调用即可生成 LaTeX/Word/HTML/Excel);使用 kableExtra 进行更多 LaTeX 样式设置;使用 gt 生成 HTML/Word;使用 ggplot2 + iplot + ggpubr + cowplot + binsreg 绘制图表。
library(modelsummary)
library(kableExtra)
library(gt)
library(fixest)
library(ggplot2)
# ============================================================
# 8a. ★ TABLE 2 — Main results, multi-column regression M1→M6
# (the centerpiece of every economics paper)
# ============================================================
modelsummary(
list("(1) Raw" = m1,
"(2) +Demog" = m2,
"(3) +Tenure" = m3,
"(4) +Unit FE" = m4,
"(5) +2-way FE" = m5,
"(6) +Ind×Yr FE" = m6),
stars = c('*' = .1, '**' = .05, '***' = .01),
coef_map = c("training" = "Training",
"age" = "Age", "edu" = "Education", "tenure" = "Tenure"),
gof_map = list(
list("raw" = "nobs", "clean" = "N", "fmt" = 0),
list("raw" = "r.squared", "clean" = "R²", "fmt" = 3),
list("raw" = "adj.r.squared","clean" = "Adj. R²", "fmt" = 3)
),
notes = "Cluster-robust SE at worker_id in parentheses. * p<0.10, ** p<0.05, *** p<0.01.",
output = "tables/table2_main.tex"
)
modelsummary(list("(1)"=m1, "(2)"=m2, "(3)"=m3, "(4)"=m4, "(5)"=m5, "(6)"=m6),
stars = TRUE, output = "tables/table2_main.docx")
# ============================================================
# 8b. TABLE 1 — Summary statistics & balance
# ============================================================
library(gtsummary)
tbl1 <- df %>%
select(log_wage, age, edu, tenure, female, training) %>%
tbl_summary(by = training, missing = "ifany",
statistic = all_continuous() ~ "{mean} ({sd})") %>%
add_p() %>% add_difference() %>% add_n() %>% bold_labels()
tbl1 %>% as_kable_extra(format = "latex", booktabs = TRUE) %>%
kableExtra::save_kable("tables/table1_balance.tex")
tbl1 %>% as_flex_table() %>%
flextable::save_as_docx(path = "tables/table1_balance.docx")
# ============================================================
# 8c. TABLE 3 — Mechanism / outcome ladder (3+ outcomes)
# ============================================================
ladder <- list()
for (y in c("hours_worked", "productivity", "log_wage")) {
ladder[[y]] <- feols(as.formula(paste(y, "~ training + age + edu + tenure | worker_id + year")),
data = df, cluster = ~ worker_id)
}
modelsummary(ladder,
stars = c('*' = .1, '**' = .05, '***' = .01),
coef_map = c("training" = "Training"),
notes = "Each column is a separate regression on the labelled outcome. Cluster-robust SE at worker_id.",
output = "tables/table3_mechanism.tex")
# ============================================================
# 8d. TABLE 4 — Heterogeneity (subgroup × main coef)
# ============================================================
het_specs <- list(
"All" = df,
"Female=0" = df %>% filter(female == 0),
"Female=1" = df %>% filter(female == 1),
"Age<40" = df %>% filter(age < 40),
"Age≥40" = df %>% filter(age >= 40),
"Manuf." = df %>% filter(industry == "manufacturing")
)
het_models <- imap(het_specs,
~ feols(log_wage ~ training + age + edu + tenure | worker_id + year,
data = .x, cluster = ~ worker_id))
modelsummary(het_models,
stars = c('*' = .1, '**' = .05, '***' = .01),
coef_map = c("training" = "Training"),
notes = "Cluster-robust SE at worker_id. Wald p-values for cross-subgroup equality should accompany this table — see references/07.",
output = "tables/table4_heterogeneity.tex")
# ============================================================
# 8e. TABLE 5 — Robustness battery (alt SE / cluster / sample / placebo)
# ============================================================
rob <- list(
"Baseline" = feols(log_wage ~ training | worker_id + year, data = df,
cluster = ~ worker_id),
"Cluster=Firm" = feols(log_wage ~ training | worker_id + year, data = df,
cluster = ~ firm_id),
"2-way Cluster" = feols(log_wage ~ training | worker_id + year, data = df,
cluster = ~ worker_id + firm_id),
"Winsor 1/99" = feols(log_wage ~ training | worker_id + year,
data = df %>% mutate(log_wage = DescTools::Winsorize(log_wage,
probs = c(.01,.99),
na.rm = TRUE)),
cluster = ~ worker_id),
"Drop Manuf." = feols(log_wage ~ training | worker_id + year,
data = df %>% filter(industry != "manufacturing"),
cluster = ~ worker_id),
"Placebo (-3)" = feols(log_wage ~ fake_post | worker_id + year,
data = df %>% filter(year < first_treat),
cluster = ~ worker_id)
)
modelsummary(rob,
stars = c('*' = .1, '**' = .05, '***' = .01),
output = "tables/table5_robustness.tex")
# ============================================================
# 8f. ★ FIGURE 3 — Coefficient plot across M1→M6
# ============================================================
modelplot(list("(1)"=m1, "(2)"=m2, "(3)"=m3, "(4)"=m4, "(5)"=m5, "(6)"=m6),
coef_map = c("training" = "Training"),
conf_level = 0.95) +
geom_vline(xintercept = 0, linetype = "dashed", alpha = 0.5) +
labs(x = "Coefficient on training (95% CI)", y = "Specification",
title = "Effect of training across specifications") +
theme_classic(base_size = 11)
ggsave("figures/fig3_coefplot.pdf", width = 6, height = 4)
ggsave("figures/fig3_coefplot.png", width = 6, height = 4, dpi = 300)
# ============================================================
# 8g. FIGURE 2 — Event-study plot (dynamic DID, base period = -1)
# ============================================================
pdf("figures/fig2_event_study.pdf", width = 7, height = 4)
iplot(es,
xlab = "Years relative to treatment",
ylab = "Coefficient (ATT, 95% CI)",
main = "Event study: dynamic effect of training",
ref.line = -0.5)
dev.off()
png("figures/fig2_event_study.png", width = 2100, height = 1200, res = 300)
iplot(es,
xlab = "Years relative to treatment",
ylab = "Coefficient (ATT, 95% CI)",
main = "Event study: dynamic effect of training",
ref.line = -0.5)
dev.off()
# ============================================================
# 8h. FIGURE 4 — Sensitivity / robustness curve
# (HonestDiD / spec curve / forest of robustness battery)
# ============================================================
# HonestDiD example (after the event study with stored b/V):
library(HonestDiD)
honest_out <- createSensitivityResults(betahat = es$coefficients,
sigma = vcov(es),
numPrePeriods = 5, numPostPeriods = 5,
Mbarvec = seq(0, 0.5, by = 0.05))
sens_plot <- createSensitivityPlot(honest_out, originalResults = honest_out$mainResult)
ggsave("figures/fig4_sensitivity.pdf", plot = sens_plot, width = 7, height = 4)
ggsave("figures/fig4_sensitivity.png", plot = sens_plot, width = 7, height = 4, dpi = 300)
# Alternative — robustness forest plot:
# rob_summary <- imap_dfr(rob, ~ tibble(
# group = .y,
# est = coef(.x)[1],
# se = se(.x)[1]
# ))
# ggplot(rob_summary, aes(est, fct_rev(factor(group)))) +
# geom_point(size = 3, color = "navy") +
# geom_errorbarh(aes(xmin = est - 1.96*se, xmax = est + 1.96*se),
# height = 0.2, color = "navy") +
# geom_vline(xintercept = 0, linetype = "dashed") +
# labs(x = "Coefficient on training (95% CI)", y = NULL,
# title = "Robustness forest plot")
# ggsave("figures/fig4_sensitivity.pdf", width = 7, height = 4)
# ============================================================
# 8i. FIGURE 1 — Trend / motivation (treated vs control over time)
# ============================================================
df %>%
group_by(year, training) %>%
summarise(mean_log_wage = mean(log_wage, na.rm = TRUE), .groups = "drop") %>%
ggplot(aes(year, mean_log_wage, color = factor(training))) +
geom_line(linewidth = 1) + geom_point(size = 2) +
geom_vline(xintercept = policy_year, linetype = "dashed", color = "gray40") +
scale_color_manual(values = c("0" = "darkred", "1" = "navy"),
labels = c("Control", "Treated"), name = "") +
labs(x = "Year", y = "Mean log wage",
title = "Treated vs control trend") +
theme_classic(base_size = 11) +
theme(legend.position = "bottom")
ggsave("figures/fig1_trend.pdf", width = 7, height = 4)
ggsave("figures/fig1_trend.png", width = 7, height = 4, dpi = 300)
# ============================================================
# 8j. Auxiliary plots (optional — produce when relevant)
# ============================================================
library(binsreg)
binsreg(y = df$log_wage, x = df$tenure, w = df %>% select(age, edu, female))
ggsave("figures/figA_binscatter.pdf", width = 6, height = 4)
# RD plot (only when running_var exists)
# rdplot(y = df$outcome, x = df$running_var, c = 0,
# title = "RD plot", x.label = "Running variable", y.label = "Outcome")
# ============================================================
# 8k. Multi-panel combined (optional, for slides / appendix)
# ============================================================
library(cowplot)
# plot_grid(p_trend, p_event, p_coef, p_sens, ncol = 2, labels = "AUTO") %>%
# ggsave("figures/combined.pdf", plot = ., width = 10, height = 8)
# ============================================================
# 8l. Theme — set once at top of script for consistency
# ============================================================
theme_set(theme_classic(base_size = 11) +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold")))
交付物检查清单(宣布运行完成前请核实):
[ ] tables/table1_balance.tex [ ] figures/fig1_trend.pdf
[ ] tables/table2_main.tex ★ [ ] figures/fig2_event_study.pdf
[ ] tables/table3_mechanism.tex [ ] figures/fig3_coefplot.pdf
[ ] tables/table4_heterogeneity.tex
[ ] tables/table5_robustness.tex [ ] figures/fig4_sensitivity.pdf
[ ] tables/tableA1_robustness.tex [ ] figures/fig5_spec_curve.pdf
[ ] artifacts/sample_construction.json (footnote 4)
[ ] artifacts/data_contract.json
[ ] artifacts/result.json (reproducibility stamp — see 8m)
8m. 可复现性标记
期刊复现办公室(或未来的合著者)复现核心结果所需的唯一工件。保存 R 版本、随机种子、数据集哈希值、基准系数 + CI,以及协议/契约的引用路径:
library(jsonlite); library(digest)
# Get baseline result (assumes `base` is the headline feols object)
b_hat <- coef(base)["training"]
se_b <- se(base)["training"]
ci <- c(b_hat - 1.96 * se_b, b_hat + 1.96 * se_b)
stamp <- list(
R_version = R.version.string,
fixest_version = as.character(packageVersion("fixest")),
modelsummary_version = as.character(packageVersion("modelsummary")),
seed = 42,
dataset_sha256 = substr(digest::digest(df, algo = "sha256"), 1, 16),
n_obs = base$nobs,
estimand = "ATT",
estimator = "fixest::feols",
estimate = unname(b_hat),
se_cluster = unname(se_b),
ci95 = unname(ci),
pre_registration = "artifacts/strategy.md",
data_contract = "artifacts/data_contract.json",
sample_log = "artifacts/sample_construction.json",
paper_bundle = "tables/table2_main.tex"
)
write_json(stamp, "artifacts/result.json", pretty = TRUE, auto_unbox = TRUE)
将 artifacts/result.json 与论文 PDF 一并提交。审稿人应能够运行 Rscript master.R,并逐位复现此 JSON。
§A — 流行病学 / 公共卫生模式
当用户的措辞表明采用模式 A(目标试验模拟 / IPTW / TMLE / MR / STROBE / 流行病学 / 公共卫生 / RWE / 队列)时,仍然适用这 8 个步骤——但步骤 5 会将 OLS 和固定效应方法组替换为双重稳健 + 生存分析 + MR 三联方法,交付物则遵循 STROBE / TRIPOD-AI 规范。步骤 1–4(清理、构建、表 1、诊断)和步骤 8(表格/图表导出)与默认模式完全相同。
软件包范围(在默认软件包组基础上安装):
install.packages(c(
"WeightIt", "PSweight", "cobalt", # IPTW / propensity weighting + balance
"gfoRmula", # parametric g-formula (time-varying)
"tmle", "ltmle", # TMLE / longitudinal TMLE
"survival", "survminer", "flexsurv", # KM / Cox / AFT / RMST
"MendelianRandomization", "TwoSampleMR", # IVW, Egger, weighted-median MR
"MRPRESSO", # outlier-robust MR
"EValue" # E-value sensitivity (VanderWeele)
))
A.0 队列构建 + 目标试验方案
在接触数据之前编写方案。将其保存为 protocol.yml,并在论文中引用。
# protocol.yml — target-trial emulation skeleton
# eligibility: age 40-75, no_prior_event, ascertained_at t0
# treatment: A=1 statin initiation; A=0 no initiation
# assignment: emulated random at t0 via IPTW on baseline covariates
# outcome: incident MI within 5 years
# estimand: ITT ATE on risk difference + hazard ratio
library(dplyr)
cohort <- df |>
filter(age >= 40, age <= 75, prior_MI == 0) |>
mutate(
t0 = coalesce(statin_initiation_date, enrollment_date),
event_5y = as.integer((MI_date - t0) <= 365 * 5 & !is.na(MI_date)),
time_at_risk = pmin(as.numeric(censor_date - t0), 365 * 5)
)
A.1 按暴露分组的表 1(与默认模式步骤 3 相同)
使用步骤 3 中相同的 gtsummary::tbl_summary,只需设置 by = A。未测量混杂的 E 值放在页脚中。
library(gtsummary)
cohort |>
select(A, age, edu, smoke, bmi, ldl, sbp) |>
tbl_summary(by = A, missing = "ifany") |>
add_difference() |>
add_p() |>
bold_labels()
A.2 DAG + 倾向评分重叠(正值性检查)
library(WeightIt); library(cobalt)
# Estimate PS + IPTW weights
w_out <- weightit(A ~ age + edu + smoke + bmi + ldl + sbp,
data = cohort, method = "glm", estimand = "ATE")
# Overlap density (positivity)
bal.plot(w_out, var.name = "prop.score", which = "both")
ggsave("figures/figA2_ps_overlap.pdf")
# Love plot (SMDs before vs after IPTW)
love.plot(w_out, threshold = 0.1, abs = TRUE)
ggsave("figures/figA2_love.pdf")
A.3 IPTW + g-formula + TMLE 双重稳健三件套(替换 Step 5)
流行病学中的「AER Table 2」:一张 3 列的表格,每列对应 {IPTW-MSM、g-formula、TMLE} 之一,便于读者确认双重稳健性结果是否一致。
# IPTW marginal structural model
library(survey)
des <- svydesign(ids = ~1, data = cohort, weights = w_out$weights)
msm <- svyglm(event_5y ~ A, design = des, family = quasibinomial())
RD_iptw <- coef(msm)["A"]; CI_iptw <- confint(msm)["A", ]
# g-formula (parametric, time-fixed)
library(gfoRmula)
gf <- gformula_binary_eof(
obs_data = cohort,
id = "subject_id", time_name = "t", outcome_name = "event_5y",
covnames = c("age","edu","smoke","bmi","ldl","sbp"),
intvars = list("A"), interventions = list(list(c(static, 1)), list(c(static, 0))),
ref_int = 1, time_points = 1, basecovs = c("age","edu","smoke","bmi","ldl","sbp")
)
# TMLE (doubly robust)
library(tmle)
fit_tmle <- tmle(
Y = cohort$event_5y, A = cohort$A,
W = cohort[, c("age","edu","smoke","bmi","ldl","sbp")],
family = "binomial",
Q.SL.library = c("SL.glm","SL.glmnet","SL.ranger"),
g.SL.library = c("SL.glm","SL.glmnet","SL.ranger")
)
RD_tmle <- fit_tmle$estimates$ATE$psi
CI_tmle <- fit_tmle$estimates$ATE$CI
# Stack the triplet into one paper table
library(modelsummary)
tableA3 <- tibble::tribble(
~Estimator, ~RD, ~`95% CI`,
"IPTW-MSM", RD_iptw, sprintf("[%.3f, %.3f]", CI_iptw[1], CI_iptw[2]),
"g-formula", gf$result[2,"mean"] - gf$result[1,"mean"], "—",
"TMLE", RD_tmle, sprintf("[%.3f, %.3f]", CI_tmle[1], CI_tmle[2])
)
modelsummary::datasummary_df(tableA3, output = "tables/tableA3_dr_triplet.tex")
A.4 生存结局 — KM / Cox / AFT / RMST
library(survival); library(survminer); library(flexsurv)
# KM by treatment
fit_km <- survfit(Surv(time_at_risk, event_5y) ~ A, data = cohort)
ggsurvplot(fit_km, conf.int = TRUE, pval = TRUE, risk.table = TRUE)
ggsave("figures/figA4_km.pdf")
# Cox HR (covariate-adjusted)
fit_cox <- coxph(Surv(time_at_risk, event_5y) ~ A + age + edu + smoke + bmi + ldl + sbp,
data = cohort, weights = w_out$weights)
HR <- exp(coef(fit_cox)["A"]); HR_CI <- exp(confint(fit_cox)["A", ])
# AFT (Weibull) for time-ratio interpretation
fit_aft <- flexsurvreg(Surv(time_at_risk, event_5y) ~ A + age + edu + smoke + bmi + ldl + sbp,
data = cohort, dist = "weibull")
# RMST contrast at t = 5 years
library(survRM2)
rmst <- rmst2(cohort$time_at_risk, cohort$event_5y, cohort$A, tau = 365 * 5)
A.5 孟德尔随机化(IVW / Egger / 加权中位数三件套)
library(MendelianRandomization)
mri <- mr_input(bx = BX, bxse = BXSE, by = BY, byse = BYSE,
exposure = "Statin use", outcome = "MI")
ivw <- mr_ivw(mri)
egger <- mr_egger(mri) # pleiotropy intercept test
wmedian<- mr_median(mri, weighting = "weighted")
# Or harmonized two-sample workflow
# library(TwoSampleMR); harmonised <- harmonise_data(exposure_dat, outcome_dat)
# res <- mr(harmonised, method_list = c("mr_ivw", "mr_egger_regression", "mr_weighted_median"))
# Sensitivity to outliers
library(MRPRESSO)
mr_presso(BetaOutcome = "by", BetaExposure = "bx", SdOutcome = "byse", SdExposure = "bxse",
OUTLIERtest = TRUE, DISTORTIONtest = TRUE, data = data.frame(bx, by, bxse, byse), NbDistribution = 1000)
A.6 稳健性 — E-value / 界限 / 主层分层
library(EValue)
ev <- evalue(RR(1.45), lo = 1.10, hi = 1.91) # required strength of unmeasured confounding
print(ev)
A.7 STROBE / TRIPOD-AI 报告清单
保存为 replication/strobe_checklist.md,并在提交前逐项勾选:
[ ] Eligibility criteria + dates (target-trial protocol)
[ ] Adjustment set with DAG justification (A.2)
[ ] Positivity / overlap diagnostic (A.2)
[ ] Doubly-robust triplet (IPTW + g-formula + TMLE) (A.3)
[ ] Risk difference + hazard ratio + RMST (A.3, A.4)
[ ] E-value for unmeasured confounding (A.6)
[ ] Loss-to-follow-up rate + censoring assumption (A.0)
[ ] Pre-registered protocol or analysis plan (A.0)
§B — 机器学习因果推断模式
当用户的表述指明模式 B(DML / 元学习器 / 因果森林 / BCF / CATE / 策略学习 / 保形因果 / 公平性 / 因果机器学习)时,工作流保留默认模式的步骤 1–4 和步骤 8,将步骤 5 替换为 ML 估计器堆栈,并在步骤 7 和步骤 8 之间添加 CATE 分布 + 策略价值层。
依赖包(在默认堆栈的基础上安装):
install.packages(c(
"DoubleML", "mlr3", "mlr3learners", # DML + ML nuisance learners
"grf", # causal forest, GRF, instrumental forest
"causalweight", # IPW / DR / sensitivity for CATE
"bartCause", "bcf", # BART / Bayesian causal forest
"policytree", # honest policy trees
"conformalInference", # conformal prediction (general)
# cfcausal — install via devtools::install_github("lihualei71/cfcausal")
"fairmodels", # fairness audit
"pcalg", "bnlearn" # causal discovery (PC / GES / Bayesian net)
))
B.0 训练集/留出集拆分 + 干扰项学习器堆栈
library(mlr3); library(mlr3learners); library(DoubleML)
set.seed(42)
idx <- sample(seq_len(nrow(df)), size = 0.7 * nrow(df))
train <- df[idx, ]; holdout <- df[-idx, ]
# Standard nuisance pair: outcome regression Q(X,A) and propensity g(A|X)
ml_g <- lrn("regr.ranger", num.trees = 500, mtry = 5) # outcome
ml_m <- lrn("classif.ranger", num.trees = 500, mtry = 5) # propensity
B.1 DAG / 估计目标声明(可选用 LLM 辅助)
library(pcalg)
# PC algorithm — constraint-based DAG discovery
suffStat <- list(C = cor(df[, c("A","Y","X1","X2","X3","X4")]), n = nrow(df))
pc.fit <- pc(suffStat, indepTest = gaussCItest,
alpha = 0.01, labels = c("A","Y","X1","X2","X3","X4"))
plot(pc.fit, main = "PC-recovered DAG")
# OR: bnlearn for hill-climbing GES
# library(bnlearn); hc.fit <- hc(df[, c("A","Y","X1","X2","X3","X4")]); plot(hc.fit)
B.2 估计器堆栈 — DML · 元学习器 · 因果森林 · BCF(替换 Step 5)
机器学习因果推断中的「AER Table 2」:一张赛马式表格,每列对应同一 (Y, A, X) 数据上的一种估计器系列——读者希望看到 DML、T-learner、因果森林和 BCF 对 ATE 得出一致(或不一致)的结果。
# DML — partially linear or interactive regression model
dml_data <- DoubleMLData$new(train, y_col = "Y", d_cols = "A",
x_cols = c("X1","X2","X3","X4"))
dml_plr <- DoubleMLPLR$new(dml_data, ml_g = ml_g, ml_m = ml_m, n_folds = 5)
dml_plr$fit()
ate_dml <- dml_plr$coef; ci_dml <- dml_plr$confint()
# Causal forest (GRF) — non-parametric CATE
library(grf)
cf <- causal_forest(X = as.matrix(train[, c("X1","X2","X3","X4")]),
Y = train$Y, W = train$A, num.trees = 2000)
ate_cf <- average_treatment_effect(cf, target.sample = "all")
cate_cf <- predict(cf, newdata = as.matrix(holdout[, c("X1","X2","X3","X4")]))$predictions
# T-learner / DR-learner (use causalweight or hand-rolled with grf::*)
library(causalweight)
dr <- treatDML(y = train$Y, d = train$A, x = as.matrix(train[, c("X1","X2","X3","X4")]),
MLmethod = "lasso")$effect
ate_DR <- mean(dr)
# Bayesian Causal Forest — separate prognostic + treatment functions
library(bcf)
bcf_fit <- bcf(y = train$Y, z = train$A,
x_control = as.matrix(train[, c("X1","X2","X3","X4")]),
x_moderate = as.matrix(train[, c("X1","X2","X3","X4")]),
pihat = predict(glm(A ~ ., data = train[, c("A","X1","X2","X3","X4")], family = binomial), type = "response"),
nburn = 1000, nsim = 1000)
ate_bcf <- mean(bcf_fit$tau)
# Stack the horse-race
library(modelsummary)
tableB2 <- tibble::tribble(
~Estimator, ~ATE,
"DML (PLR)", ate_dml[1],
"Causal Forest", ate_cf[1],
"DR-learner", ate_DR,
"Bayesian Causal Forest", ate_bcf
)
modelsummary::datasummary_df(tableB2, fmt = 4, output = "tables/tableB2_ml_horserace.tex")
B.3 CATE 分布 + 亚组 CATE 图(扩展步骤 7)
library(ggplot2)
# CATE histogram
data.frame(cate = cate_cf) |>
ggplot(aes(x = cate)) +
geom_histogram(bins = 30, fill = "grey70", colour = "black") +
geom_vline(xintercept = 0, lty = 2) +
labs(x = "CATE", y = "Count")
ggsave("figures/figB3_cate_hist.pdf")
# CATE by quartile of a covariate
holdout |>
mutate(cate = cate_cf, age_q = ntile(X1, 4)) |>
group_by(age_q) |>
summarise(mean_cate = mean(cate)) |>
ggplot(aes(age_q, mean_cate)) + geom_col() + labs(y = "Mean CATE")
ggsave("figures/figB3_cate_by_age_q.pdf")
B.4 策略学习 + 离线策略评估
library(policytree)
# Honest discrete policy tree on doubly-robust scores from causal forest
dr_scores <- double_robust_scores(cf)
ptree <- policy_tree(X = as.matrix(train[, c("X1","X2","X3","X4")]),
Gamma = dr_scores, depth = 3)
print(ptree) # human-readable tree of "treat if X1<a and X2>b"
plot(ptree)
ggsave("figures/figB4_policy_tree.pdf")
# Off-policy evaluation — DR policy value on holdout
holdout_X <- as.matrix(holdout[, c("X1","X2","X3","X4")])
pred_pol <- predict(ptree, holdout_X)
DR_holdout <- double_robust_scores(cf, newdata = holdout_X)
policy_value_DR <- mean(DR_holdout[cbind(seq_len(nrow(DR_holdout)), pred_pol)])
cat(sprintf("DR policy value (holdout): %.3f\n", policy_value_DR))
B.5 不确定性(保形因果)+ 公平性 + 敏感性分析
# Conformal prediction interval around CATE (split conformal via cfcausal)
# devtools::install_github("lihualei71/cfcausal")
library(cfcausal)
ci90 <- conformalIte(X = as.matrix(train[, c("X1","X2","X3","X4")]),
Y = train$Y, T = train$A,
alpha = 0.1,
algo = "nest",
type = "CQR",
X.test = as.matrix(holdout[, c("X1","X2","X3","X4")]))
# Fairness audit — disparate impact / equalised odds
library(fairmodels)
fobject <- fairness_check(model_treated = predict(ptree, holdout_X),
data = holdout, protected = holdout$sensitive_attr,
privileged = "majority")
plot(fobject)
ggsave("figures/figB5_fairness.pdf")
B.6 机器学习因果推断专用报告清单
保存为 replication/ml_causal_checklist.md:
[ ] Nuisance learners listed (Q model, g model, hyperparameters, CV folds)
[ ] Cross-fitting / sample-splitting documented (DML K-fold)
[ ] Overlap / propensity diagnostics (B.0 + A.2-style overlap plot)
[ ] CATE summary (mean, SD, quartiles) + heterogeneity p-value (grf::test_calibration)
[ ] Policy value with confidence interval (B.4)
[ ] Conformal coverage rate on holdout (B.5)
[ ] Fairness gaps across sensitive attributes (B.5)
[ ] DAG / adjustment set + sensitivity to unmeasured confounding (E-value or Manski bounds)
库速查表
| 步骤 | 任务 | 首选包 | 备选方案 |
|---|---|---|---|
| 1 | 读取数据 | haven / readr / readxl / data.table::fread | Parquet 使用 arrow |
| 1 | 清理名称 | janitor::clean_names | 手动处理 |
| 1 | 缺失值 | naniar / mice | Hmisc |
| 2 | 缩尾处理 | DescTools::Winsorize | 手动使用 pmin/pmax |
| 2 | 面板数据中的滞后项 | dplyr::lag(配合 arrange+group_by) | data.table::shift |
| 3 | 表 1 | gtsummary / modelsummary::datasummary_balance | tableone |
| 3 | 相关性 | psych::corr.test + corrplot | Hmisc::rcorr |
| 4 | 异方差 / 自相关 | lmtest::bptest / dwtest / bgtest | car |
| 4 | 面板检验 | plm::pbgtest / pcdtest / phtest | — |
| 4 | 平稳性 | tseries::adf.test / tseries::kpss.test | urca |
| 5 | OLS / 面板固定效应 | fixest::feols | lfe::felm(较旧) |
| 5 | 工具变量 | fixest::feols(| ~ ) | AER::ivreg / ivreg::ivreg |
| 5 | DID — 2×2 | 使用 i(treated, post) 的 feols | — |
| 5 | DID — CS | did::att_gt | — |
| 5 | DID — SA | fixest::sunab | — |
| 5 | DID — BJS | didimputation::did_imputation | — |
| 5 | DID — SDID | synthdid | — |
| 5 | RD | rdrobust / rddensity / rdmulti | — |
| 5 | 合成控制 | Synth / gsynth / tidysynth | — |
| 5 | 倾向得分匹配 | MatchIt::matchit | — |
| 5 | 逆概率加权 | WeightIt::weightit | — |
| 5 | 熵平衡 | ebal | — |
| 5 | DML | DoubleML | — |
| 5 | CATE(因果森林) | grf::causal_forest | — |
| 5 | 中介分析 | mediation::mediate | lavaan |
| 6 | 野生聚类自助法 | fwildclusterboot::boottest | clubSandwich |
| 6 | 随机化推断 | ri2::conduct_ri | 手动使用 boot |
| 6 | 多重检验 | multcomp / 手动实现 Romano-Wolf | — |
| 6 | TWFE 诊断 | bacondecomp::bacon | — |
| 6 | 平行趋势敏感性分析 | HonestDiD | — |
| 6 | Oster δ* | robomit::o_test / o_beta | — |
| 7 | 边际效应 / 斜率 | marginaleffects::avg_slopes / plot_slopes | — |
| 7 | 带敏感性分析的中介分析 | mediation::mediate + medsens | — |
| 7 | 结构方程模型 | lavaan::sem | — |
| 8 | 回归表(任意格式) | modelsummary | texreg / stargazer |
| 8 | Word 表格 | flextable / gt::gtsave | officer |
| 8 | LaTeX 表格样式 | kableExtra | — |
| 8 | 系数图 / 事件研究 | modelplot / fixest::iplot | 手动使用 ggplot2 |
| 8 | 分箱散点图 | binsreg | — |
| 8 | 多面板图 | cowplot::plot_grid / patchwork | gridExtra |
常见错误(以及正确做法)
| 错误 | 正确做法 |
|---|---|
在大型面板数据上使用 lm(y ~ x + factor(unit) + factor(year)) | `feols(y ~ x |
| 对聚类数据使用默认的 iid 标准误 | feols(..., cluster = ~ id);聚类数 < 50 时使用 boottest |
| 对分期实施的政策使用 TWFE | did::att_gt / fixest::sunab / didimputation::did_imputation |
使用 lag(x),却未调用 arrange() + group_by() | 始终使用 arrange(id, time) %>% group_by(id) %>% mutate(x_l1 = lag(x)) |
| 合并数据时不检查行数 | 在 dplyr::*_join 中使用 relationship 参数,然后执行 stopifnot(nrow(df) == n_before) |
| 直接解读 logit 系数 | 使用 marginaleffects::avg_slopes(model) 计算 AME |
| 只报告点估计 | 始终绘图 — 使用 modelplot、iplot、plot_slopes |
| 手动设置回归表格式 | modelsummary 一次调用即可生成 LaTeX/Word/HTML |
| 只报告核心系数(没有表 2) | 务必提供 M1→M6 多列主表 — 这是经济学论文的核心内容,而不是摘要中的一句话 |
| 系数表没有任何图表 | 经济学研究结果至少需要 F1 趋势图 + F2 事件研究图 + F3 系数图 + F4 敏感性分析 — 参见默认输出规范 |
只将图保存为 .png | LaTeX 投稿还应保存为 .pdf |
| 在脚本中硬编码数据集路径 | 使用 here::here() 和 renv::init() |
| 每次都手动运行测试 | 封装到 targets::tar_make() 或 Quarto 中 |
典型项目骨架
project/
├── R/
│ ├── 01_clean.R # produces data/analysis.rds
│ ├── 02_transform.R
│ ├── 03_describe.R
│ ├── 04_diagnose.R
│ ├── 05_model.R # saves models to estimates/
│ ├── 06_robust.R
│ ├── 07_further.R
│ └── 08_tables_figures.R
├── data/
│ ├── raw/
│ └── analysis.rds
├── tables/
├── figures/
├── estimates/ # saved fixest objects via saveRDS
├── logs/
├── renv.lock # package versions locked
├── _targets.R # or main.qmd / main.R
└── README.md
顶部的 _targets.R(使用 targets 包)或 main.qmd(Quarto)可让整个流水线具备可复现性:
# main.R — minimal driver
source("R/01_clean.R")
source("R/02_transform.R")
source("R/03_describe.R")
source("R/04_diagnose.R")
source("R/05_model.R")
source("R/06_robust.R")
source("R/07_further.R")
source("R/08_tables_figures.R")
有关 Quarto 撰写(结合叙述、代码、表格/图形,并渲染为 PDF/HTML/Word),请参阅 references/08-tables-plots.md §12。
回归表(modelsummary / etable)实用指南(一页配方索引)
modelsummary(...) 和 fixest::etable(...) 是所有多回归表背后的两种基本工具。上述八种模式对应如下:
| 模式 | 列间变化内容 | 步骤 |
|---|---|---|
| A. 逐步加入控制变量 | 协变量集合 / 固定效应深度 | 5.A — 表 2 |
| B. 设计方案赛马比较 | 识别策略(OLS / IV / DID / DML / PSM) | 5.B — 表 2-bis |
| C. 多个结果变量 | 因变量 Y | 5.C — 表 2-ter |
| D. 叠加面板 A / B | 时间跨度 / 样本(面板行 × 规格列) | 5.D — 表 2-quater |
| E. IV 报告三联表 | 第一阶段 / 简化式 / 2SLS | 5.E — 表 2-quinto |
| F. 因果分析编排器 | 1 列,完整诊断(att_gt / synthdid / causal_forest) | 5.F |
| G. 子组表 | 子样本(总体 / 女性 / 男性 / Q1…Q4) | 7 — 表 3 |
| H. 稳健性检验总表 | 汇总所有稳健性检验 | 6.j — 表 A1 |
AER 论文风格的 modelsummary 默认设置:
modelsummary(
list("(1)" = m1, ..., "(N)" = mN),
output = "tables/tableN.tex", # or .docx / .html
stars = c("*" = 0.1, "**" = 0.05, "***" = 0.01), # AER stars
gof_omit = "BIC|AIC|F|Log|Adj",
coef_map = c("training" = "Training"), # pretty names
notes = c("Cluster-robust SE in parentheses.",
"* p<0.10, ** p<0.05, *** p<0.01.")
)
# For multi-panel paper bundles, use gt::gt_group(modelsummary(...), modelsummary(...))
# or render via Quarto for a single .pdf / .docx / .html target.
图形工厂(R 中 12 种标准 AER 图形)
| # | 图形 | R 命令 | 章节 |
|---|---|---|---|
| 1a | 原始趋势(DID 图 1) | df %>% group_by(year, treat) %>% summarise(mean(y)) %>% ggplot() | §1 |
| 1b | 处理实施热力图 | panelView::panelview(...) · ggplot + geom_tile | §1 |
| 2a | 事件研究系数 | `fixest::iplot(feols(y ~ sunab(G, t) | i + t))` |
| 2a' | Bacon 权重 | bacondecomp::bacon + ggplot | §3 |
| 2a'' | CS-DID 动态效应 | did::ggdid(aggte(cs, type="dynamic")) | §3 |
| 2b | 第一阶段散点图 | binsreg::binsreg(y=D, x=Z, w=X) | §3(步骤 3.5.2) |
| 2c | RD 标准图 | rdrobust::rdplot(y, x, c=0) | §3(步骤 3.5.3) |
| 2c' | McCrary 密度图 | rddensity::rdplotdensity(rdd, X) | §3 |
| 2d | 匹配平衡图 | cobalt::love.plot(MatchIt::matchit(...)) | §3(步骤 3.5.4) |
| 2e | SCM 轨迹图 | tidysynth::plot_trends · synthdid::plot · Synth::path.plot | §3(步骤 3.5.5) |
| 3 | 主要规格的系数图 | modelsummary::modelplot(list(m1,...,m6), coefs="training") | §4 |
| 4a | 剂量-反应图 | marginaleffects::plot_predictions(model, condition="dose") | §5 |
| 4b | CATE 分布 | grf::causal_forest(...) + ggplot::geom_histogram(predict(cf)$predictions) | §5 |
| 5 | 规格曲线 | specr::plot(specr(...))(参见 6.k) | §7 |
| 6 | 敏感性分析仪表板 | HonestDiD::createSensitivityPlot · EValue::evalue | §7(步骤 6.l) |
| 7 | 最终主图 | 特定于估计量(rdplot、iplot、Synth::path.plot) | §8 |
每个图形都通过
ggsave()同时导出为.png ≥ 300 dpi(分别用于 LaTeX 和幻灯片 / 网页)。在master.R顶部设置一次theme_set(theme_classic(base_size = 11)),即可保持样式一致。
方法目录
经典 OLS / 面板数据
library(fixest); library(plm); library(sandwich); library(lmtest)
feols(y ~ X, data = df, cluster = ~ i) # OLS (modern primary)
feols(y ~ X | fe1, data = df, cluster = ~ i) # OLS + 1 FE
feols(y ~ X | fe1 + fe2, data = df, cluster = ~ i) # HD FE workhorse
feols(y ~ X | fe1 + fe2, data = df, cluster = ~ fe1 + fe2) # 2-way cluster
fepois(count ~ X | fe1 + fe2, data = df, cluster = ~ i) # Poisson + FE
feglm (y ~ X | fe1, data = df, family = binomial(link = "logit"),
cluster = ~ i) # Logit + FE
plm (y ~ X, data = df, model = "within", index = c("i","t")) # panel FE
plm (y ~ X, data = df, model = "random", index = c("i","t")) # RE (Hausman: phtest)
双重差分
library(fixest); library(did); library(didimputation); library(synthdid); library(bacondecomp); library(HonestDiD); library(DIDmultiplegtDYN)
feols(y ~ i(treated, post, ref = 0) | i + t, df, cluster = ~ i) # 2×2
feols(y ~ sunab(first_treat, year) | i + year, df, cluster = ~ i) # SA event study
att_gt(yname="y", tname="t", idname="i", gname="G", data=df,
control_group="nevertreated", est_method="dr", clustervars="i") # CS-DID
did_imputation(data=df, yname="y", gname="G", tname="t", idname="i",
horizon=0:5, pretrends=-5:-1, cluster_var="i") # BJS imputation
DIDmultiplegtDYN(df, "y", "i", "t", "training", effects=5, placebo=3) # de Chaisemartin
synthdid_estimate(panel.matrices(df,"i","t","y","training"), ...) # synthetic DID
bacon(y ~ training, data=df, id_var="i", time_var="t") # TWFE diagnostic
HonestDiD::createSensitivityResults(...) # PT sensitivity
工具变量 / 2SLS
library(fixest); library(AER); library(ivreg)
feols(y ~ X | D ~ Z, df, cluster = ~ firm_id) # workhorse w/ HD FE
fitstat(iv, ~ ivf + ivwald + sargan + cd) # CD/KP/Sargan/F
AER::ivreg(y ~ D + X | Z + X, data = df) # classic API
summary(iv, vcov. = sandwich, diagnostics = TRUE) # with diagnostics
回归不连续
library(rdrobust); library(rddensity); library(rdmulti)
rdrobust(y, x, c = 0, kernel = "triangular", bwselect = "mserd") # Sharp RD
rdrobust(y, x, c = 0, fuzzy = D) # Fuzzy RD
rddensity(X = x, c = 0) # McCrary density
rdplot(y, x, c = 0)
rdmc(y, x, cutoffs = c(0, 5, 10)) # multi-cutoff
匹配 / 重新加权
library(MatchIt); library(WeightIt); library(cobalt)
matchit (D ~ X1 + X2, data = df, method = "nearest", ratio = 1) # PSM
matchit (D ~ X1 + X2, data = df, method = "cem") # Coarsened EM
weightit(D ~ X1 + X2, data = df, method = "ebal") # entropy balancing
weightit(D ~ X1 + X2, data = df, method = "ps", estimand = "ATE") # IPW
love.plot(matchit_obj, threshold = 0.10) # SMD diagnostic
合成控制
library(Synth); library(gsynth); library(tidysynth); library(synthdid)
Synth::synth(...) # ADH SCM
gsynth(y ~ training, data = df, index = c("i","t"), force = "two-way") # generalized SC
synthdid_estimate(panel.matrices(...)) # synthetic DID
tidysynth::synthetic_control(df, ...) %>% generate_predictor(...) %>%
generate_weights() %>% generate_control()
机器学习因果分析(模式 B — 参见 §B)
library(grf); library(DoubleML); library(mlr3); library(causalDML)
causal_forest(X, Y, W, num.trees = 4000, honesty = TRUE) # GRF causal forest
DoubleML::DoubleMLPLR$new(data, ml_l = lrn("regr.ranger"),
ml_m = lrn("regr.ranger")) # DML PLR
DoubleML::DoubleMLIRM$new(data, ...) # DML interactive
predict(cf)$predictions # CATE per row
average_treatment_effect(cf, target.sample = "treated")
test_calibration(cf); variable_importance(cf)
policytree::policy_tree(X, gamma, depth = 3) # policy tree
稳健性、敏感性与推断
library(fwildclusterboot); library(ri2); library(multcomp); library(robomit); library(EValue)
boottest(model, param = "training", clustid = "state", B = 9999) # wild cluster bootstrap
ri2::conduct_ri(...) # randomization inference
robomit::o_test(...) # Oster δ
EValue::evalue(RR(1.45), lo = 1.10, hi = 1.91) # E-value
fwildclusterboot::boottest(..., type = "rademacher") # alt bootstrap dist
生存分析 / 流行病学(模式 A — 参见 §A)
library(survival); library(survminer); library(survRM2); library(ipw); library(tmle); library(zelig)
survfit(Surv(time, event) ~ A, data = df) # KM
coxph (Surv(time, event) ~ A + X, data = df) # Cox
survreg(Surv(time, event) ~ A + X, data = df, dist = "weibull") # AFT
rmst2 (time, status, arm, tau = 1825) # RMST contrast
ipw::ipwpoint(...) # IPTW
tmle (Y, A, W = X, ...) # TMLE
gfoRmula::gformula_survival(...) # parametric g-formula
TwoSampleMR::mr(...) # Mendelian randomization
何时移交给其他技能
- Agent 原生的单次导入 Python 工作流(
import statspai as sp)→00-StatsPAI_skill。 - 明确使用 Python 传统技术栈 →
00.1-Full-empirical-analysis-skill。 - Stata
.do流水线 →00.2-Full-empirical-analysis-skill_Stata。 - 跨语言 Mixtape 模板(Python/R/Stata 并列)→
10-Jill0099-causal-inference-mixtape。 - 贝叶斯 R 工作流(
brms/rstan/cmdstanr)→23-Learning-Bayesian-Statistics-baygent-skills。 - 分析完成后的论文起草 → 本仓库中的写作技能。
本技能在第 8 步结束——输出 .tex / .docx 表格和 .pdf 图。论文起草不在范围内。
第 8.5 步——移交给手稿(退出契约)
本技能的职责仍在第 8 步结束。不过,“结束”不应意味着“无路可走”: 写作阶段需要机器可读的契约,而不是一堆零散文件。 停止前,请在表格和图旁生成两个文件。
1. exhibits_index.md——每个编号的展项占一行:
| 展项 | 文件 | 支持的论点 | 生成者 |
|---|---|---|---|
| 表 2 | tables/table2_main.{tex,docx,xlsx} | 政策对对数产出的主要影响 | analysis.R §baseline |
| 图 2 | figures/fig2_event_study.{png,pdf} | 不存在差异化的前趋势 | analysis.R §event-study |
2. results_summary.json——每个重要估计值都作为一条扁平记录:
{"baseline": {"coef": 0.1234, "se": 0.0412, "p": 0.0031, "n": 12345, "spec": "TWFE + region-year FE"}}
为什么需要这两项,以及为什么采用这种格式:
- 手稿阶段通过包含指令引用展项,而不是重新输入数字——在 LaTeX 中使用
\input{tables/table2_main},在 Markdown 中使用{{ include: table2_main }}。 索引会告诉写作者哪个文件对应哪个论点。 - 论文中印出的每个数字,都必须能以其显示精度追溯到结果文件。
results_summary.json能让这一核查可行,而非只能依赖信任。若某个系数只存在于渲染后的表格中,就无法 对照引用它的正文进行验证。
然后移交:
- 从头到尾撰写完整论文 → Word
.docx/ LaTeX →skills/69-Paper-WorkFlow/。它负责 协调第 5–9 阶段(起草 → 润色 → 去除 AI 生成痕迹 → 评审 → 投稿),其scripts/assemble_manuscript_docx.py会根据这两个文件,将09_submission/main.docx组装为一个文件,其中包含正文、上述所有展项、图和参考文献列表。请在其第 0 阶段 选择正文格式:交付 Word 时使用 Markdown(Markdown →.docx保真度高; LaTeX →.docx会有损),投稿 venue 接受.tex时使用 LaTeX。 - 仅撰写正文 → 本仓库中的写作技能(
04-*-scientific-writer、35-*-academic-writing-skills)。 - 仅进行 LaTeX / Quarto 排版 →
08-ndpvt-web-latex-document-skill、60-regisely-superpapers。