基于多条件循环实现个体删失的R语言代码开发需求

生成随访数据集的R代码 #

# Create the dataset
set.seed(123)  # for reproducibility
new_dataset <- data.frame(
  ID = sample(1000:9999, 10, replace = TRUE)  # Generate ID
)

# Create variables for each year from 2011 to 2017 and assign random numbers from 0 to 5
for (year in 2011:2017) {
  weeks_in_year <- if (year %% 4 == 0) 53 else 52  # Check for leap year

  # Create a matrix for each year with random numbers
  year_matrix <- matrix(sample(0:5, 10 * weeks_in_year, replace = TRUE), ncol = weeks_in_year)

  # Assign the matrix to a new variable with the appropriate column names
  colnames(year_matrix) <- paste0("y_", substr(year, 3, 4), sprintf("%02d", 1:weeks_in_year))
  new_dataset[paste0("y_", substr(year, 3, 4), sprintf("%02d", 1:weeks_in_year))] <- 
    year_matrix
}

# Determine the number of cells to set to blank (70% of total cells)
total_cells <- nrow(new_dataset) * ncol(new_dataset)
cells_to_set_blank <- round(0.7 * total_cells)

# Randomly select cells to set to blank
cells_to_modify <- sample(1:total_cells, cells_to_set_blank, replace = FALSE)
rows_to_modify <- (cells_to_modify - 1) %/% ncol(new_dataset) + 1
cols_to_modify <- (cells_to_modify - 1) %% ncol(new_dataset) + 1

# Set selected cells to blank (empty strings) in the new data frame
for (i in 1:length(cells_to_modify)) {
  new_dataset[rows_to_modify[i], cols_to_modify[i] + 1] <- NA  # +1 to account for 'ID' column
}

# Add start_of_follow_up and end_of_follow_up columns
new_dataset$start_of_follow_up <- c(1146, 1247, 1348, 1449, 1150, 1151, 1150, 1150, 1150, 
                                    1150)
new_dataset$end_of_follow_up   <- c(1248, 1249, 1352, 1552, 1252, 1312, 1205, 1305, 1305, 
                                    1207)

数据集说明 #

• ID为个体标识，每行对应一个个体；
• 以y_开头的变量为周随访数据，格式如y_1148代表2011年第48周，变量值0-5为删失原因编码，NA代表无编码；
• start_of_follow_up和end_of_follow_up为个体随访起止周（格式如1146代表2011年第46周）。

需求 #

对每个个体在其随访起止周范围内的y_开头变量进行多条件检索：

• 优先查找首次出现的编码0、1、2、4，或连续出现两次的编码5；
• 若找到符合条件的事件，生成censored_week变量记录对应周（如1146），同时生成变量记录删失原因；
• 若未找到符合条件的事件，censored_week赋值为随访结束周，删失原因标记为“未删失”。

解决方案代码 #

library(dplyr)
library(tidyr)

# 处理数据集：将宽表转为长表，提取周信息
processed_data <- new_dataset %>%
  pivot_longer(cols = starts_with("y_"), names_to = "week_var", values_to = "code") %>%
  # 从变量名提取周标识（如1146）
  mutate(week_id = as.integer(sub("y_", "", week_var))) %>%
  # 仅保留随访范围内的记录
  filter(week_id >= start_of_follow_up & week_id <= end_of_follow_up) %>%
  # 按个体ID和周排序
  arrange(ID, week_id) %>%
  group_by(ID) %>%
  # 标记连续出现的编码5：当前周和下一周都是5
  mutate(
    consecutive_5 = ifelse(code == 5 & lead(code) == 5, TRUE, FALSE),
    # 标记符合优先条件的事件
    event_flag = case_when(
      code %in% c(0,1,2,4) ~ "single_event",
      consecutive_5 ~ "double_5",
      TRUE ~ NA_character_
    )
  ) %>%
  # 找到每个个体的首个符合条件的事件
  filter(!is.na(event_flag)) %>%
  slice_head(n = 1) %>%
  # 生成结果变量
  mutate(
    censored_week = week_id,
    censored_reason = case_when(
      event_flag == "single_event" ~ paste0("编码", code),
      event_flag == "double_5" ~ "连续两次编码5"
    )
  ) %>%
  ungroup() %>%
  select(ID, censored_week, censored_reason)

# 合并原数据集与结果，处理未找到事件的个体
final_dataset <- new_dataset %>%
  left_join(processed_data, by = "ID") %>%
  mutate(
    censored_week = ifelse(is.na(censored_week), end_of_follow_up, censored_week),
    censored_reason = ifelse(is.na(censored_reason), "未删失", censored_reason)
  )

# 查看结果
head(final_dataset)

代码说明 #

1. 使用tidyr::pivot_longer将宽表转为长表，方便按个体和周进行处理；
2. 提取周标识并筛选出随访范围内的记录；
3. 标记符合条件的事件：单次出现0/1/2/4，或连续两次出现5；
4. 找到每个个体的首个符合条件的事件，生成对应的删失周和原因；
5. 合并回原数据集，对未找到事件的个体赋值随访结束周和“未删失”标记。

内容的提问来源于stack exchange，提问作者user13069688