# 检查并安装所需的R包
required_packages <- c(
"tidyverse", # 数据处理
"survival", # 生存数据处理
"medicaldata", # 医学数据集
"lubridate", # 时间数据处理
"tidyr" # 数据重塑
)
# 检查并安装缺失的包
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)
# 加载所有包
invisible(lapply(required_packages, library, character.only = TRUE))我们将使用survival包中的lung数据集（肺癌患者数据）进行演示：
library(tidyverse)
library(survival)
library(medicaldata)
# 加载肺癌数据集
data(lung)
glimpse(lung)Rows: 228
Columns: 10
$ inst <dbl> 3, 3, 3, 5, 1, 12, 7, 11, 1, 7, 6, 16, 11, 21, 12, 1, 22, 16…
$ time <dbl> 306, 455, 1010, 210, 883, 1022, 310, 361, 218, 166, 170, 654…
$ status <dbl> 2, 2, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, …
$ age <dbl> 74, 68, 56, 57, 60, 74, 68, 71, 53, 61, 57, 68, 68, 60, 57, …
$ sex <dbl> 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 2, 1, …
$ ph.ecog <dbl> 1, 0, 0, 1, 0, 1, 2, 2, 1, 2, 1, 2, 1, NA, 1, 1, 1, 2, 2, 1,…
$ ph.karno <dbl> 90, 90, 90, 90, 100, 50, 70, 60, 70, 70, 80, 70, 90, 60, 80,…
$ pat.karno <dbl> 100, 90, 90, 60, 90, 80, 60, 80, 80, 70, 80, 70, 90, 70, 70,…
$ meal.cal <dbl> 1175, 1225, NA, 1150, NA, 513, 384, 538, 825, 271, 1025, NA,…
$ wt.loss <dbl> NA, 15, 15, 11, 0, 0, 10, 1, 16, 34, 27, 23, 5, 32, 60, 15, …# 基本筛选操作
advanced_cases <- lung %>%
filter(status == 2) %>% # 筛选死亡病例
filter(age > 60) %>% # 筛选老年患者
arrange(desc(time)) # 按生存时间降序排列
# 多条件筛选
high_risk_patients <- lung %>%
filter(sex == 1, # 男性
ph.ecog >= 2, # ECOG体能状态较差
wt.loss > 10) # 体重下降显著
# 展示筛选结果
print("高危患者特征：")[1] "高危患者特征："summary(high_risk_patients) inst time status age sex
Min. : 1.0 Min. : 12.0 Min. :1.000 Min. :49.00 Min. :1
1st Qu.: 1.0 1st Qu.:111.8 1st Qu.:2.000 1st Qu.:61.75 1st Qu.:1
Median : 7.0 Median :194.5 Median :2.000 Median :67.00 Median :1
Mean : 8.8 Mean :262.1 Mean :1.938 Mean :65.94 Mean :1
3rd Qu.:14.5 3rd Qu.:301.2 3rd Qu.:2.000 3rd Qu.:70.75 3rd Qu.:1
Max. :22.0 Max. :814.0 Max. :2.000 Max. :76.00 Max. :1
NA's :1
ph.ecog ph.karno pat.karno meal.cal wt.loss
Min. :2.000 Min. :50.00 Min. :40 Min. : 271.0 Min. :18.00
1st Qu.:2.000 1st Qu.:60.00 1st Qu.:60 1st Qu.: 428.5 1st Qu.:20.00
Median :2.000 Median :70.00 Median :70 Median : 644.0 Median :23.00
Mean :2.062 Mean :63.75 Mean :64 Mean : 817.2 Mean :24.69
3rd Qu.:2.000 3rd Qu.:70.00 3rd Qu.:70 3rd Qu.:1062.5 3rd Qu.:28.50
Max. :3.000 Max. :70.00 Max. :80 Max. :2450.0 Max. :36.00
NA's :1 NA's :2 # 创建示例临床数据
set.seed(123)
clinical_data <- data.frame(
patient_id = 1:200,
age = rnorm(200, mean = 45, sd = 15),
temp = rnorm(200, mean = 37, sd = 0.5),
gender = factor(sample(c("男", "女"), 200, replace = TRUE)),
wbc = rnorm(200, mean = 6.5, sd = 2),
crp = rlnorm(200, log(10), 0.8)
)
# 添加新的计算指标
clinical_analysis <- clinical_data %>%
mutate(
# 体温分类
temp_category = case_when(
temp < 37.3 ~ "正常",
temp < 38.0 ~ "低热",
temp < 39.0 ~ "中度发热",
TRUE ~ "高热"
),
# 年龄分组
age_group = case_when(
age < 18 ~ "未成年",
age < 65 ~ "成年",
TRUE ~ "老年"
),
# 是否老年
is_elderly = age >= 65,
# 炎症风险评分
risk_score = (temp - 37) * 10 + (crp/10) + (wbc - 7)^2
) %>%
select(patient_id, age, age_group, temp, temp_category,
is_elderly, risk_score, everything())
# 查看新变量的分布
summary(clinical_analysis$risk_score) Min. 1st Qu. Median Mean 3rd Qu. Max.
-10.1273 0.7558 4.6151 6.0529 10.8289 44.6618 table(clinical_analysis$temp_category)
低热 正常 中度发热
54 140 6 # 可视化风险评分分布
ggplot(clinical_analysis, aes(x = risk_score)) +
geom_histogram(fill = "steelblue", bins = 30) +
labs(title = "患者风险评分分布",
x = "风险评分",
y = "频数") +
theme_minimal()
使用medicaldata包中的smartpill数据：
library(lubridate)
# 创建示例入院数据
set.seed(123)
admission_data <- data.frame(
patient_id = 1:100,
admission_date = as.Date("2023-01-01") + sample(0:90, 100, replace = TRUE),
los = sample(1:30, 100, replace = TRUE) # 住院天数
) %>%
mutate(
discharge_date = admission_date + los,
admission_month = month(admission_date, label = TRUE),
weekday = wday(admission_date, label = TRUE)
)
# 分析入院时间模式
ggplot(admission_data, aes(x = admission_month)) +
geom_bar(fill = "steelblue") +
labs(title = "每月入院人数分布",
x = "月份",
y = "入院人数") +
theme_minimal()
# 创建随访数据
follow_up_data <- lung %>%
mutate(
start_date = as.Date("2020-01-01") + time,
last_contact = start_date + time,
follow_up_duration = interval(start_date, last_contact) / months(1),
follow_up_status = if_else(status == 2, "死亡", "存活")
)
# 分析随访时间分布
ggplot(follow_up_data, aes(x = follow_up_duration, fill = follow_up_status)) +
geom_histogram(position = "dodge", bins = 30) +
labs(title = "随访时间分布",
x = "随访月数",
y = "患者数") +
theme_minimal()
使用medicaldata包中的cytomegalovirus数据：
library(tidyr)
# 创建示例实验室检查数据
lab_data <- data.frame(
patient_id = 1:5,
wbc_1 = rnorm(5, 6.5, 1),
wbc_2 = rnorm(5, 6.8, 1),
wbc_3 = rnorm(5, 7.0, 1),
hb_1 = rnorm(5, 130, 10),
hb_2 = rnorm(5, 128, 10),
hb_3 = rnorm(5, 125, 10)
)
# 转换为长格式
lab_long <- lab_data %>%
pivot_longer(
cols = -patient_id,
names_to = c("test", "visit"),
names_pattern = "(.+)_(.+)",
values_to = "value"
)
# 可视化检验结果趋势
ggplot(lab_long, aes(x = visit, y = value, group = patient_id, color = factor(patient_id))) +
geom_line() +
facet_wrap(~test, scales = "free_y") +
labs(title = "实验室检查结果追踪",
x = "访视次数",
y = "检查值") +
theme_minimal()
# 模拟多中心数据
center_1 <- data.frame(
patient_id = paste0("A", 1:50),
age = rnorm(50, 65, 10),
center = "中心1"
)
center_2 <- data.frame(
patient_id = paste0("B", 1:30),
age = rnorm(30, 62, 8),
center = "中心2"
)
# 合并数据集
combined_data <- bind_rows(center_1, center_2) %>%
mutate(age_group = cut(age,
breaks = c(0, 50, 65, 100),
labels = c("青年", "中年", "老年")))
# 分析各中心年龄分布
ggplot(combined_data, aes(x = center, y = age, fill = center)) +
geom_boxplot() +
labs(title = "各中心患者年龄分布",
x = "研究中心",
y = "年龄") +
theme_minimal()
在本章中，我们学习了：
下一章，我们将学习统计建模的基础知识。