在R中对蜥蜴肋骨数据分3段计算delta的实现方法问询

需求说明 #

现有R数据框包含10种蜥蜴（A-J）的肋骨长度（Xₙ）、肋间隙长度（Yₙ）、肋骨数量（n.ribs）、胸腔总长度（total.length）及全局delta指标。需将每条蜥蜴的肋骨结构分为3段：

• 分段规则：每段肋骨数近似相等，无法均分时第一段向上取整，后两段向下取整，且每段必须以Xₙ开头
• 分段delta计算：段内肋骨数 ÷（段总长度 - 段内最后一根肋骨长度），结果命名为delta.1.3、delta.2.3、delta.3.3

完整实现代码 #

# 生成原始数据（用户提供）
data <- data.frame(X1 = runif(10),
                   Y1 = runif(10),
                   X2 = runif(10),
                   Y2 = runif(10),
                   X3 = runif(10),
                   Y3 = runif(10),
                   X4 = runif(10),
                   Y4 = runif(10),
                   X5 = runif(10),
                   Y5 = runif(10),
                   X6 = runif(10),
                   Y6 = runif(10),
                   X7 = runif(10),
                   Y7 = c(NA,runif(9)),
                   X8 = c(NA,runif(9)),
                   Y8 = c(NA,NA,runif(8)),
                   X9 = c(NA,NA,runif(8)),
                   Y9 = c(NA,NA,NA,runif(7)),
                   X10 = c(NA,NA,NA,runif(7)),
                   Y10 = c(NA,NA,NA,NA,runif(6)),
                   X11 = c(NA,NA,NA,NA,runif(6)),
                   Y11 = c(NA,NA,NA,NA,NA,runif(5)),
                   X12 = c(NA,NA,NA,NA,NA,runif(5)),
                   Y12 = c(NA,NA,NA,NA,NA,runif(5)),
                   X13 = c(NA,NA,NA,NA,NA,runif(5)),
                   Y13 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   X14 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   Y14 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   X15 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   Y15 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   X16 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   Y16 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   X17 = c(NA,NA,NA,NA,NA,NA,runif(4)),
                   Y17 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)),
                   X18 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)),
                   Y18 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)),
                   X19 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)),
                   Y19 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)),
                   X20 = c(NA,NA,NA,NA,NA,NA,NA,NA,runif(2)))

row.names(data) <- LETTERS[1:10]

# 基础指标计算（复用用户原有代码）
data$n.ribs <- rowSums(!is.na(data[,seq(from = 1, to = 39, by = 2)]))
data$total.length <- rowSums(data[,1:39], na.rm = TRUE)
subset.data <- data[,1:39]
last.X.value <- subset.data[cbind(seq_len(nrow(subset.data)), max.col(!is.na(subset.data), "last"))]
data$delta <- data$n.ribs / (data$total.length - last.X.value)

# 定义分段delta计算函数
calculate_segment_deltas <- function(row_data) {
  # 提取当前蜥蜴的非NA测量值及对应列名
  non_na_vals <- row_data[1:39][!is.na(row_data[1:39])]
  non_na_names <- names(non_na_vals)
  
  # 获取当前蜥蜴的肋骨总数
  n_ribs <- row_data["n.ribs"]
  
  # 确定每段应包含的肋骨数量
  seg1_ribs <- ceiling(n_ribs / 3)
  seg2_ribs <- floor(n_ribs / 3)
  seg3_ribs <- n_ribs - seg1_ribs - seg2_ribs
  
  # 定位所有X类指标的位置索引
  x_indices <- grep("^X", non_na_names)
  
  # 确定第一段的结束位置：包含seg1_ribs根肋骨及对应间隙（如果存在）
  seg1_end_x <- x_indices[seg1_ribs]
  seg1_end <- ifelse(seg1_end_x < length(non_na_names) && grepl("^Y", non_na_names[seg1_end_x + 1]),
                     seg1_end_x + 1, seg1_end_x)
  
  # 确定第二段的起止位置：从第seg1_ribs+1根肋骨开始，包含seg2_ribs根肋骨及对应间隙
  seg2_start_x <- x_indices[seg1_ribs + 1]
  seg2_end_x <- x_indices[seg1_ribs + seg2_ribs]
  seg2_end <- ifelse(seg2_end_x < length(non_na_names) && grepl("^Y", non_na_names[seg2_end_x + 1]),
                     seg2_end_x + 1, seg2_end_x)
  
  # 确定第三段的起止位置：从剩余第一根肋骨开始到最后一个测量值
  seg3_start_x <- x_indices[seg1_ribs + seg2_ribs + 1]
  seg3_end <- length(non_na_vals)
  
  # 拆分三段数据
  seg1 <- non_na_vals[1:seg1_end]
  seg2 <- non_na_vals[seg2_start_x:seg2_end]
  seg3 <- non_na_vals[seg3_start_x:seg3_end]
  
  # 单段delta计算子函数
  compute_delta <- function(segment) {
    seg_rib_count <- length(grep("^X", names(segment)))
    seg_total <- sum(segment)
    seg_last_x <- segment[tail(grep("^X", names(segment)), 1)]
    return(seg_rib_count / (seg_total - seg_last_x))
  }
  
  # 计算三段delta并返回
  return(c(delta.1.3 = compute_delta(seg1),
           delta.2.3 = compute_delta(seg2),
           delta.3.3 = compute_delta(seg3)))
}

# 批量处理所有蜥蜴，合并结果到原数据框
segment_deltas <- t(apply(data, 1, calculate_segment_deltas))
data <- cbind(data, segment_deltas)

# 查看核心结果示例
head(data[, c("n.ribs", "delta", "delta.1.3", "delta.2.3", "delta.3.3")])

关键逻辑说明 #

1. 分段准确性：通过定位X类指标的索引，确保每段严格以Xₙ开头，同时自动包含对应肋间隙Yₙ（如果存在）
2. 批量处理：使用apply对数据框逐行处理，避免单条蜥蜴重复代码
3. 规则适配：严格遵循“第一段向上取整，后两段向下取整”的肋骨数分配规则，即使肋骨总数无法被3整除也能正确分段
4. 逻辑复用：保留用户原有全局delta的计算逻辑，确保分段指标与全局指标计算规则一致

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