# \dontshow{
oop <- options(na.action="na.fail")
if(require(graphics)) { # }
# Example from Burnham and Anderson (2002), page 100:
fm1 <- lm(y ~ X1 + X2 + X3 + X4, data = Cement)
ms1 <- dredge(fm1)
confset.95p <- get.models(ms1, subset = cumsum(weight) <= .95)
avgm <- model.avg(confset.95p)
nseq <- function(x, len = length(x)) seq(min(x, na.rm = TRUE),
max(x, na.rm=TRUE), length = len)
# New predictors: X1 along the range of original data, other
# variables held constant at their means
newdata <- as.data.frame(lapply(lapply(Cement[, -1], mean), rep, 25))
newdata$X1 <- nseq(Cement$X1, nrow(newdata))
n <- length(confset.95p)
# Predictions from each of the models in a set, and with averaged coefficients
pred <- data.frame(
model = sapply(confset.95p, predict, newdata = newdata),
averaged.subset = predict(avgm, newdata, full = FALSE),
averaged.full = predict(avgm, newdata, full = TRUE)
)
opal <- palette(c(topo.colors(n), "black", "red", "orange"))
matplot(newdata$X1, pred, type = "l",
lwd = c(rep(2,n),3,3), lty = 1,
xlab = "X1", ylab = "y", col=1:7)
# For comparison, prediction obtained by averaging predictions of the component
# models
pred.se <- predict(avgm, newdata, se.fit = TRUE)
y <- pred.se$fit
ci <- pred.se$se.fit * 2
matplot(newdata$X1, cbind(y, y - ci, y + ci), add = TRUE, type="l",
lty = 2, col = n + 3, lwd = 3)
legend("topleft",
legend=c(lapply(confset.95p, formula),
paste(c("subset", "full"), "averaged"), "averaged predictions + CI"),
lty = 1, lwd = c(rep(2,n),3,3,3), cex = .75, col=1:8)
palette(opal)
}
options(oop)
Run the code above in your browser using DataLab