R/prepareOracle.R

In BarkleyBG/stabilizedinterference: Stabilized IPW Estimators for Causal Effects with Partial Interference

#' A helper function for using oracle estimates for
#' \code{\link{estimateEffects}}.
#'
#' @inheritParams estimateEffects
#' @inheritParams fitModel
#' @param modeling_formula see \code{\link{fitModel}}
#'
#' This function checks whether the oracle parameters passed through
#' \code{model_options} to \code{\link{estimateEffects}} are in appropriate
#' order. User should supply only the formula that would be
#'   used to model treatment on predictors. See Details for how to use with
#'   random effect models and \code{\link[lme4]{glmer}}.
#'
#'   \code{model_options} must be a list with numeric vectors \code{fixefs} and
#'   \code{var_comp}. The vector \code{fixefs} must have names. This function
#'   will provide a check that the names of \code{fixefs} are equal to the names
#'   that are generated by the call to \code{\link[stats]{model.matrix}}.
#'
#'   For mixed effect model, note that that random intercept's term in the
#'   modeling formula (e.g., \code{ ( 1 | cluster_ID ) }) must be omitted from
#'   \code{formula}.
#'
#' @return A list of elements, perhaps including \itemize{
#'   \item \code{will_it_work}: Boolean. If \code{FALSE} then there are issues
#'   that need to be fixed.
#'   \item \code{fixefs} the named numeric vector of fixed effects parameters.
#'   \item \code{sigma} Either a numeric singleton, or \code{NULL}.
#'   \item \code{names_fixefs}: the names of \code{model_options$fixefs}.
#'   \item \code{names_matrix_modeling}: the colnames of the model matrix.
#'   \item \code{model_matrix}: the model matrix.
#'   \item \code{x_levels}: for the \code{xlev} argument in \code{\link[stats]{model.frame}}.
#'   \item \code{model_options}: the input argument
#'   \item \code{modeling_formula}: the input argument
#'   }
#'
prepareOracle <- function(
  data,
  model_options,
  modeling_formula
){


  if (!c("fixefs")#, "var_comp")
      %in% names(model_options)) {
    stop("for model_method='oracle', model_options must have named item 'fixefs'")# and 'var_comp'")
  }

  if (!c("var_comp") %in% names(model_options)) {
    stop("for model_method='oracle', model_options must have named item 'var_comp'. If GLM is desired, set var_comp to NA")
  }

  output <- list(
    will_it_work = NA
  )
  fixefs <- model_options$fixefs
  if (is.null(names(fixefs))){stop("model_options$fixefs must be a named numeric vector")}

  if (is.na(model_options$var_comp)){
    sigma <- NULL
  } else
    if (model_options$var_comp == 0){
      stop("var_comp cannot be 0 or FALSE. Set to NA to use GLM, or supply a positive value.")
    } else {
      if (model_options$var_comp >0 && !is.logical(model_options$var_comp) ){
        sigma <- model_options$var_comp
      } else {stop("var_comp must be a positive integer.")}
    }
  output$fixefs <- fixefs
  output$sigma <- sigma
  names_fixefs <- names(fixefs)
  output$names_fixefs <- names_fixefs


  ps_model_frame <- stats::model.frame(
    modeling_formula,
    data = data
  )

  ## getting xlev
  full_model_frame <- ps_model_frame
  data_classes <- attr(attr(full_model_frame, "terms"), "dataClasses")
  var_names <- names(data_classes)

  x_levels_list <- list()
  ii = 1
  for (var_num in 1:length(data_classes)){
    if (data_classes[var_num]=="factor") {
      these_levels <- levels( full_model_frame[,var_names[var_num] ])
      x_levels_list[[ii]] <- these_levels
      names(x_levels_list)[[ii]] <- var_names[var_num]
      ii <- ii+1
    }
  }

  x_levels <- x_levels_list


  ps_model_matrix <- stats::model.matrix(
    object = modeling_formula,
    data = ps_model_frame
  )
  names_psmm <- colnames(ps_model_matrix)
  output$names_matrix_modeling <- names_psmm
  output$model_matrix <- ps_model_matrix
  # will_it_work <- TRUE

  output$x_levels <- x_levels
  if (
    length(names_fixefs) != length(names_psmm) ||
    any(names_fixefs != names_psmm)
  ) {
    warning(paste(
      "The names in model_options$fixefs are not equal to the names",
      "of the model matrix's columns. Please use function",
      "prepareOracle() again."
    ))
    output$will_it_work <- FALSE

  } else {
    output$will_it_work <- TRUE
  }
  output$model_options <- model_options
  output$modeling_formula <- modeling_formula


  output
}



## #' @param multipart_formula. Optional. User can supply the multi-part
## #'   formula as in \code{\link{estimateEffects}}.
## #' \item \code{names_matrix_multipart}: the colnames of the model matrix when \code{multipart_formula} is provided.
## #' \item \code{head_matrix_multipart}: the \code{\link[utils]{head}} of the model matrix when \code{multipart_formula} is provided.
##
## # multipart_formula = NULL,
## if(!is.null(multipart_formula)){
##   stop("not yet implemented; please supply modeling_formula.")
## }##