tests/testthat/test-nls.R

In mikldk/staid: Start Aid for Fitting Certain Statistical Models

# library(car)
# data(USPop)
d_nls <-
  structure(list(
    year = c(
      1790L,
      1800L,
      1810L,
      1820L,
      1830L,
      1840L,
      1850L,
      1860L,
      1870L,
      1880L,
      1890L,
      1900L,
      1910L,
      1920L,
      1930L,
      1940L,
      1950L,
      1960L,
      1970L,
      1980L,
      1990L,
      2000L
    ),
    population = c(
      3.929214,
      5.308483,
      7.239881,
      9.638453,
      12.860702,
      17.063353,
      23.191876,
      31.443321,
      38.558371,
      50.189209,
      62.979766,
      76.212168,
      92.228496,
      106.021537,
      123.202624,
      132.164569,
      151.325798,
      179.323175,
      203.302031,
      226.542199,
      248.709873,
      281.421906
    )
  ),
  row.names = c(NA,-22L),
  class = "data.frame")

test_that("nls", {
  modelfrm <- population ~ x1 / (1 + exp(-(x2+x3 * (year))))

  nls_staid <- prepare_nls(modelfrm, d_nls, c("x1", "x2", "x3"))
  str(nls_staid)
  
  start_vals <- optim(par = c(0, 0, 0), 
                      fn = nls_staid$f, 
                      gr = nls_staid$g, 
                      method = "BFGS", 
                      control = list(reltol = 1e-12))
  start_vals
  
  p0 <- start_vals$par
  names(p0) <- nls_staid$var_names
  p0
  
  fit <- nls(modelfrm, 
              start = p0, 
              data = d_nls)
  fit
  
})