如何使用SSasympOff获得nls assymptote函数的geom_smooth

Question

我有以下数据框：

df1<- structure(list(Site = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("ALT01"), class = "factor"), Nets = 1:18, Cumulative.spp = c(12L,13L, 15L, 17L, 17L, 17L, 17L, 19L, 19L, 19L, 19L, 20L, 22L, 22L, 22L, 22L, 22L, 22L)), .Names = c("Site", "Nets", "Cumulative.spp"), row.names = c(NA, 18L), class = "data.frame")

我正在尝试使用此函数的geom_smooth响应来获取ggplot2图：

Model1<-nls(Cumulative.spp ~ SSasympOff(Nets, A, lrc, c0), data = df1)

通常，如果我有这样的模型：

Model2 <- lm(Cumulative.spp ~ I(log(Nets), data = df1)

我尝试了两种方法

方法1

我会这样做：

 library(ggplot2)

 ggplot(df1, aes(x=Nets, y = Cumulative.spp)) + geom_point() + geom_smooth(method="lm", formula=y~log(x), fill="blue", fullrange=T) 

但是当我尝试用同义词做同样的事情时，它不起作用：

ggplot(df1, aes(x=Nets, y = Cumulative.spp)) + geom_point() + geom_smooth(method="nls", formula=y~SSasympOff(x, A, lrc, c0), color="blue", fullrange=T) 

但是我得到了这个错误和这个情节：

Warning message:
Computation failed in `stat_smooth()`:
$ operator is invalid for atomic vectors 

方法2

我尝试对原始数据框进行预测以获得置信区间并使用geom_line超过预测值并在时间间隔上使用geom_ribbon，但是当我这样做时

predict(Model1, df1, interval = "confidence")

但我没有得到置信区间，只有预测值

任何帮助将不胜感激

Answer 1

我想，因为我提出了一个我可能会演示的引导方法。在这种情况下，我们将增加残差（see Wikipedia for more information）。我对使用nls不太熟悉，所以有人可能会提出（有效的）理论上的反对意见。

B <- 2500 # bootstrap iterations, big number
pred_mat <- matrix(0, nrow = 18, ncol = B) # initialize matrix
# extract residuals and predictions from original model
resids <- residuals(Model1)
preds <- predict(Model1)
df1$Pred <- preds
for(i in 1:B){
    # bootstrapped dependent variable
    new_y <- preds + sample(resids, replace = TRUE)
    df1$NewY <- new_y
    # fit model
    Model_Boot <- nls(NewY ~ SSasympOff(Nets, A, lrc, c0), data = df1)
    # extract predictions
    pred_mat[,i] <- predict(Model_Boot)
}

# add 2.5% and 97.5% percentile intervals to df1
df1 <- cbind(df1, t(apply(pred_mat, 1, FUN = function(x) quantile(x, c(.025, .975)))))
# rename appropriately
names(df1)[6:7] <- c('lower','upper')

# make plot
ggplot(df1, aes(x = Nets))+
    geom_point(aes(y = Cumulative.spp))+
    geom_line(aes(y = Pred))+
    geom_ribbon(aes(ymin = lower, ymax = upper),
                alpha = .2, fill = 'blue')

Answer 2

我发现这样做了，我认为这比弹力球更简单，但是我会让你们所有人都判断出更好的答案，尽管我会赞成回弹球的答案。

我发现了这个old post，但是我无法在nls2中找到as.lm函数，我发现这个函数有link，我决定使用{ {1}}功能

as.lm.nls

我比使用bootstrap方法更快地得到了这个结果