在R中为不同分组拟合不同非线性方程的问题求助

• 数据集包含Site、Block、Variety、X、Y列，数据层级为Site/Block/Variety（Variety嵌套于Block，Block嵌套于Site）
• 需求：按Site、Block、Variety分组拟合非线性方程：当Variety=2时使用方程 Y ~ (X / (param_a + param_b*X))^3，其余情况使用方程 Y ~ param_a*X^param_b，最终得到包含Site、Block、Variety、param_a、param_b列的数据框
• 尝试代码及警告：

Re<-if(dat$Variety==2) {
  nls_table(dat, Y ~ (X / (param_a + param_b*X))^3, mod_start=c(param_a=1.5, param_b=0.7),   
            .groups = c("Site","Block","Variety"))
} else {
  (nls_table(dat, Y ~ param_a*X^param_b, mod_start=c(param_a=1.2, param_b=0.5),   
             .groups = c("Site","Block","Variety")))}

警告信息：Warning message: In if (dat$Variety == 2) { : the condition has length > 1 and only the first element will be used

问题根源 #

if()函数只能处理长度为1的逻辑向量，而dat$Variety==2会生成一个长度等于数据集行数的逻辑向量，因此R只会判断该向量的第一个元素，导致所有数据都执行同一个分支的拟合，不符合需求。

方法一：拆分数据后分别拟合再合并 #

直接将数据集拆分为Variety=2和其余子集，分别拟合后合并结果：

# 拆分数据集
dat_v2 <- subset(dat, Variety == 2)
dat_other <- subset(dat, Variety != 2)

# 对两个子集分别执行拟合
fit_v2 <- nls_table(dat_v2, Y ~ (X / (param_a + param_b*X))^3, 
                    mod_start = c(param_a=1.5, param_b=0.7),   
                    .groups = c("Site","Block","Variety"))
fit_other <- nls_table(dat_other, Y ~ param_a*X^param_b, 
                       mod_start = c(param_a=1.2, param_b=0.5),   
                       .groups = c("Site","Block","Variety"))

# 合并拟合结果
Re <- rbind(fit_v2, fit_other)

方法二：使用dplyr分组处理（更适配层级数据） #

借助dplyr的分组函数，按Site/Block/Variety逐个分组处理，根据每组的Variety值选择对应拟合方程：

library(dplyr)

Re <- dat %>%
  group_by(Site, Block, Variety) %>%
  group_modify(function(.x, .y) {
    # 根据当前组的Variety值选择拟合方程
    if (.y$Variety == 2) {
      fit_result <- nls_table(.x, Y ~ (X / (param_a + param_b*X))^3, 
                              mod_start = c(param_a=1.5, param_b=0.7),
                              .groups = NULL) # 已分组，无需再次指定分组参数
    } else {
      fit_result <- nls_table(.x, Y ~ param_a*X^param_b, 
                              mod_start = c(param_a=1.2, param_b=0.5),
                              .groups = NULL)
    }
    # 合并分组标识与拟合参数
    cbind(.y, fit_result %>% select(param_a, param_b))
  }) %>%
  ungroup()

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