R 使用带有多个拟合参数的nls模型绘制平滑的外推曲线

我觉得我已经接近找到问题的答案了，但不知怎么的，我就是无法找到答案。我使用nls函数拟合了3个参数，使用了一个相当复杂的函数来描述精子浓度（x轴）范围内的卵子受精成功率（y轴）（Styan模型，）。拟合参数效果很好，但我无法使用

predict

函数绘制平滑的外推曲线（请参见本文末尾）。我猜这是因为我使用了一个未安装在x轴上的值。我的问题是，如何根据使用

nls

函数拟合的模型绘制平滑的外推曲线 在x轴上使用非拟合参数

以下是一个例子：

library(ggplot2)

data.nls <- structure(list(S0 = c(0.23298, 2.32984, 23.2984, 232.98399, 2329.83993, 
23298.39926), fert = c(0.111111111111111, 0.386792452830189, 
0.158415841584158, 0.898648648648649, 0.616, 0.186440677966102
), speed = c(0.035161615379406, 0.035161615379406, 0.035161615379406, 
0.035161615379406, 0.035161615379406, 0.035161615379406), E0 = c(6.86219803476946, 
6.86219803476946, 6.86219803476946, 6.86219803476946, 6.86219803476946, 
7.05624476582978), tau = c(1800, 1800, 1800, 1800, 1800, 1800
), B0 = c(0.000102758645352932, 0.000102758645352932, 0.000102758645352932, 
0.000102758645352932, 0.000102758645352932, 0.000102758645352932
)), .Names = c("S0", "fert", "speed", "E0", "tau", "B0"), row.names = c(NA, 
6L), class = "data.frame")

## Model S

modelS <- function(Fe, tb, Be) with (data.nls,{
x <- Fe*(S0/E0)*(1-exp(-B0*E0*tau))
b <- Fe*(S0/E0)*(1-exp(-B0*E0*tb))
x*exp(-x)+Be*(1-exp(-x)-(x*exp(-x)))*exp(-b)})

## Define starting values

start <- list(Fe = 0.2, tb = 0.1, Be = 0.1)

## Fit the model using nls

modelS.fitted <- nls(formula = fert ~ modelS(Fe, tb, Be), data = data.nls, start = start, 
control=nls.control(warnOnly=TRUE,minFactor=1e-5),trace = T, lower = c(0,0,0), 
upper = c(1, Inf, 1), algorithm = "port")

## Combine model parameters

model.data <- cbind(data.nls, data.frame(pred = predict(modelS.fitted)))

## Plot

ggplot(model.data) +
geom_point(aes(x = S0, y = fert), size = 2) +
geom_line(aes(x = S0, y = pred), lwd = 1.3) +
scale_x_log10()

---

您的函数应该具有参数

（S0、E0、B0、tau、Fe、tb、Be）

nls

将查找传递到其

data

参数的data.frame中的参数，并仅尝试拟合在那里找不到的参数（前提是给定了起始值）。在您的功能中，无需使用这种有趣的

业务。（
with
无论如何都不应该在函数内部使用。它是为了交互使用。）在
predict
newdata
中，必须包含所有变量，即S0、E0、B0和tau

试试这个：

modelS <- function(S0,E0,B0,tau,Fe, tb, Be) {
  x <- Fe*(S0/E0)*(1-exp(-B0*E0*tau))
  b <- Fe*(S0/E0)*(1-exp(-B0*E0*tb))
  x*exp(-x)+Be*(1-exp(-x)-(x*exp(-x)))*exp(-b)}

## Define starting values

start <- list(Fe = 0.2, tb = 0.1, Be = 0.1)

## Fit the model using nls

modelS.fitted <- nls(formula = fert ~ modelS(S0,E0,B0,tau,Fe, tb, Be), data = data.nls, start = start, 
                     control=nls.control(warnOnly=TRUE,minFactor=1e-5),trace = T, lower = c(0,0,0), 
                     upper = c(1, Inf, 1), algorithm = "port")

## Combine model parameters

model.data <- data.frame(
  S0=seq(min(data.nls$S0),max(data.nls$S0),length.out=1e5),
  E0=seq(min(data.nls$E0),max(data.nls$E0),length.out=1e5),
  B0=seq(min(data.nls$B0),max(data.nls$B0),length.out=1e5),
  tau=seq(min(data.nls$tau),max(data.nls$tau),length.out=1e5))
model.data$pred <- predict(modelS.fitted,newdata=model.data)


## Plot

ggplot(data.nls) +
  geom_point(aes(x = S0, y = fert), size = 2) +
  geom_line(data=model.data,aes(x = S0, y = pred), lwd = 1.3) +
  scale_x_log10()

您的函数应该具有参数
（S0、E0、B0、tau、Fe、tb、Be）
nls
将查找传递到其
data
参数的data.frame中的参数，并仅尝试拟合在那里找不到的参数（前提是给定了起始值）。在您的功能中，无需使用这种有趣的
业务。（
with
无论如何都不应该在函数内部使用。它是为了交互使用。）在
predict
newdata
中，必须包含所有变量，即S0、E0、B0和tau

试试这个：

modelS <- function(S0,E0,B0,tau,Fe, tb, Be) {
  x <- Fe*(S0/E0)*(1-exp(-B0*E0*tau))
  b <- Fe*(S0/E0)*(1-exp(-B0*E0*tb))
  x*exp(-x)+Be*(1-exp(-x)-(x*exp(-x)))*exp(-b)}

## Define starting values

start <- list(Fe = 0.2, tb = 0.1, Be = 0.1)

## Fit the model using nls

modelS.fitted <- nls(formula = fert ~ modelS(S0,E0,B0,tau,Fe, tb, Be), data = data.nls, start = start, 
                     control=nls.control(warnOnly=TRUE,minFactor=1e-5),trace = T, lower = c(0,0,0), 
                     upper = c(1, Inf, 1), algorithm = "port")

## Combine model parameters

model.data <- data.frame(
  S0=seq(min(data.nls$S0),max(data.nls$S0),length.out=1e5),
  E0=seq(min(data.nls$E0),max(data.nls$E0),length.out=1e5),
  B0=seq(min(data.nls$B0),max(data.nls$B0),length.out=1e5),
  tau=seq(min(data.nls$tau),max(data.nls$tau),length.out=1e5))
model.data$pred <- predict(modelS.fitted,newdata=model.data)


## Plot

ggplot(data.nls) +
  geom_point(aes(x = S0, y = fert), size = 2) +
  geom_line(data=model.data,aes(x = S0, y = pred), lwd = 1.3) +
  scale_x_log10()

模型
有硬编码的
数据。nls
在其中，因此预测无法使用任何其他数据。
模型
有硬编码的
数据。nls
在其中，因此预测无法使用任何其他数据。+1@Roland特别是关于保持其他协变量不变的最后一句话。感谢您提供了非常有用的帮助回答+1@Roland，特别是关于保持其他协变量不变的最后一句话。谢谢你提供了非常有用的答案！
  S0 <- seq(min(data.nls$S0),max(data.nls$S0),length.out=1e4)
  E0 <- seq(1,20,length.out=20)
  B0 <- unique(data.nls$B0)
  tau <- unique(data.nls$tau)

model.data <- expand.grid(S0,E0,B0,tau)
names(model.data) <- c("S0","E0","B0","tau")

model.data$pred <- predict(modelS.fitted,newdata=model.data)



## Plot

ggplot(model.data) +
  geom_line(data=,aes(x = S0, y = pred, color=interaction(E0,B0,tau)), lwd = 1.3) +
  geom_point(data=data.nls,aes(x = S0, y = fert), size = 2) +
  scale_x_log10()