R/helpers-process-tracing.R

In rdss: Companion Datasets and Functions for Research Design in the Social Sciences

#' Process tracing estimator
#'
#' Draw conclusions from a model given a query, data, and process tracing strategies
#'
#' See https://book.declaredesign.org/observational-causal.html#process-tracing
#'
#' @param causal_model a model generated by `CausalQueries`
#' @param data a single row dataset with data on nodes in the model
#' @param query a causal query of interest
#' @param strategies a vector describing sets of nodes to be examined e.g. c("X", "X-Y")
#'
#' @return a data.frame of estimates
#'
#' @export
#' @examples
#' # Simple example showing ambiguity in attribution
#' process_tracing_estimator(
#'   causal_model = CausalQueries::make_model("X -> Y"),
#'   query = "Y[X=1] > Y[X=0]",
#'   data = data.frame(X=1, Y = 1),
#'   strategies = "X-Y")
#'
#'# Example where M=1 acts as a hoop test
#' process_tracing_estimator(
#'   causal_model = CausalQueries::make_model("X -> M -> Y") |>
#'    CausalQueries::set_restrictions("Y[M=1] < Y[M=0]") |>
#'    CausalQueries::set_restrictions("M[X=1] < M[X=0]"),
#'   query = "Y[X=1] > Y[X=0]",
#'   data = data.frame(X=1, Y = 1, M = 0),
#'   strategies = c("Y", "X-Y", "X-M-Y"))

process_tracing_estimator <- function(causal_model, query, data, strategies) {

  if(!requireNamespace("CausalQueries")){
    message("The process_tracing_estimator function requires the 'CausalQueries' package.")
    return(invisible())
  }

  if(nrow(data) !=1) {
    stop("please provide a single row dataset")
  }

  given <-
    lapply(strategies, function(x) strsplit(x, "-")[[1]]) |>
    lapply(function(s)
      paste((sapply(s, function(x)
      paste(x, "==", data[x]))[sapply(s, function(x)
        ! is.na(data[x]))]), collapse = " & "))

  causal_model |>
    CausalQueries::query_model(query = query, given = given) |>
    mutate(term = strategies, XY = paste0("X", data$X, "Y", data$Y)) |>
    select(term, XY, estimate = mean)

}