在发表于柳叶刀公共卫生的文章《The effect of healthy lifestyles and social determinants on independent life expectancy and sex differences in China:evidence from a 13-year cohort study》中，作者使用连续时间三状态马尔科夫模型对每个老年人的状态变化进行建模，并由此计算出独立预期寿命。本文将用简化版的代码粗略复刻文章使用的研究方法。
1.生成模拟数据
利用R代码生成符合文章调查要求（例如多次随访、年龄限制等）的模拟老年人状态变化的数据。其中生活方式和社会因素均按照文章中的比值设置，转移强度根据指数模型由两种得分、年龄和性别算出。
R
if (!require("msm")) install.packages("msm")
if (!require("dplyr")) install.packages("dplyr")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("expm")) install.packages("expm")
if (!require("tidyr")) install.packages("tidyr")
library(msm)
library(dplyr)
library(ggplot2)
library(expm)
library(tidyr)
# 设定随机种子以保证结果可复现
set.seed(2025)
# ==============================================================================
# 第一步：生成模拟数据 (Simulate Data)
# ==============================================================================
# 我们生成10000人的队列，模拟其从65岁起的健康轨迹
# 状态定义: 1=独立 (Independent), 2=依赖 (Dependent), 3=死亡 (Dead)
n_subjects <- 10000
follow_up_times <- c(0, 2.5, 5.5, 9, 13) # 模拟CLHLS的不规则随访间隔
# 1.1 生成基线协变量
ids <- 1:n_subjects
# 性别: 0=男性, 1=女性 (参考中国高龄人群女性比例稍高)
sex <- rbinom(n_subjects, 1, 0.53)
# 生活方式: 0=低, 1=中, 2=高 (简化模拟)
lifestyle <- sample(c(0, 1, 2), n_subjects, replace = TRUE, prob = c(0.25, 0.35, 0.40))
# 社会因素: 0=低支持, 1=高支持
social <- sample(c(0, 1), n_subjects, replace = TRUE, prob = c(0.4, 0.6))
# 基线年龄：65岁到105岁
age_baseline <- 65 + rexp(n_subjects, 0.15)
age_baseline[age_baseline > 105] <- 105
# 1.2 模拟轨迹函数
simulate_trajectory <- function(id, base_age, sex_val, life_val, soc_val) {
# 初始状态：大部分65岁是独立的，年龄越大依赖风险越高
current_state <- 1
if(base_age > 80 && runif(1) < 0.2) current_state <- 2
states <- c(current_state)
times <- c(0)
real_ages <- c(base_age)
for (t in follow_up_times[-1]) {
if (current_state == 3) { # 已经死亡，保持状态
states <- c(states, 3)
times <- c(times, t)
real_ages <- c(real_ages, base_age + t)
next
}
curr_age <- base_age + t
# 定义转移强度的对数 (log-hazards)
# 设定逻辑：
# 1. 年龄增加会增加所有风险
# 2. 女性 (sex=1) 致残率(1->2)高，但死亡率(1->3, 2->3)略低
# 3. 良好的生活方式(life_val)降低致残和死亡风险
# 4. 社会因素(soc_val)主要促进恢复(2->1)
# 1->2 (独立 -> 依赖)
r12 <- exp(-4.5 + 0.08*(curr_age-65) + 0.5*sex_val - 0.3*life_val)
# 1->3 (独立 -> 死亡)
r13 <- exp(-5.0 + 0.11*(curr_age-65) - 0.2*sex_val - 0.2*life_val)
# 2->1 (依赖 -> 独立, 恢复)
r21 <- exp(-2.0 - 0.05*(curr_age-65) + 0.4*soc_val)
# 2->3 (依赖 -> 死亡)
r23 <- exp(-2.5 + 0.10*(curr_age-65) - 0.3*sex_val)
# 构建瞬时Q矩阵
Q <- matrix(0, 3, 3)
Q[1,2]<-r12; Q[1,3]<-r13; Q[1,1]<- -(r12+r13)
Q[2,1]<-r21; Q[2,3]<-r23; Q[2,2]<- -(r21+r23)
# 计算在该时间段内的转移概率矩阵 P = exp(Q * dt)
dt <- t - times[length(times)]
P <- expm(Q * dt)#矩阵指数函数
# 随机决定下一个状态
next_s <- sample(1:3, 1, prob = P[current_state,])
states <- c(states, next_s)
times <- c(times, t)
real_ages <- c(real_ages, curr_age)
current_state <- next_s
}
data.frame(id=id, time=times, state=states,
sex=sex_val, lifestyle=life_val, social=soc_val,
age=real_ages)
}
# 生成数据列表并合并
sim_data <- do.call(rbind, lapply(1:n_subjects, function(i) {
simulate_trajectory(ids[i], age_baseline[i], sex[i], lifestyle[i], social[i])
}))
# 打印数据概况
print("模拟数据前6行：")
print(head(sim_data))2.构建转移强度矩阵并拟合msm模型
其中初始转移强度矩阵定义了转移的方向和基线强度，msm模型取性别和年龄作为协变量。
R
# 初始Q矩阵结构 (1->2, 1->3, 2->1, 2->3 允许，其他禁止)
q_init <- rbind(
c(0.2, 0.2, 0.1),
c(0.2, 0.2, 0.2),
c(0, 0, 0)
)
rownames(q_init) <- colnames(q_init) <- c("Indep", "Dep", "Dead")
print("正在拟合 msm 模型 (可能需要几秒钟)...")
# 拟合模型：加入 sex 和 age 作为协变量
# 注意：deathexact=3 告诉模型状态3是死亡（确切时间点通常是未知的，这里作为区间删失处理）
msm_model <- msm(state ~ time, subject = id, data = sim_data,
qmatrix = q_init,
gen.inits = TRUE,
covariates = ~ sex + age,
control = list(fnscale = 4000, maxit = 10000))
print(msm_model)3.计算预期寿命
利用msm拟合结果计算预期寿命。文中采用了elect包，但由于找不到这个包，故采用类似的积分法进行计算。
R
calculate_le_manual <- function(model, start_age, sex_value, max_age = 110, step = 0.5) {
current_age <- start_age
# 初始向量：假设65岁时大家都在状态1 (独立)
prob_vector <- c(1, 0, 0)
le_independent <- 0 # 独立预期寿命
le_dependent <- 0 # 依赖预期寿命
# 循环直到达到最大年龄
while (current_age < max_age) {
# ---------------- 修正点开始 ----------------
# 调用 qmatrix.msm 时指定 ci="none"，它直接返回矩阵，而不是列表
Q <- qmatrix.msm(model, covariates = list(age = current_age, sex = sex_value), ci = "none")
# ---------------- 修正点结束 ----------------
# 计算这一小步长(step)的转移概率矩阵 P = exp(Q * step)
P_step <- expm(Q * step)
# 简单的梯形积分：计算该步长后的概率分布
prob_vector_next <- prob_vector %*% P_step
# 取该时段内的平均概率作为存活概率
avg_prob_indep <- (prob_vector[1] + prob_vector_next[1]) / 2
avg_prob_dep <- (prob_vector[2] + prob_vector_next[2]) / 2
# 累加预期寿命 (概率 * 时间长度)
le_independent <- le_independent + avg_prob_indep * step
le_dependent <- le_dependent + avg_prob_dep * step
# 更新状态和年龄
prob_vector <- prob_vector_next
current_age <- current_age + step
# 如果总存活率极低，提前终止计算
if (sum(prob_vector[1:2]) < 0.0001) break
}
total_le <- le_independent + le_dependent
return(c(Total = total_le, Independent = le_independent, Dependent = le_dependent))
}
print("正在计算男性预期寿命...")
le_male <- calculate_le_manual(msm_model, start_age = 65, sex_value = 0)
print("正在计算女性预期寿命...")
le_female <- calculate_le_manual(msm_model, start_age = 65, sex_value = 1)
# 构建结果数据框
plot_data <- data.frame(
Gender = rep(c("男性", "女性"), each = 3),
Type = rep(c("总预期寿命", "独立预期寿命", "依赖预期寿命"), 2),
Years = c(le_male["Total"], le_male["Independent"], le_male["Dependent"],
le_female["Total"], le_female["Independent"], le_female["Dependent"])
)
# 打印数值结果
print(plot_data)4.绘制图表
可得到表示男性女性三种预期寿命的柱状图，对应文章中的图表2。
R
plot_data$Type <- factor(plot_data$Type, levels = c("总预期寿命", "独立预期寿命", "依赖预期寿命"))
p <- ggplot(plot_data, aes(x = Gender, y = Years, fill = Type)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7) +
geom_text(aes(label = sprintf("%.2f", Years)),
position = position_dodge(width = 0.8), vjust = -0.5, size = 4) +
scale_fill_manual(values = c("总预期寿命" = "#95a5a6", # 灰色
"独立预期寿命" = "#2ecc71", # 绿色
"依赖预期寿命" = "#e74c3c")) + # 红色
labs(title = "65岁时中国老年人预期寿命及健康状态 (模拟数据)",
subtitle = "基于连续时间马尔可夫模型 (MSM)",
y = "预期寿命 (年)",
x = NULL,
fill = "指标类型") +
theme_minimal(base_size = 14) +
theme(
legend.position = "bottom",
panel.grid.major.x = element_blank(),
plot.title = element_text(face = "bold", hjust = 0.5),
axis.text = element_text(color = "black")
)
print(p)