多个模型的函数中的 B 样条

Question

我正在尝试使用包 ** splines** 制作 B 样条曲线图。

我拥有的数据是

> head(df)
# A tibble: 6 × 4
# Groups:   Model, Drug [1]
  Model Drug      Day   AUC
  <chr> <chr>   <int> <dbl>
1 AB040 (+)-KT5     1 0.178
2 AB040 (+)-KT5     3 0.414
3 AB040 (+)-KT5     4 0.447
4 AB040 (+)-KT5     5 0.485
5 AB040 (+)-KT5     6 0.486
6 AB040 (+)-KT5     7 0.480

> str(df)
gropd_df [102 × 4] (S3: grouped_df/tbl_df/tbl/data.frame)
 $ Model: chr [1:102] "AB040" "AB040" "AB040" "AB040" ...
 $ Day  : int [1:102] 1 3 4 5 6 7 0 1 2 3 ...
 $ AUC  : num [1:102] 0.241 0.505 0.598 0.675 0.712 ...
 $ Drug : chr [1:102] "(+)-KT5" "(+)-KT5" "(+)-KT5" "(+)-KT5" ...

例如，此数据的图表如下所示： （我把药名删了。。。不好意思。。。）

因此，彩色线条代表一个模型，x 轴代表天数，y 轴代表每个模型每天的 AUC 值（这可能因模型而异。

然后，我想做一个功能分析类型，所以第一种方法是在每个药物模型中拟合一个 B 样条。所以我会在每行中得到一个 B 样条，然后在药物中，我会有几个 B 样条。但是，我遇到了一些问题：

我首先创建了一个以这种方式估计此 B 样条的函数：

library(splines)

create_bspline_functions <- function(data) {
  # Check input data frame
  if (!is.data.frame(data)) {
    stop("Input must be a data frame")
  }
  if (any(is.na(data))) {
    stop("Input contains missing values")
  }
  
  # Get unique model names
  models <- unique(data$Model)
  
  # Define function for fitting B-spline
  bspline_func <- function(x, y) {
    knots <- quantile(x, probs = seq(0, 1, by = 0.25))
    bspline <- bs(x, knots = knots, degree = 3)
    fit <- lm(y ~ bspline)
    return(fit)
  }
  
  # Create function for fitting B-spline for each model
  model_funcs <- lapply(models, function(model) {
    model_data <- subset(data, Model == model)
    x <- model_data$Day
    y <- model_data$AUC
    return(bspline_func(x, y))
  })
  
  names(model_funcs) <- models
  
  return(model_funcs)
}

自从我得到所有模型的系数值后，这种方法就起作用了：

bspline_functions <- create_bspline_functions(df)

> bspline_functions
$AB040

Call:
lm(formula = y ~ bspline)

Coefficients:
(Intercept)     bspline1     bspline2     bspline3     bspline4     bspline5     bspline6     bspline7     bspline8  
    0.27859     -0.16504      0.05630     -0.10660      0.02298     -0.01536           NA           NA           NA  

但是当我开始绘制这个时，我遇到了更多问题嘿嘿：

# Create empty data frame for plot data
plot_data <- data.frame(Model = character(), Day = numeric(), AUC = numeric(), stringsAsFactors = FALSE)

# Loop through each model
for (model in unique(RTG_filtered$Model)) {
  # Create a sequence of days for prediction
  days_seq <- seq(0, 7, by = 1)

  # Make predictions and combine with model and day information
  bspline_pred <- data.frame(Model = rep(model, length(days_seq)), 
                             Day = days_seq, 
                             AUC = predict(bspline_functions[[as.character(model)]], newdata = data.frame(Day = days_seq)))

  # Remove rows with missing values
  bspline_pred <- drop_na(bspline_pred)

  # Combine with plot_data
  if (nrow(plot_data) == 0) {
    plot_data <- bspline_pred
  } else {
    plot_data <- rbind(plot_data, bspline_pred)
  }
}

我遇到一个问题：

[1] 8
[1] 312
Error in data.frame(Model = rep(model, length(days_seq)), Day = days_seq,  : 
  arguments imply differing number of rows: 8, 114

我真的不知道还能做什么，我已经重新做了很多次这个函数，但仍然不走运......看起来错误是因为 bspline_pred 数据框和 plot_data 数据框的行数不同我不知道如何解决它。

我试图绘制它生成的内容，但仍然有问题......：

# Plot B-spline functions
ggplot(plot_data, aes(x = Day, y = AUC, color = Model)) +
  geom_line() +
  labs(x = "Days", y = "AUC", title = "B-spline Functions by Model")

你能帮我纠正一下吗？请。