与在R中创建NLS模型有关的问题

Question

我愿意根据功能固化〜A * Atan（B * Time）插入两条曲线，并拟合以下代码中报告的数据。我遇到两个问题：

library(tidyverse)
library(investr)
library(ggplot2)


#DATAFRAME
RawData <- data.frame("Time" = c(0, 4, 8, 24, 28, 32, 0, 4, 8, 24, 28, 32), "Curing" = c(0, 28.57, 56.19, 86.67, 89.52, 91.42, 0, 85.71, 93.33, 94.28, 97.62, 98.09), "Grade" = c("Product A", "Product A", "Product A", "Product A", "Product A", "Product A", "Product B", "Product B", "Product B", "Product B", "Product B", "Product B"))
attach(RawData)


model <- nls(Curing ~ a * atan(b * Time), data= RawData, control=nls.control(printEval=TRUE, minFactor=2^-24, warnOnly=TRUE))
new.data <- data.frame(time=seq(1, 32, by = 0.1))
interval <- as_tibble(predFit(model, newdata = new.data, interval = "confidence", level= 0.9)) %>% mutate(Time = RawData$Time)

第一个是输入最后一行后立即错误： 分配中的错误（Xname，newdata [，xName]）：第一个参数无效 我试图在没有成功的情况下更改new.data的值。如果我删除了可选的参数newdata =我可以合适，但是看起来拟合是在插值的，而无需区分两个系列的整个数据集。

命令行的下方以获取图形：

Graph <- ggplot(data=RawData, aes(x=`Time`, y=`Curing`, col=Grade)) + geom_point(aes(color = Grade), shape = 1, size = 2.5) 

Graph + geom_line(data=interval, aes(x = Time, y = fit))+
      geom_ribbon(data=interval, aes(x=Time, ymin=lwr, ymax=upr), alpha=0.5, inherit.aes=F, fill="blue")+
      theme_classic()

是否可以同时拥有：平滑而串联分开的拟合？

Answer 1

您的错误是由错别字（time而不是time in new.data）引起的。但是，这将无法解决为每个系列获得一个色带的问题。

为了一次性，您将需要两个不同的模型来为两组不同的数据集。最好使用拆分式插入式习语来创建一个单个预测数据框架。它还有助于绘制是否具有等级列，并且fit列将其重命名为curing，

library(tidyverse)
library(investr)
library(ggplot2)

pred_df <- do.call(rbind, lapply(split(RawData, RawData$Grade), function(d) {
  new.data <- data.frame(Time = seq(0, 32, by = 0.1))
  nls(Curing ~ a * atan(b * Time), data = d, start = list(a = 5, b = 1)) %>%
  predFit(newdata = new.data, interval = "confidence", level = 0.9) %>%
  as_tibble() %>%
  mutate(Time = new.data$Time,
         Grade = d$Grade[1],
         Curing = fit)
}))

然后允许绘图非常简单：

ggplot(data = RawData, aes(x = Time, y = Curing, color = Grade)) + 
  geom_point(shape = 1, size = 2.5) +
  geom_ribbon(data = pred_df, aes(ymin = lwr, ymax = upr, fill = Grade),
              alpha = 0.3, color = NA) +
  geom_line(data = pred_df) +
  theme_classic(base_size = 16) 

< a href =“ https://i.sstatic.net/tudnz.png” rel =“ nofollow noreferrer”>

---

一般方法

我认为这是一种非常有用的技术，并且可能引起更广泛的兴趣，因此，如果人们希望使用<<<代码> GEOM_SMOOTH 将是围绕NLS创建小包装器，prepfit：

nls_se <- function(formula, data, start, ...) {
  mod <- nls(formula, data, start)
  class(mod) <- "nls_se"
  mod
}

predict.nls_se <- function(model, newdata, level = 0.9, ...) {
  class(model) <- "nls"
  p <- investr::predFit(model, newdata = newdata, 
                        interval = "confidence", level = level)
  list(fit = p, se.fit = p[,3] - p[,1])
}

这允许使用ggplot：

ggplot(data = RawData, aes(x = Time, y = Curing, color = Grade)) + 
  geom_point(size = 2.5) +
  geom_smooth(method = nls_se, formula = y ~ a * atan(b * x),
              method.args = list(start = list(a = 5, b = 1))) +
  theme_minimal(base_size = 16) 

​预测和置信带，我们都可以做：

nls_se <- function(formula, data, start, type = "confidence", ...) {
  mod <- nls(formula, data, start)
  class(mod) <- "nls_se"
  attr(mod, "type") <- type
  mod
}

predict.nls_se <- function(model, newdata, level = 0.9, interval, ...) {
  class(model) <- "nls"
  p <- investr::predFit(model, newdata = newdata, 
                        interval = attr(model, "type"), level = level)
  list(fit = p, se.fit = p[,3] - p[,1])
}

ggplot(data = RawData, aes(x = Time, y = Curing, color = Grade)) + 
  geom_point(size = 2.5) +
  geom_smooth(method = nls_se, formula = y ~ a * atan(b * x), 
              method.args = list(start = list(a = 5, b = 1),
                                 type = "prediction"), alpha = 0.2,
              aes(fill = after_scale(color))) +  
  geom_smooth(method = nls_se, formula = y ~ a * atan(b * x),
              method.args = list(start = list(a = 5, b = 1)),
              aes(fill = after_scale(color))) +
  theme_minimal(base_size = 16)