## Not run: ------------------------------------
# ## Simulated data example illustrating
# ## how to call the optimizer function.
# ## This is done internally within
# ## the setup of function bamlss().
# d <- GAMart(n = 200)
# f <- num ~ s(x1) + s(x2) + s(x3)
# bf <- bamlss.frame(f, data = d, family = "gaussian")
# opt <- with(bf, bfit(x, y, family))
# print(str(opt))
#
# ## Same with bamlss().
# b <- bamlss(f, data = d, family = "gaussian", sampler = FALSE)
# plot(b)
# summary(b)
#
# ## Use of different updating function.
# b <- bamlss(f, data = d, family = "gaussian",
# sampler = FALSE, update = bfit_lm)
# plot(b)
#
# ## Use mgcv gam() function for updating.
# b <- bamlss(f, data = d, family = "gaussian",
# sampler = FALSE, mgcv = TRUE)
# plot(b)
#
# ## Special smooth constructor including updating/sampler
# ## function for nonlinear Gompertz curves.
# ## Note: element special.npar is needed here since this
# ## function has 3 parameters but the design matrix only
# ## one column!
# smooth.construct.gc.smooth.spec <- function(object, data, knots)
# {
# object$X <- matrix(as.numeric(data[[object$term]]), ncol = 1)
# center <- if(!is.null(object$xt$center)) {
# object$xt$center
# } else FALSE
# object$by.done <- TRUE
# if(object$by != "NA")
# stop("by variables not supported!")
# object$fit.fun <- function(X, b, ...) {
# f <- b[1] * exp(-b[2] * exp(-b[3] * drop(X)))
# if(center)
# f <- f - mean(f)
# f
# }
# object$update <- bfit_optim
# object$propose <- GMCMC_slice
# object$prior <- function(b) { sum(dnorm(b, sd = 1000, log = TRUE)) }
# object$fixed <- TRUE
# object$state$parameters <- c("b1" = 0, "b2" = 0.5, "b3" = 0.1)
# object$state$fitted.values <- rep(0, length(object$X))
# object$state$edf <- 3
# object$special.npar <- 3 ## Important!
# class(object) <- c("gc.smooth", "no.mgcv", "special")
# object
# }
#
# ## Work around for the "prediction matrix" of a growth curve.
# Predict.matrix.gc.smooth <- function(object, data, knots)
# {
# X <- matrix(as.numeric(data[[object$term]]), ncol = 1)
# X
# }
#
# ## Heteroscedastic growth curve data example.
# set.seed(123)
#
# d <- data.frame("time" = 1:30)
# d$y <- 2 + 1 / (1 + exp(0.5 * (15 - d$time))) +
# rnorm(30, sd = exp(-4 + 0.1 * d$time))
#
# ## Special model terms must be called with s2()!
# f <- list(
# "mu" = y ~ s2(time, bs = "gc"),
# "sigma" = ~ s(time)
# )
#
# ## Fit model with special model term.
# b <- bamlss(f, data = d,
# optimizer = bfit, sampler = GMCMC)
#
# ## Plot the fitted curves.
# plot(b)
#
# ## Predict with special model term.
# nd <- data.frame("time" = seq(1, 30, length = 100))
# p <- predict(b, newdata = nd, model = "mu", FUN = c95)
# plot(d, ylim = range(c(d$y, p)))
# matplot(nd$time, p, type = "l",
# lty = c(2, 1, 2), col = "black", add = TRUE)
## ---------------------------------------------
Run the code above in your browser using DataLab