I am fitting a model using gam
from the mgcv
package and store the result in model
and so far I have been looking at the smooth components
FYI, visreg
can directly output a gg
object:
visreg(model, "x1", gg=TRUE)
Updated to allow user to choose which variables are plotted.
Changed 'residuals' term to 'res_data' to avoid conflict with residuals
function.
ggplot.model <- function(model, type="conditional", res=FALSE,
col.line="#7fc97f", col.point="#beaed4", size.line=1, size.point=1, no_col = NULL,
what = "all") {
require(visreg)
require(plyr)
plotdata <- visreg(model, type = type, plot = FALSE)
smooths <- ldply(plotdata, function(part)
data.frame(Variable = part$meta$x,
x=part$fit[[part$meta$x]],
smooth=part$fit$visregFit,
lower=part$fit$visregLwr,
upper=part$fit$visregUpr))
res_data <- ldply(plotdata, function(part)
data.frame(Variable = part$meta$x,
x=part$res[[part$meta$x]],
y=part$res$visregRes))
if (what != "all") {
smooths <- smooths %>%
filter(lapply(Variable,as.character)%in% what)
res_data <- res_data%>%
filter(lapply(Variable,as.character)%in% what)
}
if (res)
ggplot(smooths, aes(x, smooth)) + geom_line(col=col.line, size=size.line) +
geom_line(aes(y=lower), linetype="dashed", col=col.line, size=size.line) +
geom_line(aes(y=upper), linetype="dashed", col=col.line, size=size.line) +
geom_point(data = res_data, aes(x, y), col=col.point, size=size.point) +
facet_wrap(. ~ Variable, scales = "free_x", ncol = no_col) + theme_bw()
else
ggplot(smooths, aes(x, smooth)) + geom_line(col=col.line, size=size.line) +
geom_line(aes(y=lower), linetype="dashed", col=col.line, size=size.line) +
geom_line(aes(y=upper), linetype="dashed", col=col.line, size=size.line) +
facet_wrap(. ~ Variable, scales = "free_x", ncol=no_col)
}
You can use the visreg package combined with the plyr package. visreg basically plots any model that you can use predict() on.
library(mgcv)
library(visreg)
library(plyr)
library(ggplot2)
# Estimating gam model:
x1 = rnorm(1000)
x2 = rnorm(1000)
n = rpois(1000, exp(x1) + x2^2)
model = gam(n ~ s(x1, k=10) + s(x2, k=20), family="poisson")
# use plot = FALSE to get plot data from visreg without plotting
plotdata <- visreg(model, type = "contrast", plot = FALSE)
# The output from visreg is a list of the same length as the number of 'x' variables,
# so we use ldply to pick the objects we want from the each list part and make a dataframe:
smooths <- ldply(plotdata, function(part)
data.frame(Variable = part$meta$x,
x=part$fit[[part$meta$x]],
smooth=part$fit$visregFit,
lower=part$fit$visregLwr,
upper=part$fit$visregUpr))
# The ggplot:
ggplot(smooths, aes(x, smooth)) + geom_line() +
geom_line(aes(y=lower), linetype="dashed") +
geom_line(aes(y=upper), linetype="dashed") +
facet_grid(. ~ Variable, scales = "free_x")
We can put the whole thing into a function, and add an option to show the residuals from the model (res = TRUE):
ggplot.model <- function(model, type="conditional", res=FALSE,
col.line="#7fc97f", col.point="#beaed4", size.line=1, size.point=1) {
require(visreg)
require(plyr)
plotdata <- visreg(model, type = type, plot = FALSE)
smooths <- ldply(plotdata, function(part)
data.frame(Variable = part$meta$x,
x=part$fit[[part$meta$x]],
smooth=part$fit$visregFit,
lower=part$fit$visregLwr,
upper=part$fit$visregUpr))
residuals <- ldply(plotdata, function(part)
data.frame(Variable = part$meta$x,
x=part$res[[part$meta$x]],
y=part$res$visregRes))
if (res)
ggplot(smooths, aes(x, smooth)) + geom_line(col=col.line, size=size.line) +
geom_line(aes(y=lower), linetype="dashed", col=col.line, size=size.line) +
geom_line(aes(y=upper), linetype="dashed", col=col.line, size=size.line) +
geom_point(data = residuals, aes(x, y), col=col.point, size=size.point) +
facet_grid(. ~ Variable, scales = "free_x")
else
ggplot(smooths, aes(x, smooth)) + geom_line(col=col.line, size=size.line) +
geom_line(aes(y=lower), linetype="dashed", col=col.line, size=size.line) +
geom_line(aes(y=upper), linetype="dashed", col=col.line, size=size.line) +
facet_grid(. ~ Variable, scales = "free_x")
}
ggplot.model(model)
ggplot.model(model, res=TRUE)
Colors are picked from http://colorbrewer2.org/.