Plot lm model fits either right or left, time series counterfactuals

lm_left__lm_right

library(ggplot2)
library(dplyr)
library(tidyr)


##########################################################################################
# Make a new kind of modelling which only predicts either right or left
##########################################################################################
{
## decorate lm object with a new class lm_right
  lm_right <- function(formula,data,...){
    mod <- lm(formula,data)
    class(mod) <- c('lm_right',class(mod))
    mod
  }
  
  ## decorate lm object with a new class lm_left
  lm_left <- function(formula,data,...){
    mod <- lm(formula,data)
    class(mod) <- c('lm_left',class(mod))
    mod
  }
  
  predictdf.lm_right <- 
    function(model, xseq, se, level){
      ## here the main code: truncate to x values at the right
      init_range = range(model$model$x)
      xseq <- xseq[xseq >=init_range[1]]
      ggplot2:::predictdf.default(model, xseq[-length(xseq)], se, level)
    }
  
  predictdf.lm_left <- 
    function(model, xseq, se, level){
      init_range = range(model$model$x)
      ## here the main code: truncate to x values at the left
      xseq <- xseq[xseq <=init_range[2]]
      ggplot2:::predictdf.default(model, xseq[-length(xseq)], se, level)
    }
}  
 


##########################################################################################
# Make a dummy data set
##########################################################################################




int = 85
set.seed(42)
df <- data.frame(
  count = as.integer(rpois(132, 9) + rnorm(132, 1, 1)),
  time = 1:132,  
  at_risk = rep(
    c(4305, 4251, 4478, 4535, 4758, 4843, 4893, 4673, 4522, 4454, 4351),
    each  = 12
  )
)

df$month <- factor(month.name, levels = month.name)
df$intv <- ifelse(df$time >= int, 1, 0)
df$intv_trend <- c(rep(0, (int - 1)),
                   1:(length(unique(df$time)) - (int - 1)))
df <- df %>%
  mutate(lag_count = dplyr::lag(count))


fit <- glm(
  count ~ month + time + intv + intv_trend +
    log(lag_count) + offset(log(at_risk)),
  family = "poisson",
  data = df
)
df$group = rep(c("Control","PreIntervention","Intervention","PostIntervention"), c(30,32, 35,35))


# Get predictions on the same scale as the data
df$predict = c(NA, predict(fit, type="response"))


# Plot an example with a left and right extrapolation of lm fit  
  
  ggplot(data = df, aes(x = time, y = predict)) +
    geom_line() +
    geom_smooth(data=filter(df,group=="Control"),method="lm", se=TRUE, aes(colour=group),fullrange=FALSE)+
    geom_smooth(data=filter(df,group=="PreIntervention"),method="lm", se=TRUE, aes(colour=group),fullrange=FALSE)+
    geom_smooth(data=filter(df,group=="Intervention"),method="lm", se=TRUE, aes(colour=group),fullrange=FALSE)+
    geom_smooth(data=filter(df,group=="PostIntervention"),method="lm", se=TRUE, aes(colour=group),fullrange=FALSE)+
    geom_smooth(data=filter(df,group=="Intervention"),method="lm_left", se=TRUE, aes(colour=group),fullrange=TRUE, linetype = "dashed",alpha=0.1)+
    geom_smooth(data=filter(df,group=="PreIntervention"),method="lm_right", se=TRUE, aes(colour=group),fullrange=TRUE, linetype = "dashed",alpha=0.1)