R/do_exact_matching.R

In PanelMatch: Matching Methods for Causal Inference with Time-Series Cross-Sectional Data

# performs exact matching on time invariant variables.
# Eventually will soon be replaced with caliper functionality
# returns matched sets with exact matching applied as a filter
do_exact_matching <- function(sets, balanced.panel.data, exact.match.vars)
{
  L <- attr(sets, "lag")
  ts <- as.numeric(sub(".*\\.", "", names(sets)))
  make.years <- function(t, repnum)
  {
    q <- rep(c((t - 0):t), repnum)
    return(q)
  }
  lsets <- sapply(sets, length)
  ts <- mapply(FUN = make.years, t = ts, 
               repnum = lsets, SIMPLIFY = FALSE)
  iddata <- lapply(sets, as.numeric)
  names(iddata) <- NULL
  create.keys <- function(t, id)
  {
    return(paste0(id,'.',t))
  }
  control.data <- (mapply(create.keys, t = ts, 
                          id = iddata, SIMPLIFY = FALSE))
  treatment.data <- names(sets)
  rowkeys <- paste0(balanced.panel.data[,1], '.', 
                    balanced.panel.data[, 2])
  
  colidx <- which(colnames(balanced.panel.data) %in% exact.match.vars)
  bpd <- as.matrix(balanced.panel.data[, c(1,2, colidx)])
  expanded.lists <- do_exact_matching_refinement(bpd, L, rowkeys, control.data,
                                                 treatment.data, (3:ncol(bpd) - 1))
  expanded.list <- unlist(expanded.lists, recursive = F)
  condensed.list <- list()
  for (i in 1:length(sets)) {
    tlist <- expanded.list[seq(from = i, 
                               to = length(expanded.list), 
                               by = length(sets))]
    matrix.set <- do.call(rbind, tlist)
    condensed.list[[i]] <- apply(matrix.set, MARGIN = 2, all) 
    #gives us consolidated t/f index for each matched set
  }
  for (i in 1:length(sets)) {
    sets[[i]] <- sets[[i]][condensed.list[[i]]]
  }
  
  return(sets)
}