## Not run:
# # Example 1: quantile regression with smoothing splines
# set.seed(123); adata <- data.frame(x2 = sort(runif(n <- 500)))
# mymu <- function(x) exp(-2 + 6*sin(2*x-0.2) / (x+0.5)^2)
# adata <- transform(adata, y = rpois(n, lambda = mymu(x2)))
# mytau <- c(0.25, 0.75); mydof <- 4
#
# fit <- vgam(y ~ s(x2, df = mydof), data = adata, trace = TRUE, maxit = 900,
# alaplace2(tau = mytau, llocat = "loge",
# parallel.locat = FALSE))
# fitp <- vgam(y ~ s(x2, df = mydof), data = adata, trace = TRUE, maxit = 900,
# alaplace2(tau = mytau, llocat = "loge", parallel.locat = TRUE))
#
# par(las = 1); mylwd <- 1.5
# with(adata, plot(x2, jitter(y, factor = 0.5), col = "orange",
# main = "Example 1; green: parallel.locat = TRUE",
# ylab = "y", pch = "o", cex = 0.75))
# with(adata, matlines(x2, fitted(fit ), col = "blue",
# lty = "solid", lwd = mylwd))
# with(adata, matlines(x2, fitted(fitp), col = "green",
# lty = "solid", lwd = mylwd))
# finexgrid <- seq(0, 1, len = 1001)
# for (ii in 1:length(mytau))
# lines(finexgrid, qpois(p = mytau[ii], lambda = mymu(finexgrid)),
# col = "blue", lwd = mylwd)
# fit@extra # Contains useful information
#
#
# # Example 2: regression quantile at a new tau value from an existing fit
# # Nb. regression splines are used here since it is easier.
# fitp2 <- vglm(y ~ sm.bs(x2, df = mydof), data = adata, trace = TRUE,
# alaplace1(tau = mytau, llocation = "loge",
# parallel.locat = TRUE))
#
# newtau <- 0.5 # Want to refit the model with this tau value
# fitp3 <- vglm(y ~ 1 + offset(predict(fitp2)[, 1]),
# alaplace1(tau = newtau, llocation = "loge"), data = adata)
# with(adata, plot(x2, jitter(y, factor = 0.5), col = "orange",
# pch = "o", cex = 0.75, ylab = "y",
# main = "Example 2; parallel.locat = TRUE"))
# with(adata, matlines(x2, fitted(fitp2), col = "blue",
# lty = 1, lwd = mylwd))
# with(adata, matlines(x2, fitted(fitp3), col = "black",
# lty = 1, lwd = mylwd))
#
#
# # Example 3: noncrossing regression quantiles using a trick: obtain
# # successive solutions which are added to previous solutions; use a log
# # link to ensure an increasing quantiles at any value of x.
#
# mytau <- seq(0.2, 0.9, by = 0.1)
# answer <- matrix(0, nrow(adata), length(mytau)) # Stores the quantiles
# adata <- transform(adata, offsety = y*0)
# usetau <- mytau
# for (ii in 1:length(mytau)) {
# # cat("\n\nii = ", ii, "\n")
# adata <- transform(adata, usey = y-offsety)
# iloc <- ifelse(ii == 1, with(adata, median(y)), 1.0) # Well-chosen!
# mydf <- ifelse(ii == 1, 5, 3) # Maybe less smoothing will help
# # lloc <- ifelse(ii == 1, "loge", "loge") # 2nd value must be "loge"
# fit3 <- vglm(usey ~ sm.ns(x2, df = mydf), data = adata, trace = TRUE,
# alaplace2(tau = usetau[ii], lloc = "loge", iloc = iloc))
# answer[, ii] <- (if(ii == 1) 0 else answer[, ii-1]) + fitted(fit3)
# adata <- transform(adata, offsety = answer[, ii])
# }
#
# # Plot the results.
# with(adata, plot(x2, y, col = "blue",
# main = paste("Noncrossing and nonparallel; tau = ",
# paste(mytau, collapse = ", "))))
# with(adata, matlines(x2, answer, col = "orange", lty = 1))
#
# # Zoom in near the origin.
# with(adata, plot(x2, y, col = "blue", xlim = c(0, 0.2), ylim = 0:1,
# main = paste("Noncrossing and nonparallel; tau = ",
# paste(mytau, collapse = ", "))))
# with(adata, matlines(x2, answer, col = "orange", lty = 1))
# ## End(Not run)
Run the code above in your browser using DataLab