# ============================================
#数据预处理流程：
#1.合并多个季度文件（DEMO、DRUG、REAC、OUTC、INDI、THER、RPSR）
#2.应用Deleted文件删除废弃Case（从2019Q1 起）
#3.去重（官方推荐的规则）
#4.用去重后的 PRIMARYID 连接其它表（DRUG / REAC / OUTC / INDI / THER / RPSR）
#5.标准化药名
#6.标准化不良事件（REAC）与 Indication（INDI），绑定 MedDRA 版本
#7.清洗人口学字段、时间字段、结果字段（AGE, WT, OUTC, SERIOUSNESS）
#8.最后的质量控制
# 设置原始 zip 文件所在文件夹路径
zip_dir <- "E:\\Faers\\zip" # 替换为你的 zip 文件所在路径
# 设置所有 zip 文件解压后的主文件夹路径
output_main_dir <- "E:\\Faers\\2021_2025" # 替换为你想存放解压文件夹的位置
# 如果主文件夹不存在，则创建它
if (!dir.exists(output_main_dir)) {
dir.create(output_main_dir, recursive = TRUE)
}
# 获取所有 zip 文件完整路径
zip_files <- list.files(zip_dir, pattern = "\\.zip$", full.names = TRUE)
# 循环处理每个 zip 文件
for (zip_file in zip_files) {
# 提取文件名（不含路径和 .zip 后缀）
zip_name <- tools::file_path_sans_ext(basename(zip_file))
# 创建解压的目标子文件夹路径
output_subdir <- file.path(output_main_dir, zip_name)
# 如果子文件夹不存在，则创建
if (!dir.exists(output_subdir)) {
dir.create(output_subdir, recursive = TRUE)
}
# 解压到目标子文件夹
unzip(zip_file, exdir = output_subdir)
# 打印状态信息
cat("已解压：", zip_name, " 到 ", output_subdir, "\n")
}
cat(" 所有文件已成功解压完毕！共解压 ", length(zip_files), " 个 zip 文件。\n")
# ============================================
#加载必要的包
library(readr) # 用于高效读取文本文件
library(dplyr) # 用于数据处理和合并
#设置FAERS主目录路径（含多个子季度）
faers_dir <- "E:\\Faers\\2021_2025"
#设置合并结果的输出目录
output_dir <- "E:\\Faers\\merge"
#如果输出目录不存在，则创建
if (!dir.exists(output_dir)) {
dir.create(output_dir, recursive = TRUE)
}
#要处理的7种FAERS文件类型c("DEMO", "DRUG", "REAC", "OUTC", "RPSR", "THER", "INDI")
file_types <- c("DEMO", "DRUG", "REAC","OUTC", "RPSR", "THER", "INDI")
#初始化列表以存储每种类型合并的数据框
merged_data_list <- list()
#遍历每种文件类型，查找并合并所有相关文件
for (type in file_types) {
cat("正在处理类型：", type, "\n")
# 在所有子文件夹中查找以该类型开头的txt文件（不区分大小写）
files <- list.files(path = faers_dir,
pattern = paste0("^", type, ".*\\.txt$"),
recursive = TRUE,
full.names = TRUE,
ignore.case = TRUE)
if (length(files) == 0) {
warning(paste("未找到类型", type, "的文件，跳过此类型"))
next
}
# 逐个文件读取并合并
type_data <- do.call(rbind, lapply(files, function(f) {
read_tsv(f, show_col_types = FALSE, progress = FALSE)
}))
# 保存合并结果到列表
merged_data_list[[type]] <- type_data
# 保存为新的txt文件到指定输出目录
output_file <- file.path(output_dir, paste0("Merged_", type, ".txt"))
write_tsv(type_data, file = output_file)
cat( type, "合并完成，共", nrow(type_data), "行，保存为：", output_file, "\n")
}
# ============================================
# FAERS 数据清洗（按 caseid 删除）
# 直接删除 Delete 文件中的 caseid 记录
# 输出格式统一为 .tsv（制表符分隔）
# ============================================
#加载必要的包
library(readr) # 高效读取 / 写入 TSV 文件
library(dplyr) # 数据处理
library(stringr) # 字符串处理
library(purrr) # 函数式编程
library(fs) # 文件路径处理
#设置路径
input_dir <- "E:/Faers/merge" # 已合并的主表路径（Merged_xxx.txt）
faers_root <- "E:/Faers/2021_2025" # 含所有季度原始文件（含 Delete 文件）
output_dir <- "E:/Faers/cleaned" # 清洗结果保存路径
#如果输出目录不存在则创建
if (!dir_exists(output_dir)) dir_create(output_dir)
# 汇总 Delete 文件中的 caseid
cat("正在查找 Delete 文件...\n")
delete_files <- dir_ls(
faers_root,
recurse = TRUE,
regexp = "(?i)delete.*\\.txt$", # 匹配各种 Delete 文件（忽略大小写）
type = "file"
)
cat("读取并汇总 Delete 文件中的 caseid...\n")
delete_caseids <- map(delete_files, function(f) {
lines <- read_lines(f) # 逐行读取
lines <- lines[!str_detect(lines, "deleted|caseid|^\\s*$")] # 去除表头、空行
str_trim(lines) # 去除多余空格
}) |> unlist() |> unique() # 展平 + 去重
# 保存汇总 caseid 结果（可选）
write_tsv(data.frame(caseid = delete_caseids),
file.path(output_dir, "All_Deleted_CASEIDs.tsv"))
cat(" 汇总删除 CASEID 数量：", length(delete_caseids), "\n")
# 按 caseid 删除并保存结果
file_types <- c("DEMO", "DRUG", "REAC", "OUTC", "RPSR", "THER", "INDI")
for (type in file_types) {
cat("正在清洗：", type, "...\n")
input_file <- file.path(input_dir, paste0("Merged_", type, ".txt"))
# 如果输入文件不存在，跳过
if (!file_exists(input_file)) {
warning("未找到文件：", input_file)
next
}
# 读取合并表（分隔符是 $）
data <- read_delim(
input_file,
delim = "$",
quote = "",
escape_double = FALSE,
col_types = cols(.default = "c"),
show_col_types = FALSE
) %>% rename_with(tolower) # 字段名统一为小写，方便匹配
# 如果没有 caseid 字段，则跳过
if (!"caseid" %in% names(data)) {
warning( type, " 文件中未找到 'caseid' 字段，跳过")
next
}
# 删除出现在 Delete 列表中的记录
cleaned <- data %>%
filter(!caseid %in% delete_caseids)
# 输出为 .tsv（标准制表符分隔）
output_file <- file.path(output_dir, paste0("Cleaned_", type, ".tsv"))
write_tsv(cleaned, file = output_file)
cat("已保存清洗后的 ", type, " 文件，共 ", nrow(cleaned), " 条记录。\n")
}
cat("全部处理完成！清洗结果已保存到：", output_dir, "\n")
# ============================================
# （补充QC报告）应用Deleted文件删除废弃Case
library(readr)
library(dplyr)
library(fs)
#路径设置
input_dir <- "E:/Faers/merge" # 清洗前文件夹 (Merged_xxx.txt)
output_dir <- "E:/Faers/cleaned" # 清洗后文件夹 (Cleaned_xxx.tsv)
#自动读取删除的 caseid / primaryid 列表
delete_caseids <- read_tsv(file.path(output_dir, "All_Deleted_CASEIDs.tsv"),
show_col_types = FALSE)$caseid
delete_primaryids <- unique(read_tsv(file.path(output_dir, "All_Deleted_CASEIDs.tsv"),
show_col_types = FALSE)$caseid)
#初始化 QC 结果表
qc_results <- data.frame(
table_name = character(),
caseid_before = integer(),
caseid_after = integer(),
primaryid_before = integer(),
primaryid_after = integer(),
deleted_caseid_n = integer(),
deleted_primaryid_n = integer(),
delete_ratio_percent = numeric(),
status = character(),
stringsAsFactors = FALSE
)
#要检查的表
check_tables <- c("DEMO", "DRUG", "REAC", "OUTC", "RPSR", "THER", "INDI")
for (tbl in check_tables) {
# 读取清洗前数据
merged_file <- file.path(input_dir, paste0("Merged_", tbl, ".txt"))
if (!file.exists(merged_file)) next
before_data <- read_delim(merged_file, delim = "$",
col_types = cols(.default = "c"),
show_col_types = FALSE)
# 注意大小写，统一转小写
names(before_data) <- tolower(names(before_data))
before_caseid_n <- if ("caseid" %in% names(before_data)) length(unique(before_data$caseid)) else NA
before_primaryid_n <- if ("primaryid" %in% names(before_data)) length(unique(before_data$primaryid)) else NA
# 读取清洗后数据
cleaned_file <- file.path(output_dir, paste0("Cleaned_", tbl, ".tsv"))
if (!file.exists(cleaned_file) && tbl == "DEMO") {
cleaned_file <- file.path(output_dir, "Cleaned_DEMO.tsv")
}
if (!file.exists(cleaned_file)) next
after_data <- read_tsv(cleaned_file, col_types = cols(.default = "c"), show_col_types = FALSE)
names(after_data) <- tolower(names(after_data))
after_caseid_n <- if ("caseid" %in% names(after_data)) length(unique(after_data$caseid)) else NA
after_primaryid_n <- if ("primaryid" %in% names(after_data)) length(unique(after_data$primaryid)) else NA
# 计算删除数量
deleted_caseid_n <- if (!is.na(before_caseid_n) & !is.na(after_caseid_n)) before_caseid_n - after_caseid_n else 0
deleted_primaryid_n <- if (!is.na(before_primaryid_n) & !is.na(after_primaryid_n)) before_primaryid_n - after_primaryid_n else 0
# 删除比例（基于 primaryid）
delete_ratio <- if (!is.na(before_primaryid_n) & before_primaryid_n > 0) {
round(deleted_primaryid_n / before_primaryid_n * 100, 2)
} else 0
# 检查是否真的删干净了
still_has_deleted <- FALSE
if ("caseid" %in% names(after_data)) {
if (length(intersect(unique(after_data$caseid), delete_caseids)) > 0) still_has_deleted <- TRUE
}
if ("primaryid" %in% names(after_data)) {
if (length(intersect(unique(after_data$primaryid), delete_primaryids)) > 0) still_has_deleted <- TRUE
}
status <- ifelse(still_has_deleted, "NOT_OK", "OK")
# 加入 QC 结果表
qc_results <- rbind(qc_results, data.frame(
table_name = tbl,
caseid_before = before_caseid_n,
caseid_after = after_caseid_n,
primaryid_before = before_primaryid_n,
primaryid_after = after_primaryid_n,
deleted_caseid_n = deleted_caseid_n,
deleted_primaryid_n = deleted_primaryid_n,
delete_ratio_percent = delete_ratio,
status = status,
stringsAsFactors = FALSE
))
}
#输出 QC 报告
qc_file <- file.path(output_dir, "Deleted_Case_QC_Report.csv")
write_csv(qc_results, qc_file)
cat("删除验证报告已生成：", qc_file, "\n")
# ============================================
# ============================
# FDA 推荐规则的 DEMO 去重脚本
# 规则：对相同 CASEID，保留 FDA_DT 最大的记录；若 FDA_DT 相同，保留 PRIMARYID 最大的记录
# 入口：使用“已应用 DeletedCases 删除”的 DEMO（Cleaned_DEMO.tsv）
# 产物：Deduped_DEMO.tsv（去重后 DEMO）；DEMO_Dedup_QC.csv（去重前后对照）
# ============================
#1) 加载依赖包
library(readr) # 高效读写分隔文本
library(dplyr) # 数据处理
library(lubridate) # 日期解析
library(stringr) # 字符串处理
library(fs) # 文件路径与目录操作
#2) 基本路径与文件名配置（按需修改）
input_dir <- "E:/Faers/cleaned" # 你“删除废弃 case”后输出 DEMO 的目录
output_dir <- "E:/Faers/dedup" # 去重结果与 QC 报告输出目录
if (!dir_exists(output_dir)) dir_create(output_dir) # 若无则创建
# 输入 DEMO（已删除无效 case）——如果你想直接用合并后的 DEMO 去重，把下面改成 Merged_DEMO.txt 且把 delim 改为 "$"
input_demo_file <- file.path(input_dir, "Cleaned_DEMO.tsv")
input_delim <- "\t" # Cleaned_DEMO.tsv 是你用 write_tsv 写出的，分隔符为制表符
# 输出文件
dedup_demo_file <- file.path(output_dir, "Deduped_DEMO.tsv") # 去重后的 DEMO
qc_csv_file <- file.path(output_dir, "DEMO_Dedup_QC.csv") # 去重 QC 报告
removed_file <- file.path(output_dir, "Removed_PRIMARYIDs.tsv") # 被删除的 PRIMARYID（审计用，可选）
#3) 读入 DEMO（已删除废弃 case）
cat("读取 DEMO：", input_demo_file, "\n")
# 用 read_delim 读取，并把所有列先按字符型读入，避免类型误判
demo_raw <- read_delim(
input_demo_file,
delim = input_delim,
col_types = cols(.default = "c"),
show_col_types = FALSE,
progress = TRUE,
trim_ws = TRUE
)
#4) 统一列名大小写并做存在性检查
demo <- demo_raw %>%
rename_with(tolower) # 全部列名转小写，便于后续稳健引用
# 检查关键字段是否存在（必须有 caseid、primaryid、fda_dt）
required_cols <- c("caseid", "primaryid", "fda_dt")
missing_cols <- setdiff(required_cols, names(demo))
if (length(missing_cols) > 0) {
stop(" DEMO 缺少关键字段：", paste(missing_cols, collapse = ", "),
"\n请检查输入文件是否为官方 DEMO 结构，或列名是否被意外改动。")
}
# 5) 去重前的计数（QC 基线）
n_rows_before <- nrow(demo) # 去重前行数
n_caseid_before <- n_distinct(demo$caseid) # 去重前唯一 CASEID 数
n_primaryid_before <- n_distinct(demo$primaryid) # 去重前唯一 PRIMARYID 数
# 6) 解析 FDA_DT（尽量保证鲁棒性）
# 官方常见格式为 YYYYMMDD；也可能是其它常见日期格式，这里用多轮尝试保证尽可能解析成功
parse_fda_dt_safe <- function(x) {
x <- str_trim(x) # 先去首尾空白
y <- suppressWarnings(ymd(x)) # 第一轮：YYYY-MM-DD 或 YYYYMMDD
idx_na <- is.na(y) # 记录未解析的索引
if (any(idx_na)) {
y[idx_na] <- suppressWarnings(mdy(x[idx_na])) # 第二轮：MM/DD/YYYY
}
idx_na <- is.na(y)
if (any(idx_na)) {
y[idx_na] <- suppressWarnings(ymd_hms(x[idx_na])) # 第三轮：带时分秒
}
return(y) # 返回 Date/POSIXct，仍解析不了则为 NA
}
# 将 FDA_DT 解析成日期，并构造排序用的“安全键”（NA 视为最小值）
demo <- demo %>%
mutate(
fda_dt_parsed = parse_fda_dt_safe(fda_dt), # 解析 FDA_DT
fda_dt_key = if_else(is.na(fda_dt_parsed),
as.Date("1900-01-01"), # NA 作为早期日期，以便不会“误胜”
as.Date(fda_dt_parsed))
)
#7) 构造 PRIMARYID 数值键用于比较大小（无法转为数字的设为 -Inf）
# 注意：PRIMARYID 本质是数字 ID，这里用 suppressWarnings 转为数值，失败则 NA，再替换为 -Inf
demo <- demo %>%
mutate(
primaryid_num = suppressWarnings(as.double(primaryid)),
primaryid_key = if_else(is.na(primaryid_num), -Inf, primaryid_num)
)
#8) 严格按 FDA 规则排序 + 去重
# 先按 caseid 升序、fda_dt_key 降序、primaryid_key 降序排序，
# 然后对 caseid 执行 distinct(keep = first)，即可保留组内“最大 FDA_DT；若并列取最大 PRIMARYID”的那一行
demo_sorted <- demo %>%
arrange(caseid, desc(fda_dt_key), desc(primaryid_key))
dedup_demo <- demo_sorted %>%
distinct(caseid, .keep_all = TRUE) %>% # 每个 CASEID 只保留排序后的第一条（即我们定义的“最大值”）
select(-fda_dt_key, -primaryid_key) # 清理中间键列，保留原始字段与解析后的 fda_dt_parsed
# ---- 9) 去重后的计数（QC 对照）----
n_rows_after <- nrow(dedup_demo)
n_caseid_after <- n_distinct(dedup_demo$caseid)
n_primaryid_after <- n_distinct(dedup_demo$primaryid)
# 10) 导出去重后的 DEMO
write_tsv(dedup_demo, dedup_demo_file)
cat("已输出去重后的 DEMO：", dedup_demo_file, "\n")
#11) 可选：导出被删除的 PRIMARYID（便于审计与复现）
removed_primaryids <- setdiff(unique(demo$primaryid), unique(dedup_demo$primaryid))
write_tsv(data.frame(primaryid = removed_primaryids), removed_file)
cat("已输出被移除的 PRIMARYID 列表：", removed_file, "\n")
#12) 生成 QC 报告（去重前后数量对照与比例）
qc <- tibble::tibble(
metric = c("rows", "unique_caseid", "unique_primaryid"),
before = c(n_rows_before, n_caseid_before, n_primaryid_before),
after = c(n_rows_after, n_caseid_after, n_primaryid_after)
) %>%
mutate(
reduced = before - after, # 绝对减少量
reduction_ratio_percent = round(ifelse(before > 0, # 百分比减少
(before - after) / before * 100,
NA_real_), 2)
)
readr::write_csv(qc, qc_csv_file)
cat("已输出去重 QC 报告：", qc_csv_file, "\n")
#13) 额外校验（确保逻辑正确）
# 1) 确认去重后每个 CASEID 只出现一次
dup_caseid_after <- sum(duplicated(dedup_demo$caseid))
if (dup_caseid_after == 0) {
cat("校验通过：去重后每个 CASEID 唯一。\n")
} else {
warning("去重后仍存在重复 CASEID：", dup_caseid_after, "，请检查排序与键构造逻辑。")
}
# 2) 抽样核对：对于随机挑选的若干 caseid，确认保留的就是组内“最大 FDA_DT/PRIMARYID”
set.seed(123)
sample_caseids <- sample(unique(demo$caseid), size = min(5, n_caseid_before))
for (cid in sample_caseids) {
grp <- demo %>% filter(caseid == cid) %>%
arrange(desc(fda_dt_key), desc(primaryid_key))
kept <- dedup_demo %>% filter(caseid == cid)
# 比较第一行（应为保留行）与结果是否一致
same_primaryid <- nrow(kept) == 1 && kept$primaryid[1] == grp$primaryid[1]
if (!same_primaryid) {
warning("抽检发现不一致的 CASEID：", cid, "，请人工复核。")
}
}
cat(" DEMO 去重流程完成。\n")
# ============================================
# 用去重后的 PRIMARYID 连接其它表
# 加载必要包
library(readr) # 读写 TSV/CSV
library(dplyr) # 数据操作
library(stringr) # 字符串处理
library(fs) # 文件/目录判断与创建
# 设置路径 —— 请按实际路径确认
dedup_demo_path <- "E:/Faers/dedup/Deduped_DEMO.tsv" # 去重后 DEMO 路径（必须存在）
cleaned_dir <- "E:/Faers/cleaned" # 已应用 DeletedCases 的从表目录
final_dir <- "E:/Faers/final_dedup_filtered" # 输出目录（本脚本会创建）
# 确保输出目录存在
if (!dir_exists(final_dir)) dir_create(final_dir) # 若不存在则创建
# 读取去重后的 DEMO 文件（全部按字符读入，列名统一小写）
if (!file_exists(dedup_demo_path)) stop("找不到去重后的 DEMO 文件：", dedup_demo_path) # 若不存在则停止
dedup_demo <- read_tsv(dedup_demo_path, col_types = cols(.default = "c"), show_col_types = FALSE) # 读入
dedup_demo <- dedup_demo %>% rename_with(tolower) # 列名转小写，便于后续引用
# 校验 DEMO 中必须包含 primaryid 列
if (!("primaryid" %in% names(dedup_demo))) stop("去重后的 DEMO 文件缺少 'primaryid' 列。请检查。")
# 提取唯一 PRIMARYID 清单（移除 NA 和空字符串，并确保字符型）
primaryid_keep <- dedup_demo %>%
mutate(primaryid = str_trim(primaryid)) %>% # 去掉首尾空白
filter(!is.na(primaryid) & primaryid != "") %>% # 过滤空/NA
distinct(primaryid) %>% # 唯一化
pull(primaryid) # 提取向量
# 记录 DEMO 中 PRIMARYID 数量（基准）
n_demo_ids <- length(primaryid_keep) # 基准数量
cat("DEMO 去重后 PRIMARYID 数量（基准）:", n_demo_ids, "\n") # 打印信息DEMO 去重后 PRIMARYID 数量（基准）: 5445683
# 要处理的从表列表
child_tables <- c("DRUG", "REAC", "OUTC", "INDI", "THER", "RPSR") # 六张表
# 初始化 QC 结果表（用于收集每张表的 before/after 指标）
qc <- tibble::tibble(
table_name = character(),
rows_before = integer(),
rows_after = integer(),
unique_primaryid_before = integer(),
unique_primaryid_after = integer(),
orphan_primaryid_before = integer(), # 在从表里但不在 DEMO 的 primaryid 个数（过滤前）
orphan_primaryid_after = integer(), # 过滤后仍孤立的个数（理论应为 0）
na_primaryid_before = integer(), # primaryid 为 NA/空 的行数（过滤前）
na_primaryid_after = integer(), # primaryid 为 NA/空 的行数（过滤后）
coverage_in_demo_percent = numeric(), # 过滤后在 DEMO 中的 unique_primaryid / n_demo_ids *100
reduction_rows_percent = numeric(), # 行数下降比例（%）
check_all_in_demo_after = character() # PASS/FAIL
)
# 循环处理每张从表
for (tbl in child_tables) {
# 构建 Cleaned_*.tsv 的路径（优先使用已经清洗过的 Cleaned 表）
src_path <- file.path(cleaned_dir, paste0("Cleaned_", tbl, ".tsv"))
# 若 Cleaned 文件不存在，发出警告并跳过该表
if (!file_exists(src_path)) {
warning("未找到文件：", src_path, "，已跳过 ", tbl) # 警告并跳过
next
}
# 读取从表（tab 分隔，全部作为字符）
df <- read_tsv(src_path, col_types = cols(.default = "c"), show_col_types = FALSE)
# 统一列名小写
df <- df %>% rename_with(tolower)
# 若没有 primaryid 列，记录警告并跳过
if (!("primaryid" %in% names(df))) {
warning(tbl, " 表中缺少 'primaryid' 列，跳过该表。")
next
}
# 标准化 primaryid 列（trim）
df <- df %>% mutate(primaryid = str_trim(primaryid))
# 统计过滤前指标
rows_before <- nrow(df) # 总行数
na_before <- sum(is.na(df$primaryid) | df$primaryid == "") # primaryid NA/空 的行数
uniq_before <- length(unique(df$primaryid[!is.na(df$primaryid) & df$primaryid != ""])) # 唯一 primaryid 数
# 计算过滤前孤儿 ID（在从表中但不在 DEMO 清单）
orphan_before <- length(setdiff(unique(df$primaryid[!is.na(df$primaryid) & df$primaryid != ""]),
primaryid_keep))
# 用去重后的 PRIMARYID 对从表进行过滤（只保留 demo 中存在的 primaryid）
df_filtered <- df %>% filter(primaryid %in% primaryid_keep)
# 统计过滤后指标
rows_after <- nrow(df_filtered) # 过滤后行数
na_after <- sum(is.na(df_filtered$primaryid) | df_filtered$primaryid == "") # 过滤后 NA/空
uniq_after <- length(unique(df_filtered$primaryid[!is.na(df_filtered$primaryid) & df_filtered$primaryid != ""])) # 唯一 primaryid 数
orphan_after <- length(setdiff(unique(df_filtered$primaryid[!is.na(df_filtered$primaryid) & df_filtered$primaryid != ""]),
primaryid_keep)) # 理论应该为 0
# 计算覆盖率与行数减少百分比
coverage <- if (n_demo_ids > 0) round(uniq_after / n_demo_ids * 100, 4) else NA_real_
reduc_rows_pct <- if (rows_before > 0) round((rows_before - rows_after) / rows_before * 100, 4) else NA_real_
pass_flag <- ifelse(orphan_after == 0, "PASS", "FAIL") # 检查过滤后是否还有孤儿
# 将过滤后的从表写出到 final_dir
out_file <- file.path(final_dir, paste0("Final_", tbl, ".tsv")) # 输出文件名
write_tsv(df_filtered, out_file) # 写出（tab 分隔）
cat("已输出：", out_file, " (rows_after=", rows_after, ")\n", sep = "") # 打印输出信息
# 若存在过滤前的孤儿 ID，写出示例文件供人工检查（最多写 200 个示例）
if (orphan_before > 0) {
orphan_ids_before <- setdiff(unique(df$primaryid[!is.na(df$primaryid) & df$primaryid != ""]),
primaryid_keep)
write_tsv(data.frame(primaryid = head(orphan_ids_before, 200)),
file.path(final_dir, paste0("OrphanIDs_before_", tbl, ".tsv")))
}
# 若过滤后仍出现孤儿（理论不应发生），写出示例文件并发出警告
if (orphan_after > 0) {
orphan_ids_after <- setdiff(unique(df_filtered$primaryid[!is.na(df_filtered$primaryid) & df_filtered$primaryid != ""]),
primaryid_keep)
write_tsv(data.frame(primaryid = head(orphan_ids_after, 200)),
file.path(final_dir, paste0("OrphanIDs_after_", tbl, ".tsv")))
warning("表 ", tbl, " 过滤后仍存在不在 DEMO 的 PRIMARYID（示例已写出）。请检查。")
}
# 将这张表的 QC 指标追加到 qc 表
qc <- bind_rows(qc, tibble::tibble(
table_name = tbl,
rows_before = rows_before,
rows_after = rows_after,
unique_primaryid_before = uniq_before,
unique_primaryid_after = uniq_after,
orphan_primaryid_before = orphan_before,
orphan_primaryid_after = orphan_after,
na_primaryid_before = na_before,
na_primaryid_after = na_after,
coverage_in_demo_percent = coverage,
reduction_rows_percent = reduc_rows_pct,
check_all_in_demo_after = pass_flag
))
}
# 额外：把 DEMO 自身作为基准行追加到 QC 报告（可选，但有助于查看对照）
qc_demo <- tibble::tibble(
table_name = "DEMO_dedup_base",
rows_before = nrow(dedup_demo),
rows_after = nrow(dedup_demo),
unique_primaryid_before = length(unique(dedup_demo$primaryid)),
unique_primaryid_after = length(unique(dedup_demo$primaryid)),
orphan_primaryid_before = 0,
orphan_primaryid_after = 0,
na_primaryid_before = sum(is.na(dedup_demo$primaryid) | trimws(dedup_demo$primaryid) == ""),
na_primaryid_after = sum(is.na(dedup_demo$primaryid) | trimws(dedup_demo$primaryid) == ""),
coverage_in_demo_percent = 100,
reduction_rows_percent = 0,
check_all_in_demo_after = "PASS"
)
qc <- bind_rows(qc_demo, qc) # 将 DEMO 行放到 QC 顶部
# 将 QC 报告写出为 CSV（CSV 便于导入 Excel / R Markdown）
qc_file <- file.path(final_dir, "Linking_Consistency_QC.csv") # QC 报告路径
write_csv(qc, qc_file) # 写出 CSV（UTF-8）
cat("一致性 QC 报告已生成：", qc_file, "\n") # 打印完成信息
# 最后：如果任一表标记 FAIL，则发出总提醒（但不自动中止）
if (any(qc$check_all_in_demo_after == "FAIL")) {
warning("检测到至少一张从表在过滤后仍含不在 DEMO 的 PRIMARYID，请检查 final_dedup_filtered 目录中的 OrphanIDs_after_* 文件并排查原因。")
} else {
cat("所有从表在过滤后均不含孤儿 PRIMARYID，一致性验证通过。\n")
}