Search code examples
rfunctionnls

nlstools - nlsBoot not working


I'm trying to use nlsBoot function from the nlstools package by applying it to a function I created. I get an error when using nlsBoot from the output of my function. However, if I use directly the nls function with the data it works. What is happening and is there a way around this?

# Nonlinear function to generate data
NEE <- function(GPmax, alpha, resp, PAR) {
  ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp

}

#some data
plot <- rep(c(1,2), each = 2000)
PAR <- 1:2000
dat <- data.table(plot, PAR)
dat[, GPP := (NEE(12, 0.73, -2, PAR) + rnorm(length(PAR), sd=2))]

library(nlstools)

# Function I created
model.fun <- function(df){
  fit <- nls(GPP ~ ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp, 
             start = list(GPmax = 12, alpha = 0.73, resp = -2), data = df)

  return(list(b = summary(nlsBoot(fit))))
}

models <- dat[, list(model.fun(.SD)) , by = .(plot)]

# Error
# Error in data2[, var1] <- fitted1 + sample(scale(resid1, scale = FALSE),  : 
# object of type 'closure' is not subsettable

# Using nls directly outside of the function I created for plot 1.
mod1 <- nls(GPP ~ ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp, 
           start = list(GPmax = 12, alpha = 0.73, resp = -2), data = dat[plot==1])

# Bootstrap of residuals
summary(nlsBoot(mod1,niter=5))

mod2 <- nls(GPP ~ ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp, 
               start = list(GPmax = 12, alpha = 0.73, resp = -2), data = dat[plot==2])

    # Bootstrap of residuals
    summary(nlsBoot(mod2,niter=5))

# works

Solution

  • I would write the bootstrapping myself. This gives you more control and you avoid this kind of scoping issues:

    library(boot)
    
    model.fun <- function(dt){
      fit <- nls(GPP ~ ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp, 
                 start = list(GPmax = 12, alpha = 0.73, resp = -2), data = dt)
      #this copy should be avoided if you have big data, but I don't have time right now:
      df <- copy(dt)
      df[, fitted := fitted(fit)]
      df[, resid := residuals(fit)]
      fun <- function(df, inds) {
        df[, bootGPP := fitted + resid[inds]]
        tryCatch(coef(nls(bootGPP ~ ((alpha * PAR * GPmax)/((alpha * PAR)+ GPmax)) - resp, 
                          start = list(GPmax = 12, alpha = 0.73, resp = -2), data = df)),
                 error = function(e) c("GPmax" = NA, "alpha" = NA, "resp" = NA))
    
    
      }
      b <- boot(df, fun, R = 1000)
      res0 <- b$t0
      res1 <- apply(b$t, 2, sd, na.rm = TRUE)
      res2 <- res0 - colMeans(b$t, na.rm = TRUE)
      return(as.list(setNames(c(sum(!is.na(b$t[,1])), res0, res1, res2), c("n", "GPmax", "alpha", "resp","SEGPmax", 
                                                     "SEalpha", "SEresp","BiasGPmax", "Biasalpha", "Biasresp"))))
    }
    
    set.seed(42)
    models <- dat[, model.fun(.SD) , by = .(plot)]
    #   plot    n    GPmax     alpha       resp  SEGPmax   SEalpha   SEresp   BiasGPmax   Biasalpha    Biasresp
    #1:    1 1000 12.60382 0.9308744 -1.3579906 1.249449 0.2729928 1.263640 -0.11642169 -0.04376221 -0.11526536
    #2:    2 1000 13.58702 0.8660450 -0.5081954 1.109599 0.2085150 1.125234 -0.06664517 -0.02241303 -0.06447617