# 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 TRUE
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(111)
d <- data.frame("time" = 1:30)
d$y <- 2 + 1 / (1 + exp(0.5 * (15 - d$time))) +
rnorm(30, sd = exp(-3 + 2 * cos(d$time/30 * 6 - 3)))
## Special model terms must be called with s2()!
f <- list(
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