R/declare_diagnosands.R

Defines functions default_diagnosands diagnosand_handler

Documented in diagnosand_handler

#' @param ... A set of new diagnosands.
#' @param subset A subset of the simulations data frame within which to calculate diagnosands e.g. \code{subset = p.value < .05}.
#' @param alpha Alpha significance level. Defaults to \code{.05}.
#' @param label Label for the set of diagnosands.
#' @param data A data.frame.
#'
#' @details
#'
#' If term is TRUE, the names of ... will be returned in a \code{term} column, and \code{inquiry}
#' will contain the step label. This can be used as an additional dimension for use in diagnosis.
#'
#' @importFrom rlang eval_tidy quos is_quosure quo_is_call %||%
#' @importFrom stats na.omit
#' @rdname declare_diagnosands
diagnosand_handler <- function(data, ...,
                               subset = NULL,
                               alpha = 0.05,
                               label) {
  options <- quos(...)
  
  if(length(options) == 0) {
    default_diagnosands(data = data, alpha = alpha)
  } else {
    
    # subsetting the data -----------------------------------------------------
    
    subset <- enquo(subset)
    idx <- eval_tidy(subset, data = data)
    if (!is.null(idx)) {
      data <- data[idx, , drop = FALSE]
    }
    
    ret <- vector("list", length(options))
    
    for (i in seq_along(options)) {
      ret[i] <- eval_tidy(options[[i]], data = data)
    }
    
    ret <- simplify2array(ret)
    
    data.frame(
      diagnosand_label = names(options),
      diagnosand = ret,
      stringsAsFactors = FALSE
    )
  }
  
}


validation_fn(diagnosand_handler) <- function(ret, dots, label) {
  
  options <- names(dots)[!names(dots) %in% c("subset", "alpha", "label", "data")]
  
  # if (length(options) == 0) {
  #   declare_time_error("No diagnosands were declared.", ret)
  # }
  
  # check whether all diagnosands are named
  if (is.null(names(dots)) || "" %in% names(dots)) {
    declare_time_error("All diagnosands must be named", ret)
  }
  
  ret
}

#' Declare diagnosands
#'
#' @inheritParams declare_internal_inherit_params
#'
#' @details
#'
#' Diagnosands summarize the simulations generated by \code{\link{diagnose_design}} or \code{\link{simulate_design}}. Typically, the columns of the resulting simulations data.frame include the following variables: estimate, std.error, p.value, conf.low, conf.high, and inquiry. Many diagnosands will be a function of these variables.
#'
#' @return a function that returns a data.frame
#'
#' @importFrom rlang eval_tidy
#'
#' @export
#'
#' @examples
#'
#' design <- 
#'   declare_model(
#'     N = 500, 
#'     U = rnorm(N),
#'     Y_Z_0 = U, 
#'     Y_Z_1 = U + rnorm(N, mean = 2, sd = 2)
#'   ) + 
#'   declare_assignment(Z = complete_ra(N)) + 
#'   declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 
#'   declare_estimator(Y ~ Z, inquiry = my_inquiry) + 
#'   declare_measurement(Y = reveal_outcomes(Y ~ Z))
#'
#' \dontrun{
#' # using built-in defaults:
#' diagnosis <- diagnose_design(design)
#' diagnosis
#' }
#'
#' # You can choose your own diagnosands instead of the defaults e.g.,
#'
#' my_diagnosands <-
#'   declare_diagnosands(median_bias = median(estimate - inquiry))
#' \dontrun{
#' diagnosis <- diagnose_design(design, diagnosands = my_diagnosands)
#' diagnosis
#' }
#' \dontrun{
#' design <- set_diagnosands(design, diagnosands = my_diagnosands)
#' diagnosis <- diagnose_design(design)
#' diagnosis
#' }
#'
#' # Below is the code that makes the default diagnosands.
#' # You can use these as a model when writing your own diagnosands.
#'
#' default_diagnosands <- declare_diagnosands(
#' bias = mean(estimate - estimand),
#' rmse = sqrt(mean((estimate - estimand) ^ 2)),
#' power = mean(p.value < alpha),
#' coverage = mean(estimand <= conf.high & estimand >= conf.low),
#' mean_estimate = mean(estimate),
#' sd_estimate = sd(estimate),
#' mean_se = mean(std.error),
#' type_s_rate = mean((sign(estimate) != sign(estimand))[p.value < alpha]),
#' mean_estimand = mean(estimand)
#' )
#'
declare_diagnosands <- make_declarations(diagnosand_handler, "diagnosand", "diagnosands")

#' @importFrom stats na.omit
default_diagnosands <- function(data, alpha = .05){
  
  estimate <- data$estimate %||% NA
  estimand <- data$estimand %||% NA
  p.value <- data$p.value %||% NA
  std.error <- data$std.error %||% NA
  conf.low <- data$conf.low %||% NA
  conf.high <- data$conf.high %||% NA
  
  bias <- mean(estimate - estimand)
  rmse <- sqrt(mean((estimate - estimand)^2))
  power <- mean(p.value < alpha)
  coverage <- mean(estimand <= conf.high & estimand >= conf.low)
  mean_estimate <- mean(estimate)
  sd_estimate <- sd(estimate)
  mean_se <- mean(std.error)
  type_s_rate <- mean((sign(estimate) != sign(estimand))[p.value < alpha])
  mean_estimand <- mean(estimand)
  
  data.frame(
    diagnosand_label = c(
      "bias",
      "rmse",
      "power",
      "coverage",
      "mean_estimate",
      "sd_estimate",
      "mean_se",
      "type_s_rate",
      "mean_estimand"
    ),
    diagnosand = c(
      bias,
      rmse,
      power,
      coverage,
      mean_estimate,
      sd_estimate,
      mean_se,
      type_s_rate,
      mean_estimand
    ), 
    stringsAsFactors = FALSE
  )
  
}

Try the DeclareDesign package in your browser

Any scripts or data that you put into this service are public.

DeclareDesign documentation built on Aug. 21, 2021, 5:07 p.m.