Is it possible to plot the smooth components of a gam fit with ggplot2?

后端 未结 3 640
旧巷少年郎
旧巷少年郎 2021-01-30 09:20

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

相关标签:
3条回答
  • 2021-01-30 09:52

    FYI, visreg can directly output a gg object:

    visreg(model, "x1", gg=TRUE)
    

    0 讨论(0)
  • 2021-01-30 10:02

    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)
    }
    
    0 讨论(0)
  • 2021-01-30 10:16

    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)
    

    ggplot without residuals ggplot with residuals Colors are picked from http://colorbrewer2.org/.

    0 讨论(0)
提交回复
热议问题