R/plot.placebos.R

In bcastanho/SCtools: Extensions for Synthetic Controls Analysis

#' @title Function to plot placebos of a synthetic control analysis
#' @description Creates plots with the difference between observed units 
#'     and synthetic controls for the treated and control units. 
#'     See Abadie, Diamond, and Hainmueller (2011). 
#' @param tdf An object with a list of outcome values for placebos, 
#'     constructed by \code{\link{generate.placebos}}.
#' @param discard.extreme Logical. Whether or not units with high pre-treatement 
#'     MSPE should be excluded from the plot. Takes a default of \code{FALSE}.
#' @param mspe.limit Numerical. Used if \code{discard.extreme} is \code{TRUE}. 
#'     It indicates how many times the pre-treatment MSPE of a placebo should 
#'     be higher than that of the treated unit to be considered extreme and 
#'     discarded. Default is \code{20}.
#' @param xlab Character. Optional. Label of the x axis.
#' @param ylab Character. Optional. Label of the y axis.
#' @param title Character. Optional. Title of the plot.
#' @param alpha.placebos the transparency setting, default of \code{1}
#' @param ... optional arguments (currently not used)
#' @seealso \code{\link{generate.placebos}}, \code{\link[Synth]{gaps.plot}}, 
#'     \code{\link[Synth]{synth}}, \code{\link[Synth]{dataprep}}
#' @examples 
#' \dontshow{## Example with toy data from Synth
#' library(Synth)
#' # Load the simulated data
#' data(synth.data)
#' 
#' # Execute dataprep to produce the necessary matrices for synth
#' dataprep.out<-
#'   dataprep(
#'     foo = synth.data,
#'     predictors = c("X1"),
#'     predictors.op = "mean",
#'     dependent = "Y",
#'     unit.variable = "unit.num",
#'     time.variable = "year",
#'     special.predictors = list(
#'       list("Y", 1991, "mean")
#'     ),
#'     treatment.identifier = 7,
#'     controls.identifier = c(29, 2, 17),
#'     time.predictors.prior = c(1984:1989),
#'     time.optimize.ssr = c(1984:1990),
#'     unit.names.variable = "name",
#'     time.plot = 1984:1996
#' )
#' 
#' # run the synth command to create the synthetic control
#' synth.out <- synth(dataprep.out, Sigf.ipop=1)
#' 
#' tdf <- generate.placebos(dataprep.out,synth.out, Sigf.ipop = 1)
#' ## Plot the gaps in outcome values over time of each unit --
#' ## treated and placebos -- to their synthetic controls
#' 
#' p <- plot_placebos(tdf,discard.extreme=TRUE, mspe.limit=10, xlab='Year')
#' p
#' }
#' \dontrun{## Example with toy data from Synth
#' library(Synth)
#' # Load the simulated data
#' data(synth.data)
#' 
#' # Execute dataprep to produce the necessary matrices for synth
#' dataprep.out<-
#'   dataprep(
#'     foo = synth.data,
#'     predictors = c("X1"),
#'     predictors.op = "mean",
#'     dependent = "Y",
#'     unit.variable = "unit.num",
#'     time.variable = "year",
#'     special.predictors = list(
#'       list("Y", 1991, "mean")
#'     ),
#'     treatment.identifier = 7,
#'     controls.identifier = c(29, 2, 13, 17),
#'     time.predictors.prior = c(1984:1989),
#'     time.optimize.ssr = c(1984:1990),
#'     unit.names.variable = "name",
#'     time.plot = 1984:1996
#' )
#' 
#' # run the synth command to create the synthetic control
#' synth.out <- synth(dataprep.out, Sigf.ipop=2)
#' 
#' ## run the generate.placebos command to reassign treatment status
#' ## to each unit listed as control, one at a time, and generate their
#' ## synthetic versions. Sigf.ipop = 2 for faster computing time. 
#' ## Increase to the default of 5 for better estimates. 
#' tdf <- generate.placebos(dataprep.out,synth.out, Sigf.ipop = 2, strategy='multicore')
#' 
#' ## Plot the gaps in outcome values over time of each unit --
#' ## treated and placebos -- to their synthetic controls
#' 
#' p <- plot_placebos(tdf,discard.extreme=TRUE, mspe.limit=10, xlab='Year')
#' p
#' }
#' @export

plot_placebos <-
function(tdf=tdf, 
         discard.extreme=FALSE, 
         mspe.limit=20, 
         xlab = NULL, 
         ylab = NULL, 
         title=NULL,
         alpha.placebos=1, ...){
  # Bindings
  year <- cont <- id <- Y1 <- synthetic.Y1 <- NULL
  
  # check incoming objects
  if(!is_tdf(tdf)){
    stop("Please pass a valid `tdf` object the tdf argument.\nThese are generated by the `generate.placebos` function.")
  }
  
  discard.extreme <- match_logical(discard.extreme)

  if(!discard.extreme & mspe.limit != 20){
  	warning('discard.extreme is FALSE. mspe.limit will be ignored.')
  }
  
  
n<-tdf$n
t1 <- unique(tdf$df$year)[which(tdf$df$year == tdf$t1) - 1]
tr<-tdf$tr
names.and.numbers<-tdf$names.and.numbers
treated.name<-as.character(tdf$treated.name)
df.plot<-NULL
for(i in 1:n){
  a<-cbind(tdf$df$year,tdf$df[,i],tdf$df[,n+i],i)
  df.plot<-rbind(df.plot, a)
}
df.plot<-data.frame(df.plot)
colnames(df.plot)<-c('year','cont','tr','id')
if(discard.extreme) {
  df.plot<-df.plot[ ! df.plot$id %in% which(tdf$mspe.placs/tdf$loss.v[1] >= mspe.limit),] 
}
else {
  df.plot<-df.plot
  }
p.gaps<-ggplot2::ggplot(data=data.frame(df.plot),
                        ggplot2::aes(x=year, y=(tr-cont)))+
  ggplot2::geom_line( ggplot2::aes(group=id, 
                                   color='2'))+
  ggplot2::geom_vline(xintercept = t1,
                      linetype = 'dotted')+
  ggplot2::geom_hline(yintercept = 0, 
                      linetype = 'dashed')+ 
  ggplot2::geom_line(data=data.frame(tdf$df),
                     ggplot2::aes(x = year, y=(Y1-synthetic.Y1), color='1'),
                     alpha=alpha.placebos)+ 
  ggplot2::ylim(c(1.5*min(c(min(tdf$df$Y1 - tdf$df$synthetic.Y1),
                            min(df.plot$tr-df.plot$cont))),
                  1.5*max(c(max(tdf$df$Y1-tdf$df$synthetic.Y1),
                            max(df.plot$tr-df.plot$cont))))) +
  ggplot2::labs(y=ylab,
                x=xlab,
                title=title)+
  ggplot2::scale_color_manual(values = c('2' = 'gray80', '1' = 'black'),
                     labels = c('Control units',tdf$treated.name), 
                     guide = ggplot2::guide_legend(NULL))+
  ggplot2::theme(panel.background = ggplot2::element_blank(), 
          panel.grid.major = ggplot2::element_blank(),
          panel.grid.minor=ggplot2::element_blank(),
          axis.line.x = ggplot2::element_line(colour = 'black'),
          axis.line.y = ggplot2::element_line(colour = 'black'),
          legend.key = ggplot2::element_blank(),
          axis.text.x = ggplot2::element_text(colour = 'black'),
          axis.text.y = ggplot2::element_text(colour = 'black'),
          legend.position='bottom')
  return(p.gaps)
}

#' #' Deprecating plot.placebos
#' #' @description Deprecating older version of plot.placebos due to S3 conflicts.
#' #' @inheritParams plot.placebos
#' #' @export
#' #' @keywords internal
#' plot.placebos <- function(x) {
#'   signal_soft_deprecated("`plot.placebos()` is deprecated, use `plot_placebos()`.")
#'   
#'   plot_placebos(x)
#' }