Trastuzumab-Based Therapy Improves Survival in HER2-Positive Breast Cancer: A Real-World Cohort Study from Taipei Veterans General Hospital
b10406023 Nature Huang
2026-07-14
一、資料前處理與病歷整理 (Data Curation)
本區塊之學術目的在於解決台灣癌症登記資料庫（癌登）中常見的日期缺漏與病患重複登錄問題，確保世代研究中「一人僅能擁有一筆最精準之原發癌紀錄」。
# 1. 模糊日期標準化函數 (月/日缺失者，統一補正為 15 號)
fix_date_string <- function(x) {
x <- str_replace_all(as.character(x), "[^0-9]", "")
x[nchar(x) != 8] <- NA
x_valid <- !is.na(x)
fixed <- x
if (any(x_valid)) {
month_part <- as.integer(substr(x[x_valid], 5, 6))
day_part <- as.integer(substr(x[x_valid], 7, 8))
month_fixed <- ifelse(month_part >= 1 & month_part <= 12, sprintf("%02d", month_part), "06")
day_fixed <- ifelse(day_part >= 1 & day_part <= 31, sprintf("%02d", day_part), "15")
fixed[x_valid] <- paste0(substr(x[x_valid], 1, 4), month_fixed, day_fixed)
}
return(fixed)
}
safe_ymd <- function(x) suppressWarnings(ymd(fix_date_string(x)))
# 2. 讀取北榮癌登大表
data0 <- read.csv("C:/Users/user/OneDrive/文件/公衛實習/癌登/concise2_1140803.csv", fileEncoding = "UTF-8") %>%
mutate(ID = as.character(ID), DIAG_DT = safe_ymd(X2.5.Date.of.Initial.Diagnosis), FU_DT = safe_ymd(FU_Date))
# 3. 處理重複病歷號 (確保一人一筆資料)
id_freq <- table(data0$ID)
data1 <- data0 %>% filter(ID %in% names(id_freq[id_freq == 1]))
data2 <- data0 %>% filter(ID %in% names(id_freq[id_freq == 2])) %>% arrange(ID)
data3 <- data0 %>% filter(ID %in% names(id_freq[id_freq >= 3]))
split_data <- lapply(unique(data2$ID), function(i) {
tmp <- data2 %>% filter(ID == i) %>% mutate(year = year(DIAG_DT), LATERAL = X2.7.Laterality, CASITE = ICD, HIST = Hist, CLASS = X2.3.Class.of.Case)
if (length(unique(tmp$LATERAL)) > 1) { tmp$ID <- paste0(tmp$ID, "_l", tmp$LATERAL); return(tmp) }
if (tmp$year[1] == tmp$year[2] && tmp$CASITE[1] == tmp$CASITE[2] && tmp$HIST[1] == tmp$HIST[2] && abs(as.numeric(diff(tmp$DIAG_DT))) <= 30) {
class12 <- tmp %>% filter(CLASS %in% c(1, 2))
return(if (nrow(class12) > 0) class12[1, , drop = FALSE] else tmp %>% slice_max(FU_DT, n = 1))
}
tmp$ID <- paste0(tmp$ID, "_m", 1:2)
return(tmp)
})
data2_processed <- bind_rows(split_data)
data3_processed <- data3 %>% group_by(ID) %>% slice_max(DIAG_DT, n = 1) %>% ungroup()
all_cols <- unique(c(names(data1), names(data2_processed), names(data3_processed)))
fill_missing <- function(df, cols) { for (c in setdiff(cols, names(df))) df[[c]] <- NA; df[, cols] }
# 建立最終無重複、清洗完成之大世代資料庫
final_data <- bind_rows(fill_missing(data1, all_cols), fill_missing(data2_processed, all_cols), fill_missing(data3_processed, all_cols))二、存活變數計算與兩大世代建立
本區進行核心資料流處理：首先計算好所有病患的存活天數與五年截尾變數，接著像漏斗一樣分流出「主分析大世代」與「次族群小世代」，確保兩份資料表皆具備完整的存活變數。 研究邏輯！從「所有 HER2+病人」這個大池子（Step1），分出兩條路徑： * 路徑 A（主線 Step 7）：抓取所有期別的病人，用來看全體存活率與跑 Cox 模型。 * 路徑 B（支線 Step 2~6）：一步步嚴格篩選出「有開刀、沒做化療、腫瘤極小的 pT1N0M0 病人」，留到報告最後的 Discussion 討論。
# =====================================================================
# 1. 抓出 HER2 陽性母體，並「預先算好所有存活變數」
# =====================================================================
step1 <- final_data %>% filter(ihc %in% c("HR+/HER2+", "HR-/HER2+"))
step1_clean <- step1 %>%
mutate(
DIAG_DT = as.Date(DIAG_DT), FU_DT = as.Date(FU_DT),
Recur_Date2 = suppressWarnings(ymd(ifelse(is.na(Recur_Date) | Recur_Date %in% c(0, 99999999), NA, as.character(Recur_Date)))),
# 修正 RFS 事件：排除從未 disease-free 的病人 (設為 NA)
rfs_event_raw = case_when(
Recur_Type == 70 ~ NA_integer_,
Recur_Type %in% c(1:69, 88) & !is.na(Recur_Date2) ~ 1L,
TRUE ~ 0L
),
rfs_date_used = if_else(rfs_event_raw == 1L, Recur_Date2, FU_DT),
# 【完整追蹤期變數】(供 Cox 迴歸使用)
surv_year_rfs = if_else(is.na(rfs_event_raw), NA_real_, as.numeric(pmax(rfs_date_used - DIAG_DT, 0)) / 365.25),
surv_year_os = as.numeric(survival) / 12,
Vita_m = if_else(!is.na(Vital) & Vital == 0, 1, 0),
# 【5 年截尾存活變數】(供 KM Plot 視覺化使用)
relapse_5y = case_when(is.na(rfs_event_raw) ~ NA_real_, rfs_event_raw == 1L & surv_year_rfs <= censor_years ~ 1, TRUE ~ 0),
surv_year_rfs_5y = if_else(is.na(surv_year_rfs), NA_real_, pmin(surv_year_rfs, censor_years)),
Vita_m_5y = if_else(Vita_m == 1 & surv_year_os <= censor_years, 1, 0),
surv_year_os_5y = pmin(surv_year_os, censor_years)
)
# =====================================================================
# 2. 🚀 路徑 A：主分析世代建立 (全期別)
# =====================================================================
step7_her2_clean <- step1_clean %>%
mutate(NAC_binary = case_when(NAC %in% c(10,11,20,21,30,31,40,41,990,999) ~ 1, TRUE ~ 0)) %>%
mutate(
final_stage = factor(case_when(
NAC_binary == 1 ~ X3.7.Clinical.Stage.Group,
NAC_binary == 0 ~ X3.13.Pathologic.Stage.Group,
TRUE ~ NA_character_
), levels = stages)
) %>% filter(!is.na(final_stage) & final_stage %in% stages)
# 寫出主分析資料庫
write.csv(step7_her2_clean, "final_her2_data.csv", row.names = FALSE)
cat("👉 [主線] 全體 HER2+ 且擁有明確期別之主要分析人數：", nrow(step7_her2_clean), "人\n")## 👉 [主線] 全體 HER2+ 且擁有明確期別之主要分析人數： 1332 人# =====================================================================
# 3. 🔎 路徑 B：極早期小腫瘤漏斗篩選 (Patient Flowchart)
# =====================================================================
cat("\n=== 🔎 臨床次族群篩選：Patient Flowchart ===\n")##
## === 🔎 臨床次族群篩選：Patient Flowchart ===step2 <- step1_clean %>% filter(X_1st_Surg != 0)
cat("👉 Step 2 (接受第一線手術開刀者):", nrow(step2), "人\n")## 👉 Step 2 (接受第一線手術開刀者): 1652 人step3 <- step2 %>% filter(NAC == 988)
cat("👉 Step 3 (排除新輔助治療，確定為純開刀首選者):", nrow(step3), "人\n")## 👉 Step 3 (排除新輔助治療，確定為純開刀首選者): 1333 人step4 <- step3 %>% filter(X3.10.Pathologic.T %in% c("1", "1A", "1B", "1C", "1MIC", "1Mic", "1mic"))
cat("👉 Step 4 (病理診斷確定為腫瘤小於2公分之 T1 族群):", nrow(step4), "人\n")## 👉 Step 4 (病理診斷確定為腫瘤小於2公分之 T1 族群): 483 人step5 <- step4 %>% filter(X3.11.Pathologic.N == "0")
cat("👉 Step 5 (病理檢查確定淋巴結無轉移 N0 族群):", nrow(step5), "人\n")## 👉 Step 5 (病理檢查確定淋巴結無轉移 N0 族群): 367 人# 這裡修正了名稱，統一叫 step6_subgroup
step6_subgroup <- step5 %>% filter(X3.12.Pathologic.M != "1")
cat("👉 Step 6 (最終排除遠端轉移 M1，確定符合 pT1N0M0 之臨床總人數):", nrow(step6_subgroup), "人\n")## 👉 Step 6 (最終排除遠端轉移 M1，確定符合 pT1N0M0 之臨床總人數): 366 人# 寫出次族群資料庫 (此表已自動繼承 surv_year_rfs_5y)
write.csv(step6_subgroup, "subgroup_t1n0m0_data.csv", row.names = FALSE)三、患者基線特徵 (Table 1)
建立四大治療組別的基線特徵比較表，並補正 Grade 缺失值以保留檢定力。
# 讀取具有乾淨存活欄位的主線資料庫
df_analysis <- read.csv("final_her2_data.csv") %>%
mutate(
# 定義治療組 A 到 D
group = factor(case_when(
CT == 0 & TT == 0 ~ "Group A",
CT == 0 & TT == 1 ~ "Group B",
CT == 1 & TT == 0 ~ "Group C",
CT == 1 & TT == 1 ~ "Group D",
TRUE ~ NA_character_
), levels = c("Group A", "Group B", "Group C", "Group D")),
age_group = ifelse(Age < 50, "< 50 y/o", "≥ 50 y/o"),
hr_status = factor(case_when(grepl("HR\\+", ihc) ~ "HR positive", grepl("HR\\-", ihc) ~ "HR negative", TRUE ~ NA_character_), levels = c("HR negative", "HR positive")),
# 防呆修正：將 Grade 缺失值轉換為 "Unknown" 類別，避免被 R 自動刪除
grade_f = factor(ifelse(is.na(Grade) | !(Grade %in% c(1, 2, 3)), "Unknown", as.character(Grade)), levels = c("1", "2", "3", "Unknown"), labels = c("I", "II", "III", "Unknown")),
histology = factor(case_when(Hist == 8500 ~ "IDC", Hist == 8520 ~ "ILC", TRUE ~ "Others"), levels = c("IDC", "ILC", "Others")),
endocrine = factor(ifelse(HT == 1, "Yes", "No"), levels = c("No", "Yes")),
rt_value = suppressWarnings(as.numeric(X4.2.1.1.RT.Target.Summary)),
rt_done = factor(ifelse(!is.na(rt_value) & rt_value > 0, "Done", "None"), levels = c("None", "Done")),
follow_up_months = surv_year_os * 12
)
tbl1 <- df_analysis %>%
select(group, Age, age_group, hr_status, grade_f, histology, endocrine, rt_done, follow_up_months, final_stage) %>%
tbl_summary(
by = group,
type = list(Age ~ "continuous2", follow_up_months ~ "continuous2"),
statistic = list(all_continuous2() ~ "{mean} ± {sd}; {median} [{min}, {max}]", all_categorical() ~ "{n} ({p}%)"),
missing = "no"
) %>%
add_overall(last = TRUE) %>%
add_p(test = everything() ~ "chisq.test") %>%
modify_header(label = "**Characteristics**") %>%
bold_labels()
# 顯示與輸出表格
tbl1| Characteristics | Group A N = 2401 |
Group B N = 301 |
Group C N = 701 |
Group D N = 9921 |
Overall N = 1,3321 |
p-value2 |
|---|---|---|---|---|---|---|
| Age | <0.001 | |||||
| Mean ± SD; Median [Min, Max] | 58 ± 12; 58 [32, 89] | 64 ± 16; 68 [32, 86] | 55 ± 12; 57 [30, 79] | 54 ± 11; 54 [20, 87] | 55 ± 12; 55 [20, 89] | |
| age_group | 0.008 | |||||
| < 50 y/o | 57 (24%) | 7 (23%) | 22 (31%) | 344 (35%) | 430 (32%) | |
| ≥ 50 y/o | 183 (76%) | 23 (77%) | 48 (69%) | 648 (65%) | 902 (68%) | |
| hr_status | <0.001 | |||||
| HR negative | 148 (62%) | 9 (30%) | 23 (33%) | 428 (43%) | 608 (46%) | |
| HR positive | 92 (38%) | 21 (70%) | 47 (67%) | 564 (57%) | 724 (54%) | |
| grade_f | <0.001 | |||||
| I | 7 (2.9%) | 0 (0%) | 0 (0%) | 4 (0.4%) | 11 (0.8%) | |
| II | 76 (32%) | 7 (23%) | 27 (39%) | 270 (27%) | 380 (29%) | |
| III | 44 (18%) | 9 (30%) | 24 (34%) | 276 (28%) | 353 (27%) | |
| Unknown | 113 (47%) | 14 (47%) | 19 (27%) | 442 (45%) | 588 (44%) | |
| histology | 0.070 | |||||
| IDC | 224 (93%) | 27 (90%) | 67 (96%) | 946 (95%) | 1,264 (95%) | |
| ILC | 2 (0.8%) | 2 (6.7%) | 0 (0%) | 12 (1.2%) | 16 (1.2%) | |
| Others | 14 (5.8%) | 1 (3.3%) | 3 (4.3%) | 34 (3.4%) | 52 (3.9%) | |
| endocrine | 89 (37%) | 21 (70%) | 43 (61%) | 536 (54%) | 689 (52%) | <0.001 |
| rt_done | <0.001 | |||||
| None | 168 (70%) | 22 (73%) | 49 (70%) | 489 (49%) | 728 (55%) | |
| Done | 72 (30%) | 8 (27%) | 21 (30%) | 503 (51%) | 604 (45%) | |
| follow_up_months | 0.10 | |||||
| Mean ± SD; Median [Min, Max] | 66 ± 41; 60 [0, 155] | 65 ± 39; 58 [9, 147] | 77 ± 42; 78 [5, 156] | 75 ± 39; 71 [0, 163] | 73 ± 40; 67 [0, 163] | |
| final_stage | <0.001 | |||||
| 1A | 191 (80%) | 12 (40%) | 30 (43%) | 251 (25%) | 484 (36%) | |
| 1B | 0 (0%) | 0 (0%) | 0 (0%) | 7 (0.7%) | 7 (0.5%) | |
| 2A | 35 (15%) | 5 (17%) | 28 (40%) | 287 (29%) | 355 (27%) | |
| 2B | 6 (2.5%) | 6 (20%) | 3 (4.3%) | 175 (18%) | 190 (14%) | |
| 3A | 2 (0.8%) | 2 (6.7%) | 4 (5.7%) | 130 (13%) | 138 (10%) | |
| 3B | 4 (1.7%) | 0 (0%) | 0 (0%) | 17 (1.7%) | 21 (1.6%) | |
| 3C | 2 (0.8%) | 5 (17%) | 5 (7.1%) | 125 (13%) | 137 (10%) | |
| 1 n (%) | ||||||
| 2 Pearson’s Chi-squared test | ||||||
tbl1 %>% as_flex_table() %>% autofit() %>% save_as_docx(path = "Table1_Clinicopathologic_Characteristics.docx")四、5年存活率分析 (KM Plots)
使用 5 年截尾時間變數，並套用指定的經典四色色票（A:紅、B:藍、C:綠、D:紫）進行全期別分層展示。
df_analysis <- df_analysis %>%
filter(!is.na(group)) %>%
mutate(group = relevel(factor(group), ref = "Group A"), final_stage = relevel(factor(final_stage), ref = "1A"))
for (stg in stages) {
df_stage <- df_analysis %>% filter(final_stage == stg)
if (nrow(df_stage) > 0 && n_distinct(df_stage$group) >= 2) {
# 5年無復發存活率 (RFS) Plot
fit_rfs <- survfit(Surv(surv_year_rfs_5y, relapse_5y) ~ group, data = df_stage)
p_rfs <- ggsurvplot(fit_rfs, data = df_stage, pval = TRUE, risk.table = TRUE, xlim = c(0, 5), palette = km_colors, title = paste0("5-Year RFS - Stage ", stg), risk.table.height = 0.25, tables.theme = theme_cleantable())
# 5年整體存活率 (OS) Plot
fit_os <- survfit(Surv(surv_year_os_5y, Vita_m_5y) ~ group, data = df_stage)
p_os <- ggsurvplot(fit_os, data = df_stage, pval = TRUE, risk.table = TRUE, xlim = c(0, 5), palette = km_colors, title = paste0("5-Year OS - Stage ", stg), risk.table.height = 0.25, tables.theme = theme_cleantable())
# 使用 grid 引擎左右合體排列
grid.newpage()
grid.arrange(p_rfs$plot, p_os$plot, p_rfs$table, p_os$table, ncol = 2, heights = c(4, 1.2))
}
}
五、Cox 比例風險模型 (Cox Regression)
評估各項臨床預後因子對於無復發存活（RFS）與整體存活（OS）之多變項影響（此處採用完整追蹤期變數以獲取最高之統計檢定力與長期 Hazard Ratio 估計）。
# 基於統計效力考量，採用完整追蹤天數
surv_os_full <- Surv(time = df_analysis$surv_year_os, event = df_analysis$Vita_m == 1)
surv_rfs_full <- Surv(time = df_analysis$surv_year_rfs, event = df_analysis$rfs_event_raw == 1)
vars <- c("group", "Age", "hr_status", "grade_f", "final_stage")
# 單多因子合併函數
run_cox <- function(surv_obj, data, vars) {
uni_table <- lapply(vars, function(v) tidy(coxph(as.formula(paste("surv_obj ~", v)), data = data), exponentiate = TRUE, conf.int = TRUE)) %>% bind_rows(.id = "Variable") %>% mutate(Variable = vars[as.numeric(Variable)]) %>% select(Variable, term, estimate, conf.low, conf.high, p.value)
multi_model <- coxph(surv_obj ~ group + Age + hr_status + grade_f + final_stage, data = data)
multi_table <- tidy(multi_model, exponentiate = TRUE, conf.int = TRUE) %>% select(term, estimate, conf.low, conf.high, p.value)
uni_table %>% rename(Uni_HR = estimate, Uni_LCL = conf.low, Uni_UCL = conf.high, Uni_p = p.value) %>% left_join(multi_table %>% rename(Multi_HR = estimate, Multi_LCL = conf.low, Multi_UCL = conf.high, Multi_p = p.value), by = "term") %>% mutate(across(c(Uni_HR, Uni_LCL, Uni_UCL, Multi_HR, Multi_LCL, Multi_UCL), ~ ifelse(. > 100 | is.infinite(.), NA, .)))
}
# 格式化輸出函數
format_cox <- function(cox_table, title) {
cox_table %>% mutate(Level = case_when(grepl("group", term) ~ sub("group", "", term), grepl("hr_status", term) ~ sub("hr_status", "", term), grepl("grade_f", term) ~ sub("grade_f", "", term), grepl("final_stage", term) ~ sub("final_stage", "", term), term == "Age" ~ "Age (per year increase)", TRUE ~ term), Uni = ifelse(is.na(Uni_HR), "Not estimable", sprintf("%.2f (%.2f–%.2f)", Uni_HR, Uni_LCL, Uni_UCL)), Multi = ifelse(is.na(Multi_HR), "Not estimable", sprintf("%.2f (%.2f–%.2f)", Multi_HR, Multi_LCL, Multi_UCL)), Uni_p = ifelse(is.na(Uni_p), "", sprintf("%.3f", Uni_p)), Multi_p = ifelse(is.na(Multi_p), "", sprintf("%.3f", Multi_p))) %>% select(Variable, Level, Uni, Uni_p, Multi, Multi_p) %>% bind_rows(tribble(~Variable, ~Level, ~Uni, ~Uni_p, ~Multi, ~Multi_p, "group", "Group A (ref)", "", "", "", "", "hr_status", "HR negative (ref)", "", "", "", "", "grade_f", "Grade I (ref)", "", "", "", "", "final_stage", "Stage 1A (ref)", "", "", "", "")) %>% arrange(factor(Variable, levels = c("group", "Age", "hr_status", "grade_f", "final_stage")), case_when(grepl("ref", Level) ~ 0, TRUE ~ 1), Level) %>% flextable() %>% set_header_labels(Variable="Variable", Level="Level", Uni="Univariate HR (95% CI)", Uni_p="Univariate p", Multi="Multivariate HR (95% CI)", Multi_p="Multivariate p") %>% add_header_row(values = title, colwidths = 6) %>% autofit() %>% bold(i = ~ as.numeric(Uni_p) < 0.05 | as.numeric(Multi_p) < 0.05, bold = TRUE)
}
# 印出標準發表格式表格
format_cox(run_cox(surv_os_full, df_analysis, vars), "Table 3a. Cox Regression for Overall Survival (Full Follow-up)")Table 3a. Cox Regression for Overall Survival (Full Follow-up) | |||||
|---|---|---|---|---|---|
Variable | Level | Univariate HR (95% CI) | Univariate p | Multivariate HR (95% CI) | Multivariate p |
group | Group A (ref) | ||||
group | Group B | 2.33 (0.94–5.76) | 0.068 | 0.71 (0.27–1.90) | 0.500 |
group | Group C | 1.29 (0.59–2.81) | 0.524 | 0.97 (0.42–2.23) | 0.935 |
group | Group D | 0.59 (0.36–0.97) | 0.039 | 0.35 (0.19–0.64) | 0.001 |
Age | Age (per year increase) | 1.07 (1.05–1.09) | 0.000 | 1.05 (1.03–1.07) | 0.000 |
hr_status | HR negative (ref) | ||||
hr_status | HR positive | 0.81 (0.54–1.22) | 0.320 | 0.80 (0.52–1.24) | 0.318 |
grade_f | Grade I (ref) | ||||
grade_f | II | 0.49 (0.12–2.02) | 0.324 | 0.19 (0.04–0.88) | 0.034 |
grade_f | III | 0.53 (0.13–2.20) | 0.385 | 0.12 (0.03–0.59) | 0.009 |
grade_f | Unknown | 0.10 (0.02–0.49) | 0.004 | 0.04 (0.01–0.19) | 0.000 |
final_stage | Stage 1A (ref) | ||||
final_stage | 1B | 0.00 (0.00–NA) | 0.994 | 0.00 (0.00–NA) | 0.995 |
final_stage | 2A | 2.53 (1.26–5.09) | 0.009 | 3.25 (1.49–7.09) | 0.003 |
final_stage | 2B | 3.75 (1.81–7.78) | 0.000 | 7.53 (3.20–17.69) | 0.000 |
final_stage | 3A | 3.72 (1.70–8.16) | 0.001 | 7.51 (3.06–18.44) | 0.000 |
final_stage | 3B | 9.27 (2.99–28.75) | 0.000 | 7.70 (2.30–25.76) | 0.001 |
final_stage | 3C | 7.23 (3.62–14.46) | 0.000 | 12.28 (5.39–27.99) | 0.000 |
format_cox(run_cox(surv_rfs_full, df_analysis, vars), "Table 3b. Cox Regression for Recurrence-Free Survival (Full Follow-up)")Table 3b. Cox Regression for Recurrence-Free Survival (Full Follow-up) | |||||
|---|---|---|---|---|---|
Variable | Level | Univariate HR (95% CI) | Univariate p | Multivariate HR (95% CI) | Multivariate p |
group | Group A (ref) | ||||
group | Group B | 2.07 (0.84–5.09) | 0.112 | 0.68 (0.26–1.82) | 0.448 |
group | Group C | 1.08 (0.50–2.34) | 0.837 | 0.53 (0.23–1.22) | 0.136 |
group | Group D | 0.66 (0.41–1.05) | 0.080 | 0.25 (0.14–0.46) | 0.000 |
Age | Age (per year increase) | 1.03 (1.01–1.04) | 0.002 | 1.01 (0.99–1.02) | 0.363 |
hr_status | HR negative (ref) | ||||
hr_status | HR positive | 0.72 (0.49–1.04) | 0.078 | 0.76 (0.52–1.12) | 0.168 |
grade_f | Grade I (ref) | ||||
grade_f | II | Not estimable | 0.993 | Not estimable | 0.995 |
grade_f | III | Not estimable | 0.993 | Not estimable | 0.995 |
grade_f | Unknown | Not estimable | 0.993 | Not estimable | 0.995 |
final_stage | Stage 1A (ref) | ||||
final_stage | 1B | 0.00 (0.00–NA) | 0.994 | 0.00 (0.00–NA) | 0.996 |
final_stage | 2A | 2.39 (1.32–4.32) | 0.004 | 3.93 (2.03–7.60) | 0.000 |
final_stage | 2B | 1.90 (0.92–3.91) | 0.082 | 3.87 (1.72–8.70) | 0.001 |
final_stage | 3A | 2.08 (0.95–4.55) | 0.065 | 4.41 (1.84–10.55) | 0.001 |
final_stage | 3B | 7.40 (2.73–20.07) | 0.000 | 10.42 (3.63–29.89) | 0.000 |
final_stage | 3C | 7.59 (4.26–13.51) | 0.000 | 15.02 (7.40–30.48) | 0.000 |
六、新輔助治療 (NAC) 時代演變趨勢
觀察不同期別與荷爾蒙狀態下，歷史採用新輔助化療（NAC）的趨勢。折線上已加入各年份實際的「總人數（N數）」，以防小樣本比例失真。
summary_nac <- df_analysis %>%
mutate(year = year(DIAG_DT), NAC = as.integer(NAC_binary == 1)) %>%
filter(!is.na(year), !is.na(hr_status)) %>%
group_by(year, final_stage, hr_status) %>%
summarise(total = n(), nac_rate = sum(NAC) / total, .groups = "drop") %>%
filter(final_stage %in% c("1A", "2A", "2B", "3A", "3B", "3C"))
ggplot(summary_nac, aes(x = year, y = nac_rate, color = hr_status)) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
# 數據點上直接標記樣本數 (N)
geom_text(aes(label = total), vjust = -1, size = 3, show.legend = FALSE) +
facet_wrap(~ final_stage, ncol = 3) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1), expand = expansion(mult = c(0.1, 0.2))) +
labs(title = "NAC Adoption Rate Over Time by Stage and HR Status with Sample Counts", x = "Year of Diagnosis", y = "NAC Rate", color = "HR Status") +
theme_minimal(base_size = 14) + theme(legend.position = "bottom")
七、討論區：pT1N0M0 極早期小腫瘤之療效分析 (Subgroup Discussion)
專門探討針對第二章經由漏斗篩選出的極早期小腫瘤患者，實施「降階治療」的療效。本圖已套用專屬四色色票（km_colors）。
# 讀取在第二章時已經算好存活變數的極早期小腫瘤檔案
df_sub <- read.csv("subgroup_t1n0m0_data.csv") %>%
mutate(group = factor(case_when(
CT == 0 & TT == 0 ~ "Group A (None)",
CT == 0 & TT == 1 ~ "Group B (TT only)",
CT == 1 & TT == 0 ~ "Group C (CT only)",
CT == 1 & TT == 1 ~ "Group D (CT+TT)",
TRUE ~ NA_character_
), levels = c("Group A (None)", "Group B (TT only)", "Group C (CT only)", "Group D (CT+TT)"))) %>%
filter(!is.na(group))
if (n_distinct(df_sub$group) >= 2) {
# 繪製 pT1N0M0 專屬 5 年 RFS
fit_sub_rfs <- survfit(Surv(surv_year_rfs_5y, relapse_5y) ~ group, data = df_sub)
p_sub_rfs <- ggsurvplot(fit_sub_rfs, data = df_sub, pval = TRUE, risk.table = TRUE, xlim = c(0, 5), palette = km_colors, title = "Discussion Spec: 5-Year RFS for pT1N0M0", risk.table.height = 0.25, tables.theme = theme_cleantable())
# 繪製 pT1N0M0 專屬 5 年 OS
fit_sub_os <- survfit(Surv(surv_year_os_5y, Vita_m_5y) ~ group, data = df_sub)
p_sub_os <- ggsurvplot(fit_sub_os, data = df_sub, pval = TRUE, risk.table = TRUE, xlim = c(0, 5), palette = km_colors, title = "Discussion Spec: 5-Year OS for pT1N0M0", risk.table.height = 0.25, tables.theme = theme_cleantable())
# 雙圖輸出
grid.newpage()
grid.arrange(p_sub_rfs$plot, p_sub_os$plot, p_sub_rfs$table, p_sub_os$table, ncol = 2, heights = c(4, 1.2))
}