生物统计学基础

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10

学习目标：通过本章学习，读者将系统掌握生物统计学的核心概念、参数估计与假设检验方法、常用统计模型、高维统计方法、统计学习基础以及因果推断思想。学完本章后，你将能够：(1) 理解总体与样本的关系，正确描述数据特征；(2) 掌握区间估计和假设检验的完整流程，能独立进行Z检验、t检验、方差分析和卡方检验；(3) 理解线性模型、Logistic回归、Cox模型等统计模型的原理与应用；(4) 了解高维数据下的正则化方法和变量筛选思想；(5) 理解有监督与无监督学习的基本算法；(6) 认识因果推断的核心概念，理解混杂因素和工具变量方法。
核心问题：生物学研究中，我们如何从有限的样本数据中推断总体规律？如何判断观察到的差异是真实的生物学效应还是随机波动？当数据维度远超样本量时，如何构建可靠的统计模型？如何从观察性数据中推断因果关系？

# 设置随机种子，保证结果可重复
set.seed(42)
# 模拟总体：假设总体有10000个学生的身高，服从正态分布N(170, 10^2)
population <- rnorm(10000, mean = 170, sd = 10)
# 简单随机抽样：从中抽取100个样本
sample_data <- sample(population, size = 100, replace = FALSE)
# 查看样本基本信息
cat("总体均值:", mean(population), "\n")
cat("样本均值:", mean(sample_data), "\n")
cat("样本容量:", length(sample_data), "\n")
# 可视化：总体分布 vs 样本分布
par(mfrow = c(1, 2))
hist(population, breaks = 50, main = "总体分布", xlab = "身高(cm)")
hist(sample_data, breaks = 20, main = "样本分布", xlab = "身高(cm)")

概念定义：在统计学中，数据类型决定了我们可以使用哪些统计方法。每个变量都属于一个特定的数据类型，正确识别数据类型是选择适当分析方法的前提。
数据类型分类：
| 数据类型 | 子类型 | 定义 | 示例 |
|---------|--------|------|------|
| 数值型 | 连续型 | 在一定范围内可以取任意数值 | 身高、体重、血压、基因表达量 |
| | 离散型 | 只能取有限或可数数值 | 细胞计数、家庭成员数、突变位点数 |
| 分类型 | - | 表示不同类别，无数值大小意义 | 性别、血型、基因型 |
| 顺序型 | - | 可以排序，但差值无意义 | 肿瘤分期（I/II/III/IV）、烧伤程度 |

统计量与参数：
- 统计量（Statistic）：基于样本数据计算的数值，用来描述样本特征。如样本均值 $\bar{X}$、样本标准差 $s$。
- 参数（Parameter）：描述总体特征的数值，通常是未知的。如总体均值 $\mu$、总体标准差 $\sigma$。
常用统计量：
(1) 均值（Mean）
样本均值是所有观测值的总和除以观测值个数：
$$\bar{X} = \frac{1}{n}\sum_{i=1}^{n} X_i \tag{2-1}$$
均值反映了数据的"重心"，是最常用的集中趋势度量。但对极端值（离群值）敏感。
(2) 中位数（Median）
将数据从小到大排列后处于中间位置的值：
$$\widetilde{X} = \begin{cases} X_{\frac{n+1}{2}} & \text{（n为奇数）} \ \frac{1}{2}\left(X_{\frac{n}{2}} + X_{\frac{n}{2}+1}\right) & \text{（n为偶数）} \end{cases} \tag{2-2}$$
中位数不受极端值影响，是稳健的集中趋势度量。当数据分布偏斜时，中位数比均值更能代表"典型"值。
(3) 众数（Mode）
数据中出现频率最高的值。一个数据集可以有多个众数，也可以没有众数。
(4) 极差（Range）
$R = X_{\max} - X_{\min}$
极差是最简单的离散程度度量，但只利用了两个极端值，对数据分布的中间部分不敏感。
(5) 方差（Variance）与标准差（Standard Deviation）
方差衡量数据偏离均值的平均程度。样本方差定义为：
$$s^2 = \frac{1}{n-1}\sum_{i=1}^{n}(X_i - \bar{X})^2 \tag{2-3}$$
注意分母是 $n-1$ 而不是 $n$，这是为了得到总体方差的无偏估计（称为贝塞尔校正）。标准差是方差的平方根：$s = \sqrt{s^2}$。
为什么分母是 $n-1$ 而不是 $n$？
这是一个初学者最常困惑的问题。证明如下：
设总体方差为 $\sigma^2 = E[(X - \mu)^2]$，考虑样本方差 $s^2 = \frac{1}{n-1}\sum(X_i - \bar{X})^2$。
$$\sum(X_i - \bar{X})^2 = \sum[(X_i - \mu) - (\bar{X} - \mu)]^2 = \sum(X_i - \mu)^2 - n(\bar{X} - \mu)^2$$
取期望：
$$E\left[\sum(X_i - \bar{X})^2\right] = \sum E[(X_i - \mu)^2] - nE[(\bar{X} - \mu)^2] = n\sigma^2 - n\cdot\frac{\sigma^2}{n} = (n-1)\sigma^2$$
因此 $E[s^2] = \sigma^2$，即 $s^2$ 是 $\sigma^2$ 的无偏估计。如果使用分母 $n$，则会系统性地低估总体方差。
(6) 四分位距（IQR）
将数据从小到大排列后四等分，三个分位点分别称为第一四分位数 $Q_1$（第25百分位数）、第二四分位数 $Q_2$（中位数，第50百分位数）、第三四分位数 $Q_3$（第75百分位数）。
$$IQR = Q_3 - Q_1$$
IQR包含了中间50%的数据，是稳健的离散程度度量。
(7) 变异系数（CV）
$$CV = \frac{s}{\bar{X}} \times 100\%$$
变异系数消除了量纲影响，用于比较不同单位或不同量级数据的离散程度。
(8) 偏度（Skewness）
衡量数据分布的不对称程度：
$$g_1 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^3}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^{3/2}} \tag{2-4}$$
- $g_1 > 0$：右偏（正偏），长尾在右侧，均值 > 中位数
- $g_1 < 0$：左偏（负偏），长尾在左侧，均值 < 中位数
- $g_1 = 0$：对称分布
(9) 峰度（Kurtosis）
衡量数据分布的尖峭程度（相对于正态分布）：
$$g_2 = \frac{\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^4}{\left[\frac{1}{n}\sum_{i=1}^{n}(X_i - \bar{X})^2\right]^2} - 3 \tag{2-5}$$
- $g_2 > 0$：比正态分布更尖峭（重尾，离群值更多）
- $g_2 < 0$：比正态分布更扁平（轻尾，数据更集中）
- $g_2 = 0$：正态分布的峰度（注意：有些软件不减3，此时正态分布峰度为3）

(1) 频数频率表
将数据分组后，统计每组的频数和频率。频率 = 频数 / 总数。
(2) 直方图（Histogram）
用矩形面积表示每个区间内数据的频数或频率。矩形的高度代表频数密度（频数/组距），面积代表频数。直方图可以直观地展示数据的分布形态（对称、偏态、单峰、多峰等）。
(3) 散点图（Scatter Plot）
在二维坐标平面上绘制两个连续变量的观测点，用于探索变量之间的关系。可以初步判断是否存在线性或非线性关系、相关性的方向以及是否有离群值。
(4) 箱线图（Box Plot）
箱线图是展示数据分布的利器，它显示了：
- 中位数（箱体中的横线）
- 四分位距（箱体的上下边界）
- 数据的整体范围（延伸线，通常延伸到 $Q_1 - 1.5 \times IQR$ 和 $Q_3 + 1.5 \times IQR$）
- 离群值（延伸线之外的点）
箱线图特别适合比较多个组别的分布。
(5) 折线图（Line Chart）
连接数据点形成的图形，常用于显示数据随时间变化的趋势。

# 小鼠体重数据
weight <- c(18.5, 22.3, 19.7, 21.0, 20.5, 23.1, 20.0, 19.2, 21.5, 20.8)
# 基本统计量
mean(weight)       # 均值
median(weight)     # 中位数
sd(weight)         # 标准差（注意R默认使用n-1）
var(weight)        # 方差
range(weight)      # 极差
quantile(weight, c(0.25, 0.75))  # 四分位数
IQR(weight)        # 四分位距
# 综合描述性统计
summary(weight)
# 绘制图形
par(mfrow = c(2, 2))
hist(weight, main = "体重分布直方图", xlab = "体重(g)", col = "lightblue")
boxplot(weight, main = "体重箱线图", ylab = "体重(g)", col = "lightgreen")
# 模拟两组数据比较
group1 <- rnorm(30, mean = 20, sd = 2)
group2 <- rnorm(30, mean = 22, sd = 2)
boxplot(list(组1 = group1, 组2 = group2), 
        main = "两组体重比较", ylab = "体重(g)", col = c("pink", "lightblue"))
# 散点图：体重与身高的关系
height <- c(10.2, 11.5, 10.8, 11.0, 11.2, 12.0, 10.5, 10.3, 11.8, 11.1)
plot(height, weight, main = "体重 vs 身高", xlab = "身高(cm)", ylab = "体重(g)", 
     pch = 19, col = "blue")
abline(lm(weight ~ height), col = "red", lwd = 2)  # 添加回归线

# 演示中心极限定理
set.seed(123)
# 从一个非正态分布（指数分布）中抽样
pop_data <- rexp(100000, rate = 1)  # 指数分布，均值=1，方差=1
# 反复抽取样本，计算样本均值
sample_means <- replicate(10000, mean(sample(pop_data, size = 30)))
# 可视化：原始分布 vs 样本均值的抽样分布
par(mfrow = c(1, 2))
hist(pop_data, breaks = 100, main = "总体分布（指数分布）", xlab = "x", xlim = c(0, 5))
hist(sample_means, breaks = 50, main = "样本均值分布（n=30）", xlab = "样本均值", 
     freq = FALSE, xlim = c(0, 3))
# 叠加理论正态分布曲线
x_seq <- seq(0, 3, length.out = 100)
lines(x_seq, dnorm(x_seq, mean = 1, sd = 1/sqrt(30)), col = "red", lwd = 2)
legend("topright", legend = "理论正态分布", col = "red", lwd = 2)

2.2.2 区间估计

# 手动计算置信区间
hemoglobin_change <- c(2.5, 3.1, 1.8, 2.9, 3.5, 2.2, 2.7, 3.0, 2.4, 2.8,
                       3.2, 2.6, 2.1, 3.3, 2.0, 2.5, 2.9, 3.1, 2.3, 2.7)
n <- length(hemoglobin_change)
x_bar <- mean(hemoglobin_change)
s <- sd(hemoglobin_change)
se <- s / sqrt(n)
# 95% 置信区间（t分布）
t_crit <- qt(0.975, df = n - 1)
ci_lower <- x_bar - t_crit * se
ci_upper <- x_bar + t_crit * se
cat("95% 置信区间: (", round(ci_lower, 3), ", ", round(ci_upper, 3), ")\n")
# 使用R内置函数（更简洁）
t.test(hemoglobin_change, conf.level = 0.95)$conf.int
# 不同置信水平的比较
cat("90% CI:", t.test(hemoglobin_change, conf.level = 0.90)$conf.int, "\n")
cat("99% CI:", t.test(hemoglobin_change, conf.level = 0.99)$conf.int, "\n")

2.2.3 假设检验

当总体服从正态分布且方差 $\sigma^2$ 已知时，使用Z检验。
检验统计量：
$$Z = \frac{\bar{X} - \mu_0}{\sigma/\sqrt{n}} \tag{2-9}$$
在原假设 $H_0$ 下，$Z \sim N(0,1)$。
拒绝域：
- 双侧检验 $H_0: \mu = \mu_0$ vs $H_A: \mu \neq \mu_0$：$|Z| \geq Z_{1-\alpha/2}$
- 右侧检验 $H_0: \mu \leq \mu_0$ vs $H_A: \mu > \mu_0$：$Z \geq Z_{1-\alpha}$
- 左侧检验 $H_0: \mu \geq \mu_0$ vs $H_A: \mu < \mu_0$：$Z \leq Z_{\alpha}$

当总体方差未知时，用样本方差 $s^2$ 代替，检验统计量服从t分布。
单样本t检验：
$$T = \frac{\bar{X} - \mu_0}{s/\sqrt{n}} \tag{2-10}$$
在原假设 $H_0$ 下，$T \sim t(n-1)$。
两独立样本t检验：
假设两个正态总体 $N(\mu_1, \sigma_1^2)$ 和 $N(\mu_2, \sigma_2^2)$，检验 $H_0: \mu_1 = \mu_2$。
情况一：方差齐性（$\sigma_1^2 = \sigma_2^2$）
使用合并方差（pooled variance）：
$$s_w^2 = \frac{(n_1-1)s_1^2 + (n_2-1)s_2^2}{n_1 + n_2 - 2}$$
$$T = \frac{\bar{X}1 - \bar{X}_2}{s_w\sqrt{\frac{1}{n_1} + \frac{1}{n_2}}} \sim t(n_1 + n_2 - 2) \tag{2-11}$$
情况二：方差不齐（Welch's t检验）
$$T = \frac{\bar{X}_1 - \bar{X}_2}{\sqrt{\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}}} \tag{2-12}$$
自由度使用Satterthwaite近似：
$$v = \frac{\left(\frac{s_1^2}{n_1} + \frac{s_2^2}{n_2}\right)^2}{\frac{(s_1^2/n_1)^2}{n_1-1} + \frac{(s_2^2/n_2)^2}{n_2-1}}$$
Welch's t检验不假设方差齐性，在实际中更为稳健，应作为默认选择。
配对t检验：
当两组数据是配对设计（如同一患者治疗前后），计算差值 $d_i = X{i1} - X_{i2}$，然后对差值进行单样本t检验：
$$T = \frac{\bar{d}}{s_d/\sqrt{n}} \sim t(n-1) \tag{2-13}$$
配对设计控制了患者间的个体差异，通常比独立样本检验具有更高的检验效能。

# 单样本t检验
# 检验某药物是否使血压平均降低10 mmHg
blood_pressure <- c(145, 142, 138, 140, 148, 135, 139, 141, 136, 143,
                    137, 144, 140, 138, 142, 139, 141, 137, 143, 140)
# H0: mu = 150 (假设原血压均值150), H1: mu != 150
t.test(blood_pressure, mu = 150)
# 两独立样本t检验（Welch's t检验，默认）
group_A <- c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7)
group_B <- c(13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5)
t.test(group_A, group_B)  # 默认var.equal=FALSE
# 配对t检验
before <- c(152, 153, 155, 146, 166, 160, 141, 152, 151, 151)
after <- c(150, 135, 146, 142, 140, 150, 141, 129, 127, 137)
t.test(before, after, paired = TRUE)
# 计算效应量（Cohen's d）
# 效应量衡量差异的实际重要性，不仅仅是统计显著性
cohens_d <- function(x, y) {
  mean_diff <- mean(x) - mean(y)
  pooled_sd <- sqrt((var(x) + var(y)) / 2)
  return(mean_diff / pooled_sd)
}
cohens_d(group_A, group_B)

2.2.5 方差分析

# 单因素方差分析
fertilizer_data <- data.frame(
  height = c(18.3, 19.3, 24.7, 20.2, 20.4, 25.1, 21.4, 16.2, 17.9, 18.7,
             13.0, 20.4, 24.4, 7.3, 21.1, 21.5, 16.1, 16.3, 16.2, 14.5,
             20.9, 19.1, 26.0, 23.3, 23.3, 28.1, 23.1, 25.0, 27.1, 24.2,
             15.3, 16.5, 17.2, 20.9, 13.0, 19.0, 14.3, 21.8, 15.5, 19.7),
  group = factor(rep(c("A", "B", "C", "D"), each = 10))
)
# ANOVA
anova_result <- aov(height ~ group, data = fertilizer_data)
summary(anova_result)
# 方差齐性检验（Levene检验）
# install.packages("car")
library(car)
leveneTest(height ~ group, data = fertilizer_data)
# 事后检验：Tukey HSD
TukeyHSD(anova_result)
# 可视化
boxplot(height ~ group, data = fertilizer_data, 
        main = "不同肥料对植物高度的影响", ylab = "高度(cm)", col = "lightblue")
# 双因素方差分析示例
# 假设研究肥料类型和光照条件对植物高度的影响
two_way_data <- data.frame(
  height = c(rnorm(10, 20, 2), rnorm(10, 25, 2), rnorm(10, 18, 2), rnorm(10, 22, 2)),
  fertilizer = factor(rep(c("A", "A", "B", "B"), each = 10)),
  light = factor(rep(c("Low", "High"), each = 20))
)
aov_two <- aov(height ~ fertilizer * light, data = two_way_data)
summary(aov_two)

2.2.6 多重检验校正

# 模拟10000个基因的p值
# 其中100个基因真实差异表达，9900个无差异
set.seed(42)
p_values <- c(
  rbeta(100, 1, 50) * 0.05,  # 显著基因（小p值）
  runif(9900, 0, 1)           # 非显著基因（均匀分布）
)
# Bonferroni校正
p_bonferroni <- p.adjust(p_values, method = "bonferroni")
sum(p_bonferroni < 0.05)  # 非常保守，发现很少
# BH校正（FDR控制）
p_bh <- p.adjust(p_values, method = "BH")
sum(p_bh < 0.05)  # 更合理，发现更多
# 可视化p值分布
hist(p_values, breaks = 50, main = "p值分布", xlab = "p值")
# 火山图：展示p值与效应量的关系
# 通常用于差异表达分析
log_fc <- rnorm(10000)  # 模拟log fold change
plot(log_fc, -log10(p_values), pch = 20, 
     xlab = "log2 Fold Change", ylab = "-log10(p值)",
     main = "火山图", col = ifelse(p_bh < 0.05, "red", "gray"))
abline(h = -log10(0.05/10000), col = "blue", lty = 2)  # Bonferroni阈值
abline(h = -log10(max(p_values[p_bh < 0.05])), col = "green", lty = 2)  # BH阈值

2.2.7 卡方检验

# 拟合优度检验：孟德尔实验
observed <- c(315, 108, 101, 32)
expected_prop <- c(9, 3, 3, 1) / 16
chisq.test(observed, p = expected_prop)
# 独立性检验：基因型与疾病
genotype_disease <- matrix(c(38, 12, 40, 33, 52, 25), nrow = 3, byrow = TRUE)
rownames(genotype_disease) <- c("AA", "Aa", "aa")
colnames(genotype_disease) <- c("患病", "未患病")
chisq.test(genotype_disease)
# 如果期望频数小于5，使用Fisher精确检验
fisher.test(genotype_disease)
# 查看期望频数
chisq.test(genotype_disease)$expected
# 卡方检验的模拟（Monte Carlo）
chisq.test(genotype_disease, simulate.p.value = TRUE, B = 10000)

2.2.8 非参数检验方法

# Wilcoxon符号秩检验（配对）
before <- c(143, 164, 129, 151, 171, 153, 134, 128, 164, 154)
after <- c(147, 166, 133, 142, 155, 153, 142, 143, 136, 151)
wilcox.test(before, after, paired = TRUE)
# Mann-Whitney U检验（独立样本）
group1 <- c(15, 18, 22, 19, 25, 20, 21, 17)
group2 <- c(12, 14, 16, 13, 15, 18, 11, 14)
wilcox.test(group1, group2)  # 默认exact=TRUE当n<50
# Kruskal-Wallis检验
# 三组小鼠的跑迷宫时间
strain_A <- c(12, 15, 18, 14, 16, 13)
strain_B <- c(22, 25, 19, 24, 21, 23)
strain_C <- c(30, 28, 32, 29, 31, 27)
kruskal.test(list(A = strain_A, B = strain_B, C = strain_C))
# 事后检验：Dunn检验（带Bonferroni校正）
# install.packages("dunn.test")
library(dunn.test)
dunn.test(c(strain_A, strain_B, strain_C), 
          g = factor(rep(c("A", "B", "C"), each = 6)), method = "bonferroni")

# 使用MASS包中的Pima数据
# install.packages("MASS")
library(MASS)
data(Pima.tr)
# 建立线性模型
model <- lm(glu ~ bmi + age, data = Pima.tr)
summary(model)
# 模型诊断图
par(mfrow = c(2, 2))
plot(model)
# 提取系数和置信区间
confint(model, level = 0.95)
# 预测新数据
new_data <- data.frame(bmi = c(25, 30, 35), age = c(30, 45, 60))
predict(model, newdata = new_data, interval = "confidence")
# 检查多重共线性
# install.packages("car")
library(car)
vif(model)

2.3.2 极大似然估计法

# 手动实现MLE估计正态分布参数
x <- rnorm(100, mean = 5, sd = 2)  # 真实参数mu=5, sigma=2
# 对数似然函数
log_likelihood <- function(params, data) {
  mu <- params[1]
  sigma <- params[2]
  n <- length(data)
  -n/2 * log(2*pi*sigma^2) - sum((data - mu)^2) / (2*sigma^2)
}
# 最大化对数似然（R中通过最小化负对数似然实现）
neg_log_lik <- function(params, data) -log_likelihood(params, data)
result <- optim(par = c(0, 1), fn = neg_log_lik, data = x, method = "L-BFGS-B",
                lower = c(-Inf, 0.01))
result$par  # MLE估计值
# 与样本均值和标准差比较
c(mean(x), sd(x))  # 注意sd使用n-1，MLE使用n
# R中直接使用最大似然估计的包
# install.packages("bbmle")
library(bbmle)

2.3.3 Logistic回归模型

# Logistic回归
# install.packages("MASS")
library(MASS)
data(birthwt)
# 建立Logistic回归模型
model_logit <- glm(low ~ age + lwt + race + smoke + ht, 
                   data = birthwt, family = binomial(link = "logit"))
summary(model_logit)
# 提取OR及其置信区间
exp(cbind(coef(model_logit), confint(model_logit)))
# 模型评估：ROC曲线
# install.packages("pROC")
library(pROC)
prob <- predict(model_logit, type = "response")
roc_obj <- roc(birthwt$low, prob)
plot(roc_obj, main = paste("AUC =", round(auc(roc_obj), 3)))
# Probit模型
model_probit <- glm(low ~ age + lwt + race + smoke + ht,
                    data = birthwt, family = binomial(link = "probit"))
summary(model_probit)

2.3.4 泊松回归模型

# 泊松回归示例：某基因在不同处理组中的表达计数
# 模拟数据
count_data <- data.frame(
  count = c(rpois(10, 5), rpois(10, 10), rpois(10, 15)),
  treatment = factor(rep(c("Control", "Low", "High"), each = 10)),
  size_factor = rep(c(1.0, 1.1, 0.9), each = 10)  # 测序深度
)
# 泊松回归（带偏移量）
model_pois <- glm(count ~ treatment + offset(log(size_factor)), 
                  data = count_data, family = poisson)
summary(model_pois)
# 检验过度离散
dispersion <- sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)
cat("离散参数:", dispersion, "\n")
# 如果过度离散，使用负二项回归
# install.packages("MASS")
library(MASS)
model_nb <- glm.nb(count ~ treatment + offset(log(size_factor)), data = count_data)
summary(model_nb)

2.3.5 Cox比例风险模型

# Cox比例风险模型
# install.packages("survival")
library(survival)
data(lung)
# 建立Cox模型
model_cox <- coxph(Surv(time, status) ~ age + sex + ph.ecog, data = lung)
summary(model_cox)
# 检验比例风险假设
# install.packages("survminer")
library(survminer)
cox.zph(model_cox)
# 绘制生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
ggsurvplot(fit, pval = TRUE, conf.int = TRUE, 
           title = "不同性别患者的生存曲线",
           xlab = "天数", ylab = "生存概率")
# 预测
new_patients <- data.frame(age = c(60, 70), sex = c(1, 2), ph.ecog = c(1, 2))
fit_new <- survfit(model_cox, newdata = new_patients)
plot(fit_new, col = 1:2, xlab = "天数", ylab = "生存概率")
legend("bottomleft", legend = c("患者1", "患者2"), col = 1:2, lty = 1)

2.3.6 线性混合效应模型

# 线性混合效应模型
# install.packages("lme4")
library(lme4)
# install.packages("lmerTest")
library(lmerTest)
# 使用sleepstudy数据（sleep deprivation study）
data(sleepstudy)
# 模型：反应时间 ~ 天数 + (1|受试者)
# 固定效应：天数；随机效应：受试者截距
model_lmm <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
summary(model_lmm)
# 随机斜率模型：每个受试者有自己的截距和斜率
model_lmm2 <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy)
summary(model_lmm2)
# 计算ICC
# ICC = 随机效应方差 / (随机效应方差 + 残差方差)
variance_components <- as.data.frame(VarCorr(model_lmm))
icc <- variance_components[1, 4] / (variance_components[1, 4] + variance_components[2, 4])
cat("ICC:", icc, "\n")
# 可视化：每个受试者的拟合线
library(ggplot2)
ggplot(sleepstudy, aes(x = Days, y = Reaction, color = Subject)) +
  geom_line() +
  geom_smooth(method = "lm", se = FALSE) +
  theme(legend.position = "none") +
  labs(title = "各受试者反应时间随天数的变化")

2.3.7 隐马尔可夫模型

# HMM在R中的实现
# install.packages("HMM")
library(HMM)
# 定义HMM
# 3个隐藏状态：健康、轻度疾病、重度疾病
# 3个观测状态：无症状、轻微症状、严重症状
states <- c("健康", "轻度", "重度")
symbols <- c("无症状", "轻微", "严重")
# 初始概率
start_probs <- c(0.7, 0.2, 0.1)
# 转移概率矩阵
trans_probs <- matrix(c(
  0.7, 0.2, 0.1,
  0.1, 0.6, 0.3,
  0.05, 0.15, 0.8
), nrow = 3, byrow = TRUE)
# 观测概率矩阵
emission_probs <- matrix(c(
  0.9, 0.08, 0.02,
  0.05, 0.9, 0.05,
  0.01, 0.2, 0.79
), nrow = 3, byrow = TRUE)
hmm_model <- initHMM(States = states, Symbols = symbols,
                     startProbs = start_probs,
                     transProbs = trans_probs,
                     emissionProbs = emission_probs)
# 观测序列：无症状、轻微、无症状、轻微、严重
observation <- c("无症状", "轻微", "无症状", "轻微", "严重")
# Viterbi算法：解码最可能的状态序列
viterbi_result <- viterbi(hmm_model, observation)
print(viterbi_result)
# 前向算法：计算观测序列的概率
forward_result <- forward(hmm_model, observation)
print(exp(forward_result[, ncol(forward_result)]))  # 最终概率
# Baum-Welch算法：从数据中学习参数
# 需要多个观测序列来训练
train_obs <- list(
  c("无症状", "轻微", "无症状"),
  c("无症状", "无症状", "轻微", "严重"),
  c("轻微", "严重", "严重", "严重")
)
# baumWelch(hmm_model, train_obs)  # 需要足够的数据

2.3.8 贝叶斯统计基础

# 贝叶斯分析：硬币问题
# 先验 Beta(2, 2)，数据 7次正面/10次抛掷
# 先验分布
alpha_prior <- 2
beta_prior <- 2
# 数据
n <- 10
y <- 7
# 后验分布
alpha_post <- alpha_prior + y
beta_post <- beta_prior + n - y
# 可视化
p_seq <- seq(0, 1, length.out = 1000)
prior_density <- dbeta(p_seq, alpha_prior, beta_prior)
likelihood <- dbeta(p_seq, y + 1, n - y + 1)  # 归一化似然
posterior_density <- dbeta(p_seq, alpha_post, beta_post)
plot(p_seq, posterior_density, type = "l", col = "blue", lwd = 2,
     xlab = "theta", ylab = "密度", main = "先验 vs 后验")
lines(p_seq, prior_density, col = "red", lwd = 2, lty = 2)
lines(p_seq, likelihood / max(likelihood) * max(posterior_density), 
      col = "green", lwd = 2, lty = 3)
legend("topright", legend = c("后验", "先验", "似然（归一化）"),
       col = c("blue", "red", "green"), lwd = 2, lty = c(1, 2, 3))
# 后验统计量
cat("后验均值:", alpha_post / (alpha_post + beta_post), "\n")
cat("后验MAP:", (alpha_post - 1) / (alpha_post + beta_post - 2), "\n")
cat("95% 可信区间:", qbeta(c(0.025, 0.975), alpha_post, beta_post), "\n")
# 使用RStan进行复杂贝叶斯分析
# install.packages("rstan")
library(rstan)
# Stan模型代码（简单版本）
stan_code <- "
data {
  int<lower=0> n;
  int<lower=0, upper=n> y;
}
parameters {
  real<lower=0, upper=1> theta;
}
model {
  theta ~ beta(2, 2);  // 先验
  y ~ binomial(n, theta);  // 似然
}
"
fit <- stan(model_code = stan_code, data = list(n = 10, y = 7), 
            iter = 2000, chains = 4)
print(fit)
stan_hist(fit)

# install.packages("glmnet")
library(glmnet)
# 模拟高维数据
set.seed(123)
n <- 100
p <- 500
X <- matrix(rnorm(n * p), n, p)
# 真实稀疏系数
beta_true <- c(rep(5, 5), rep(-3, 5), rep(0, p - 10))
Y <- X %*% beta_true + rnorm(n, sd = 2)
# 交叉验证选择最优lambda
cv_fit <- cv.glmnet(X, Y, alpha = 1, nfolds = 10)
plot(cv_fit)
# 提取LASSO系数
lasso_coef <- as.matrix(coef(cv_fit, s = "lambda.1se"))  # 更简洁的模型
selected_vars <- which(lasso_coef[-1] != 0)
cat("选中的变量数:", length(selected_vars), "\n")
cat("选中的变量:", selected_vars, "\n")
cat("真实非零变量:", which(beta_true != 0), "\n")
# 岭回归
cv_ridge <- cv.glmnet(X, Y, alpha = 0)
ridge_coef <- coef(cv_ridge, s = "lambda.min")
# Elastic Net（LASSO和Ridge的折中）
cv_en <- cv.glmnet(X, Y, alpha = 0.5)

2.4.2 变量筛选

Elastic Net：
结合L1和L2惩罚：
$$\hat{\beta}{en} = \arg\min{\beta} |Y - X\beta|^2 + \lambda_1 |\beta|1 + \lambda_2 |\beta|_2^2 \tag{2-27}$$
优点：
- 保留LASSO的变量选择能力
- 像Ridge一样处理多重共线性，将相关变量同时选入或同时排除
- 当 $p > n$ 时，可以选择超过 $n$ 个变量
Group LASSO：
当变量有自然的分组结构时（如基因通路中一组基因），对整组进行选择和收缩：
$$\hat{\beta}{group} = \arg\min_{\beta} |Y - X\beta|^2 + \lambda \sum_{g=1}^{G} |\beta_g|2$$
其中 $\beta_g$ 是第 $g$ 组变量的系数向量。Group LASSO要么选择整组，要么完全排除整组。
SCAD（Smoothly Clipped Absolute Deviation）：
SCAD惩罚是为了解决LASSO的有偏性问题：
$$P{\lambda}(\beta) = \begin{cases} \lambda |\beta| & |\beta| \leq \lambda \ \frac{2a\lambda|\beta| - \beta^2 - \lambda^2}{2(a-1)} & \lambda < |\beta| \leq a\lambda \ \frac{(a+1)\lambda^2}{2} & |\beta| > a\lambda \end{cases}$$
其中 $a > 2$（通常取3.7）。SCAD对小的系数进行LASSO式收缩，但对大的系数几乎不收缩，从而减少了估计偏差。SCAD具有Oracle性质：能够以概率1正确选择变量，并且估计量与仅使用真实变量的Oracle估计量具有相同的渐近分布。
MCP（Minimax Concave Penalty）：
$$P_{\lambda}(\beta) = \lambda \int_0^{|\beta|} \left(1 - \frac{x}{\gamma\lambda}\right)+ dx$$
MCP也旨在减少LASSO的偏差，计算更简单。
贝叶斯LASSO：
将LASSO的L1惩罚解释为Laplace先验（双指数分布）：
$$p(\beta) = \frac{\lambda}{2} e^{-\lambda|\beta|}$$
然后通过MCMC方法从后验分布中抽样。贝叶斯LASSO的优点是可以自然地获得参数的不确定性估计（后验标准差），而不仅仅是一个点估计。
Dantzig Selector：
与LASSO类似，但约束形式不同：
$$\min |\beta|_1 \quad \text{s.t.} \quad |X^T(Y - X\beta)|\infty \leq \lambda$$
在某些理论条件下，Dantzig Selector具有与LASSO类似的性质。

决策树（Decision Tree）是一种递归分割的模型，将特征空间划分为多个区域，每个区域赋予一个预测值。
回归树：
- 对于每个节点，选择最优的分裂变量和分裂点，使左右子节点的响应变量方差之和最小
- 叶子节点的预测值是该节点内所有样本响应变量的均值
决策树（分类）：
- 选择使不纯度（如基尼指数、信息熵）减少最多的分裂
- 叶子节点的预测值是类别多数表决
基尼指数（Gini Index）：
$$Gini = 1 - \sum_{k=1}^{K} p_k^2$$
其中 $p_k$ 是节点中第 $k$ 类的比例。Gini越小，节点纯度越高。
信息熵（Entropy）：
$$Entropy = -\sum_{k=1}^{K} p_k \log p_k$$
信息增益（Information Gain）：
$$IG = Entropy_{parent} - \frac{n_{left}}{n} Entropy_{left} - \frac{n_{right}}{n} Entropy_{right}$$
选择使信息增益最大的分裂。
决策树的优缺点：
- 优点：可解释性强，不需要特征缩放，能处理非线性关系
- 缺点：容易过拟合，不稳定（小的数据变化可能导致完全不同的树），预测精度通常不如集成方法

Bagging（Bootstrap Aggregating）：通过自助采样（bootstrap）生成多个训练集，分别训练模型，最后将预测结果平均（回归）或投票（分类）。
Bootstrap：从原始数据中有放回地抽样，生成与原始数据量相同的新样本。每个bootstrap样本大约包含63.2%的原始数据。
Bagging通过降低方差来提高模型稳定性。对决策树特别有效，因为单棵树方差大。

随机森林（Random Forest）在Bagging的基础上进一步减少树之间的相关性：
1. 对每棵树，bootstrap采样生成训练集
2. 在每个节点分裂时，随机选择 $m$ 个变量（通常 $m = \sqrt{p}$ 或 $p/3$），从中选择最优分裂变量
3. 不剪枝，让树完全生长
4. 预测时，所有树的预测平均（回归）或投票（分类）
随机森林的优势：
- 预测精度高，不易过拟合
- 不需要交叉验证来估计泛化误差（OOB误差）
- 可以评估变量重要性（通过permutation importance或Gini importance）
- 并行计算友好
变量重要性：
- Gini Importance：某变量在所有树中带来的不纯度减少的平均值
- Permutation Importance：随机打乱某变量的值，观察模型性能下降的程度
OOB（Out-of-Bag）误差：
每个样本在bootstrap抽样中没有被选中的概率约为 $e^{-1} \approx 0.368$。对于这些样本，可以用没有使用它们的树来预测，得到OOB预测。OOB误差是OOB预测与真实标签的差异，是无偏的泛化误差估计。

训练集、验证集、测试集：
- 训练集：用于训练模型参数
- 验证集：用于选择模型结构和超参数
- 测试集：仅用于最终评估模型泛化能力，不能用于任何模型选择
交叉验证（Cross-Validation, CV）：
当数据有限时，使用交叉验证：
1. $K$折交叉验证：将数据分成 $K$ 份，每次用 $K-1$ 份训练，1份验证，重复 $K$ 次，平均误差
2. 留一交叉验证（LOOCV）：$K = n$，每次留一个样本做验证
3. 分层交叉验证：保证每折中各类别比例与总体一致
过拟合与欠拟合：
- 欠拟合（Underfitting）：模型太简单，无法捕捉数据的真实模式，训练误差和测试误差都高
- 过拟合（Overfitting）：模型太复杂，"记住"了训练数据的噪声，训练误差低但测试误差高
偏差-方差分解：
$$E[(Y - \hat{f}(X))^2] = Bias^2 + Variance + \sigma^2$$
- 简单模型：高偏差，低方差（欠拟合）
- 复杂模型：低偏差，高方差（过拟合）
- 最优模型：在偏差和方差之间取得平衡

SVM是一种基于最大间隔原则的分类方法。其基本思想是：找到一个超平面，使得两类数据点到该超平面的最小距离（间隔）最大化。
线性可分SVM：
对于数据 $(x_i, y_i)$，$y_i \in {-1, 1}$，寻找超平面 $w^T x + b = 0$ 使得：
$$y_i(w^T x_i + b) \geq 1, \quad \forall i$$
最大化间隔等价于最小化 $\frac{1}{2}|w|^2$：
$$\min_{w,b} \frac{1}{2}|w|^2 \quad \text{s.t.} \quad y_i(w^T x_i + b) \geq 1 \tag{2-28}$$
软间隔SVM：
当数据不完全线性可分时，引入松弛变量 $\xi_i \geq 0$：
$$\min_{w,b,\xi} \frac{1}{2}|w|^2 + C\sum_{i=1}^{n} \xi_i$$
$$\text{s.t.} \quad y_i(w^T x_i + b) \geq 1 - \xi_i, \quad \xi_i \geq 0$$
$C$ 是惩罚参数，$C$ 越大，对误分类的惩罚越重，模型越复杂。
核方法（Kernel Trick）：
当数据线性不可分时，通过映射 $\phi(x)$ 将数据映射到高维空间，在高维空间中寻找线性超平面。通过核函数 $K(x_i, x_j) = \phi(x_i)^T \phi(x_j)$，不需要显式计算 $\phi(x)$。
常用核函数：
- 线性核：$K(x_i, x_j) = x_i^T x_j$
- 多项式核：$K(x_i, x_j) = (x_i^T x_j + c)^d$
- RBF（高斯核）：$K(x_i, x_j) = \exp(-\gamma|x_i - x_j|^2)$
- Sigmoid核：$K(x_i, x_j) = \tanh(\kappa x_i^T x_j + \theta)$
对偶问题：
通过拉格朗日乘子法，原问题转化为对偶问题：
$$\max_{\alpha} \sum_{i=1}^{n} \alpha_i - \frac{1}{2}\sum_{i=1}^{n}\sum_{j=1}^{n} \alpha_i \alpha_j y_i y_j K(x_i, x_j)$$
$$\text{s.t.} \quad \sum_{i=1}^{n} \alpha_i y_i = 0, \quad 0 \leq \alpha_i \leq C$$
决策函数：$f(x) = \text{sign}\left(\sum_{i=1}^{n} \alpha_i y_i K(x_i, x) + b\right)$
支持向量：满足 $\alpha_i > 0$ 的样本。只有支持向量影响最终的决策边界，其他样本对模型没有影响。
SVM的优缺点：
- 优点：泛化能力强，高维数据有效，核方法灵活
- 缺点：大规模数据训练慢，核函数和参数选择需要经验，不直接给出概率

# 随机森林
# install.packages("randomForest")
library(randomForest)
library(caret)
# 使用乳腺癌数据（ Wisconsin Breast Cancer Dataset）
data(iris)  # 暂时用iris数据示例
# 划分训练集和测试集
set.seed(123)
train_idx <- createDataPartition(iris$Species, p = 0.8, list = FALSE)
train_data <- iris[train_idx, ]
test_data <- iris[-train_idx, ]
# 随机森林
rf_model <- randomForest(Species ~ ., data = train_data, ntree = 500, importance = TRUE)
print(rf_model)
# 预测
predictions <- predict(rf_model, test_data)
confusionMatrix(predictions, test_data$Species)
# 变量重要性
importance(rf_model)
varImpPlot(rf_model)
# SVM
# install.packages("e1071")
library(e1071)
svm_model <- svm(Species ~ ., data = train_data, kernel = "radial", cost = 1, gamma = 0.1)
svm_pred <- predict(svm_model, test_data)
confusionMatrix(svm_pred, test_data$Species)
# 交叉验证
ctrl <- trainControl(method = "cv", number = 5)
model_cv <- train(Species ~ ., data = train_data, method = "rf", trControl = ctrl)
print(model_cv)
# ROC曲线（二分类示例）
# 使用其他二分类数据
data(ROCR.simple, package = "ROCR")
library(ROCR)
pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred, "tpr", "fpr")
plot(perf, colorize = TRUE, main = "ROC曲线")
abline(a = 0, b = 1, lty = 2)
# AUC
auc <- performance(pred, "auc")
auc@y.values[[1]]

2.5.2 无监督学习

主成分分析（PCA）：
PCA通过线性变换将数据投影到新的正交坐标系中，使得第一主成分方向上的数据方差最大，第二主成分方向上的方差次大，且与第一主成分正交，以此类推。
数学原理：
设数据矩阵 $X \in \mathbb{R}^{n \times p}$（已中心化）。寻找投影方向 $\beta$（$|\beta| = 1$）使 $Var(X\beta) = \beta^T \Sigma \beta$ 最大，其中 $\Sigma$ 是协方差矩阵。
通过拉格朗日乘子法：
$$\max_{\beta} \beta^T \Sigma \beta \quad \text{s.t.} \quad \beta^T \beta = 1$$
解为 $\Sigma$ 的最大特征值对应的特征向量。第 $k$ 主成分对应第 $k$ 大特征值 $\lambda_k$ 的特征向量。
方差贡献率：
$$PC_k \text{ 的贡献率} = \frac{\lambda_k}{\sum_{j=1}^{p} \lambda_j}$$
通常选择前几个主成分，使其累计贡献率达到80%-90%。
t-SNE（t-Distributed Stochastic Neighbor Embedding）：
PCA是线性降维，可能无法捕捉非线性结构。t-SNE通过保持高维空间中样本之间的局部相似性来进行非线性降维。
核心思想：
1. 在高维空间中，定义样本 $i$ 和 $j$ 之间的相似度为条件概率：
$$p_{j|i} = \frac{\exp(-|x_i - x_j|^2 / 2\sigma_i^2)}{\sum_{k \neq i} \exp(-|x_i - x_k|^2 / 2\sigma_i^2)}$$
2. 在低维空间中，用t分布定义相似度：
$$q_{ij} = \frac{(1 + |y_i - y_j|^2)^{-1}}{\sum_{k \neq l} (1 + |y_k - y_l|^2)^{-1}}$$
3. 最小化 $p_{ij}$ 和 $q_{ij}$ 之间的KL散度
t-SNE特别适合可视化高维数据的局部结构，但全局距离可能不准确。通常先用PCA降维到50维左右，再用t-SNE。
UMAP（Uniform Manifold Approximation and Projection）：
UMAP是近年来流行的降维方法，相比t-SNE：
- 速度更快，适合大规模数据
- 保留更多的全局结构
- 更好的理论保证（基于黎曼几何和代数拓扑）

K-means算法：
目标：最小化类内平方和（Within-cluster Sum of Squares, WCSS）：
$$WCSS = \sum_{k=1}^{K} \sum_{i \in C_k} |x_i - \mu_k|^2$$
其中 $\mu_k$ 是第 $k$ 类的中心。
算法步骤：
1. 随机初始化 $K$ 个中心
2. 重复直到收敛：
- 分配步：将每个样本分配到距离最近的中心所在的类
- 更新步：重新计算每个类的中心（该类所有样本的均值）
K-means的缺点：
- 需要预先指定 $K$（可以用肘部法则或轮廓系数选择）
- 对初始值敏感（通常运行多次取最好结果）
- 对非球形簇效果差
- 对离群值敏感
层次聚类（Hierarchical Clustering）：
不需要预先指定聚类数，生成一个树状结构（树状图，dendrogram）。
自底向上（Agglomerative）：
1. 每个样本作为一个独立的类
2. 计算所有类之间的距离（如欧氏距离）
3. 合并距离最近的两个类
4. 更新距离矩阵，重复直到所有样本合并为一个类
类间距离的定义：
- 单链接（Single linkage）：两类中最近样本的距离
- 全链接（Complete linkage）：两类中最远样本的距离
- 平均链接（Average linkage）：两类中所有样本对距离的平均
- Ward法：合并后使类内平方和增加最小
层次聚类的优缺点：
- 优点：不需要预设聚类数，树状图直观展示层次结构
- 缺点：计算复杂度高（$O(n^3)$），对噪声和离群值敏感，一旦合并不能撤销
其他聚类方法：
- DBSCAN：基于密度，可以发现任意形状的簇，自动识别离群值
- 高斯混合模型（GMM）：基于概率模型，假设数据来自多个高斯分布的混合
- 谱聚类：利用图论和拉普拉斯矩阵进行聚类，适合非凸形状的数据

# PCA示例
data(iris)
pca_result <- prcomp(iris[, 1:4], center = TRUE, scale. = TRUE)
# 查看方差贡献
summary(pca_result)
plot(pca_result, type = "l", main = "PCA方差贡献")
# 可视化前两个主成分
library(ggplot2)
pca_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2], 
                       Species = iris$Species)
ggplot(pca_data, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "PCA of Iris Dataset") +
  theme_minimal()
# K-means聚类
set.seed(123)
kmeans_result <- kmeans(iris[, 1:4], centers = 3, nstart = 25)
# 与真实标签比较
table(Predicted = kmeans_result$cluster, True = iris$Species)
# 可视化聚类结果（使用PCA降维）
cluster_data <- data.frame(PC1 = pca_result$x[, 1], PC2 = pca_result$x[, 2],
                           Cluster = factor(kmeans_result$cluster))
ggplot(cluster_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(size = 3) +
  labs(title = "K-means Clustering (K=3)") +
  theme_minimal()
# 层次聚类
hc_result <- hclust(dist(iris[, 1:4]), method = "ward.D2")
plot(hc_result, main = "层次聚类树状图", xlab = "", sub = "")
rect.hclust(hc_result, k = 3, border = 2:4)
# t-SNE
# install.packages("Rtsne")
library(Rtsne)
set.seed(123)
tsne_result <- Rtsne(iris[, 1:4], dims = 2, perplexity = 30, verbose = TRUE)
tsne_data <- data.frame(Dim1 = tsne_result$Y[, 1], Dim2 = tsne_result$Y[, 2],
                        Species = iris$Species)
ggplot(tsne_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "t-SNE of Iris Dataset") +
  theme_minimal()
# UMAP
# install.packages("umap")
library(umap)
umap_result <- umap(iris[, 1:4])
umap_data <- data.frame(Dim1 = umap_result$layout[, 1], Dim2 = umap_result$layout[, 2],
                        Species = iris$Species)
ggplot(umap_data, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(size = 3) +
  labs(title = "UMAP of Iris Dataset") +
  theme_minimal()

在医学研究中，如果不考虑年龄、性别等混杂因素，可能会得到错误的结论。例如，某种治疗可能在每个年龄组内都有效，但在总体上看起来无效（因为更多重症患者接受了治疗，而轻症患者未接受治疗）。

2.6.2 关联与因果

1. 可忽略性（Ignorability / No Unmeasured Confounding）：
$$(Y(0), Y(1)) \perp X | Z$$
给定协变量 $Z$ 后，干预分配与潜在结果独立。在随机对照试验（RCT）中，如果随机化正确，这个条件自动满足。
2. 正性（Positivity / Overlap）：
$$0 < P(X=1|Z=z) < 1, \quad \forall z$$
对于任何协变量组合，两种干预都有非零概率被分配到。如果某些 $Z$ 下只接受一种干预，则无法比较。
3. 稳定性（SUTVA, Stable Unit Treatment Value Assumption）：
- 无干扰性：一个个体的潜在结果不受其他个体干预的影响
- 一致性：对于每个个体，实际接受干预 $x$ 时的结果 $Y = Y(x)$

在以上假设下，ATE可以识别：
$$E[Y(1)] = E_Z[E[Y|X=1, Z]]$$
$$E[Y(0)] = E_Z[E[Y|X=0, Z]]$$
$$\tau = E_Z[E[Y|X=1, Z] - E[Y|X=0, Z]]$$
即通过对 $Z$ 分层，每层内计算 $X$ 对 $Y$ 的影响，然后加权平均。

2.6.4 因果效应的估计

倾向得分（Propensity Score）：
$$e(Z) = P(X=1|Z)$$
即给定协变量 $Z$ 下接受干预的概率。通常通过Logistic回归估计。
IPW估计量：
给每个样本赋予权重：
- 干预组：$w_i = 1 / e(Z_i)$
- 对照组：$w_i = 1 / (1 - e(Z_i))$
然后计算加权平均：
$$\hat{\tau}{IPW} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i Y_i}{e(Z_i)} - \frac{(1-X_i)Y_i}{1-e(Z_i)}\right]$$
IPW的思想是：对干预组中那些"不太可能被分配到干预"（倾向得分小）的样本赋予更大权重，使得加权后的样本分布近似于随机化试验。
IPW的局限性：
- 当倾向得分接近0或1时，权重变得极大，导致方差爆炸
- 需要正确指定倾向得分模型
修剪（Trimming）：
当倾向得分极端时，可以剔除倾向得分 < 0.1 或 > 0.9 的样本，减少方差但引入偏差。
重叠权重（Overlap Weights）：
$$w_i = X_i(1-e(Z_i)) + (1-X_i)e(Z_i)$$
重叠权重给倾向得分接近0.5的样本更大权重，自动排除极端倾向得分的样本，具有更好的有限样本性质。

直接建立结果模型：
$$E[Y|X, Z] = \beta_0 + \tau X + \gamma^T Z$$
通过回归系数 $\tau$ 估计因果效应。需要正确指定结果模型的函数形式。
标准化（G-computation）：
1. 拟合结果模型 $E[Y|X, Z]$
2. 对每个样本，预测其在干预和对照下的结果：$\hat{Y}i(1)$ 和 $\hat{Y}_i(0)$
3. ATE估计：$\hat{\tau} = \frac{1}{n}\sum{i=1}^{n}(\hat{Y}_i(1) - \hat{Y}_i(0))$

结合IPW和结果回归：
$$\hat{\tau}{DR} = \frac{1}{n}\sum{i=1}^{n} \left[\frac{X_i(Y_i - \hat{\mu}_1(Z_i))}{e(Z_i)} + \hat{\mu}_1(Z_i) - \frac{(1-X_i)(Y_i - \hat{\mu}_0(Z_i))}{1-e(Z_i)} - \hat{\mu}_0(Z_i)\right]$$
其中 $\hat{\mu}_x(Z) = E[Y|X=x, Z]$ 是结果回归的预测。
双稳健性：
如果倾向得分模型或结果模型至少有一个正确指定，则估计量是一致的。这是双稳健估计的核心优势。
Augmented IPW（AIPW）：
双稳健估计量也被称为AIPW，是因果推断中的金标准方法。

2.6.5 工具变量

# 因果推断示例：使用IPW和结果回归
# 模拟数据
set.seed(123)
n <- 1000
Z1 <- rnorm(n)  # 协变量1
Z2 <- rbinom(n, 1, 0.5)  # 协变量2
U <- rnorm(n)  # 未观测混杂（模拟中用于生成数据，但分析时假装不知道）
# 干预分配（受协变量和混杂影响）
ps <- plogis(0.5 * Z1 + 0.3 * Z2 + 0.4 * U)  # 真实倾向得分
X <- rbinom(n, 1, ps)
# 结果（受干预和混杂影响）
Y <- 2 * X + 1.5 * Z1 - 1 * Z2 + 2 * U + rnorm(n, 0, 1)
# 数据框
data <- data.frame(Y = Y, X = X, Z1 = Z1, Z2 = Z2)
# 1. 朴素估计（混淆估计）
naive_model <- lm(Y ~ X, data = data)
summary(naive_model)$coef[2, 1]  # 有偏
# 2. 结果回归（调整Z1, Z2）
or_model <- lm(Y ~ X + Z1 + Z2, data = data)
summary(or_model)$coef[2, 1]  # 仍然可能有偏，因为U未观测
# 3. IPW估计
# 估计倾向得分（注意：不能包含U，因为U未观测）
ps_model <- glm(X ~ Z1 + Z2, data = data, family = binomial)
ps_est <- predict(ps_model, type = "response")
# 稳定IPW权重
w <- ifelse(data$X == 1, 1 / ps_est, 1 / (1 - ps_est))
w_stable <- w / sum(w) * n
ipw_model <- lm(Y ~ X, weights = w_stable, data = data)
summary(ipw_model)$coef[2, 1]
# 4. 双稳健估计
# install.packages("survey")
library(survey)
# 先拟合结果模型
mu_model <- lm(Y ~ X + Z1 + Z2, data = data)
data$mu1 <- predict(mu_model, newdata = transform(data, X = 1))
data$mu0 <- predict(mu_model, newdata = transform(data, X = 0))
# 计算双稳健估计量
dr_term <- with(data, 
  X * (Y - mu1) / ps_est + mu1 - 
  (1 - X) * (Y - mu0) / (1 - ps_est) - mu0
)
mean(dr_term)
# 工具变量示例
# 模拟工具变量
Z_iv <- rbinom(n, 1, 0.5)  # 工具变量（如出生季度）
X_iv <- rbinom(n, 1, plogis(0.5 * Z_iv + 0.3 * Z1 + 0.2 * U))  # 暴露（受教育年限）
Y_iv <- 2 * X_iv + 1.5 * Z1 + 2 * U + rnorm(n, 0, 1)
# 2SLS
# install.packages("AER")
library(AER)
iv_model <- ivreg(Y_iv ~ X_iv + Z1 | Z1 + Z_iv)
summary(iv_model)
# 第一阶段F统计量（检验工具变量强度）
stage1 <- lm(X_iv ~ Z_iv + Z1)
summary(stage1)
# F统计量应该 > 10