基于nlsLM的S型曲线拟合：参数提取与可视化问题咨询

1. 解决individual_DFs仅保留最后一个受试者数据的问题 #

原因：循环中直接赋值individual_DFs <- new_data会覆盖已有数据，未做追加操作。
解决方法：初始化空列表存储每个受试者的结果，最后合并为数据框：

# 初始化空列表
individual_list <- list()

# 循环处理每个受试者
for (i in unique(df$subID)) {
  sub_data <- subset(df, subID == i)
  # 拟合S型曲线（替换x为你的自变量列名）
  fit <- nlsLM(mepAMP_pre ~ plateau/(1 + exp((S50 - x)/slope)), 
               data = sub_data, 
               start = list(plateau = max(sub_data$mepAMP_pre), S50 = median(sub_data$x), slope = 1))
  # 提取参数并添加受试者ID
  params <- as.data.frame(t(coef(fit)))
  params$subID <- i
  # 存入列表
  individual_list[[as.character(i)]] <- params
}

# 合并列表为最终数据框
individual_DFs <- do.call(rbind, individual_list)

2. 同时提取pre/post参数并合并到同一数据框 #

定义通用拟合函数减少重复代码，为每个受试者分别拟合pre/post曲线，将参数按行合并：

# 初始化结果数据框
params_df <- data.frame(subID = unique(df$subID))

# 定义S型曲线拟合函数
fit_sigmoid <- function(data, y_col, x_col) {
  y <- data[[y_col]]
  x <- data[[x_col]]
  fit <- nlsLM(y ~ plateau/(1 + exp((S50 - x)/slope)),
               data = data,
               start = list(plateau = max(y), S50 = median(x), slope = 1))
  as.data.frame(t(coef(fit)))
}

# 循环处理每个受试者
for (i in params_df$subID) {
  sub_data <- subset(df, subID == i)
  # 拟合pre、post数据
  pre_params <- fit_sigmoid(sub_data, "mepAMP_pre", "x")
  post_params <- fit_sigmoid(sub_data, "mepAMP_post", "x")
  # 重命名参数列
  colnames(pre_params) <- paste0(colnames(pre_params), "_pre")
  colnames(post_params) <- paste0(colnames(post_params), "_post")
  # 合并到结果数据框
  params_df[params_df$subID == i, c(colnames(pre_params), colnames(post_params))] <- cbind(pre_params, post_params)
}

注：将代码中的x替换为你实际使用的自变量列名。

3. 可视化实现及ggplot异常排查 #

3.1 按受试者分网格展示pre/post拟合曲线 #

先整理包含原始数据和拟合预测值的长格式数据，再分面绘图：

library(ggplot2)
library(dplyr)
library(tidyr)

# 生成拟合预测数据
pred_data <- list()
for (i in unique(df$subID)) {
  sub_data <- subset(df, subID == i)
  x_seq <- seq(min(sub_data$x), max(sub_data$x), length.out = 100)
  # 拟合pre并生成预测值
  fit_pre <- nlsLM(mepAMP_pre ~ plateau/(1 + exp((S50 - x)/slope)),
                   data = sub_data,
                   start = list(plateau = max(sub_data$mepAMP_pre), S50 = median(sub_data$x), slope = 1))
  pred_pre <- data.frame(subID = i, state = "pre", x = x_seq, mepAMP = predict(fit_pre, newdata = data.frame(x = x_seq)), type = "prediction")
  # 拟合post并生成预测值
  fit_post <- nlsLM(mepAMP_post ~ plateau/(1 + exp((S50 - x)/slope)),
                   data = sub_data,
                   start = list(plateau = max(sub_data$mepAMP_post), S50 = median(sub_data$x), slope = 1))
  pred_post <- data.frame(subID = i, state = "post", x = x_seq, mepAMP = predict(fit_post, newdata = data.frame(x = x_seq)), type = "prediction")
  # 转换原始数据为长格式
  raw_sub <- sub_data %>%
    select(subID, x, mepAMP_pre, mepAMP_post) %>%
    pivot_longer(cols = c(mepAMP_pre, mepAMP_post),
                 names_to = "state",
                 values_to = "mepAMP",
                 names_prefix = "mepAMP_") %>%
    mutate(type = "raw")
  # 合并原始与预测数据
  pred_data[[as.character(i)]] <- bind_rows(raw_sub, pred_pre, pred_post)
}
pred_data <- bind_rows(pred_data)

# 分网格绘图
ggplot(pred_data, aes(x = x, y = mepAMP)) +
  geom_point(aes(color = state), data = filter(pred_data, type == "raw")) +
  geom_line(aes(color = state), data = filter(pred_data, type == "prediction")) +
  facet_wrap(~subID, scales = "free") +
  labs(x = "自变量", y = "MEP振幅", color = "状态") +
  theme_bw()

3.2 所有pre、所有post分别绘图 #

# 所有pre拟合曲线汇总图
ggplot(filter(pred_data, state == "pre"), aes(x = x, y = mepAMP, color = factor(subID))) +
  geom_point(data = filter(pred_data, state == "pre" & type == "raw")) +
  geom_line(data = filter(pred_data, state == "pre" & type == "prediction")) +
  labs(x = "自变量", y = "MEP振幅(pre)", color = "受试者ID") +
  theme_bw()

# 所有post拟合曲线汇总图
ggplot(filter(pred_data, state == "post"), aes(x = x, y = mepAMP, color = factor(subID))) +
  geom_point(data = filter(pred_data, state == "post" & type == "raw")) +
  geom_line(data = filter(pred_data, state == "post" & type == "prediction")) +
  labs(x = "自变量", y = "MEP振幅(post)", color = "受试者ID") +
  theme_bw()

3.3 ggplot绘制pre曲线异常排查 #

常见问题及解决：

• 数据格式错误：检查pred_data的x、mepAMP是否为数值型，确认长格式转换正确，无列名或变量类型错误。
• 预测范围异常：确保x_seq的范围与原始数据的x轴范围一致，避免因外推导致的曲线异常。
• 分组逻辑错误：将subID转换为因子类型（factor(subID)），避免ggplot将其当作连续变量处理。
• 模型拟合失败：检查部分受试者的pre模型是否收敛，调整start初始参数或优化模型形式，排除因拟合失败导致的NA预测值。

内容的提问来源于stack exchange，提问作者A.R.