R/inspect.R

In CausalQueries: Make, Update, and Query Binary Causal Models

#' Helpers for inspecting causal models
#'
#' Various helpers to inspect or access internal objects generated or used by Causal Models
#'
#' @name inspection
NULL
#> NULL

#' inspect a causal model
#'
#' Returns specified elements from a \code{causal_model} and prints summary.
#' Users can use \code{inspect} to extract model's components or objects implied by
#' the model structure including nodal types, causal types, parameter priors,
#' parameter posteriors, type priors, type posteriors, and other relevant elements.
#' See argument \code{what} for other options.
#' @rdname inspection
#' @inheritParams CausalQueries_internal_inherit_params
#' @param what A character string specifying the component to retrieve.
#'   Available options are:
#'   \itemize{
#'   \item "\code{statement}" a character string describing causal relations using dagitty syntax,
#'   \item "\code{nodes}" A list containing the nodes in the model,
#'   \item "\code{parents_df}" A table listing nodes, whether they are root nodes or not, and the number and names of parents they have,
#'   \item "\code{parameters}" A vector of 'true' parameters,
#'   \item "\code{parameter_names}" A vector of names of parameters,
#'   \item "\code{parameter_mapping}" A matrix mapping from parameters into data types,
#'   \item "\code{parameter_matrix}" A matrix mapping from parameters into causal types,
#'   \item "\code{parameters_df}" A data frame containing parameter information,
#'   \item "\code{causal_types}" A data frame listing causal types and the nodal types that produce them,
#'   \item "\code{nodal_types}" A list with the nodal types of the model,
#'   \item "\code{data_types}" A list with all data types consistent with the model; for options see \code{?get_all_data_types},
#'   \item "\code{ambiguities_matrix}" A matrix mapping from causal types into data types,
#'   \item "\code{prior_hyperparameters}" A vector of alpha values used to parameterize Dirichlet prior distributions; optionally provide node names to reduce output, e.g., \code{inspect(prior_hyperparameters, nodes = c('M', 'Y'))},
#'   \item "\code{prior_distribution}" A data frame of the parameter prior distribution,
#'   \item "\code{posterior_distribution}" A data frame of the parameter posterior distribution,
#'   \item "\code{type_prior}" A matrix of type probabilities using priors,
#'   \item "\code{type_posterior}" A matrix of type probabilities using posteriors,
#'   \item "\code{prior_event_probabilities}" A vector of data (event) probabilities given a single realization of parameters; for options see \code{?get_event_probabilities},
#'   \item "\code{posterior_event_probabilities}" A sample of data (event) probabilities from the posterior,
#'   \item "\code{data}" A data frame with data that was provided to update the model,
#'   \item  \code{stan_summary}" A `stanfit` summary with processed parameter names,
#'   \item "\code{stanfit}" An (unprocessed) \code{stanfit} object as generated by Stan, with raw parameter names,
#'   \item "\code{stan_warnings}" Messages generated during the generation of a \code{stanfit} object.
#'   }
#' @param ... Other arguments passed to helper \code{"get_*"} functions: get_all_data_types, get_event_probabilities,  get_priors, Any such additional arguments must be named.
#' @return Objects  that can be derived from a \code{causal_model}, with summary.
#'
#' @export
#'
#' @examples
#' \donttest{
#'
#' model <- make_model("X -> Y")
#' data <- make_data(model, n = 4)
#'
#' inspect(model, what = "statement")
#' inspect(model, what = "parameters")
#' inspect(model, what = "nodes")
#' inspect(model, what = "parents_df")
#' inspect(model, what = "parameters_df")
#' inspect(model, what = "causal_types")
#' inspect(model, what = "prior_distribution")
#' inspect(model, what = "prior_hyperparameters", nodes = "Y")
#' inspect(model, what = "prior_event_probabilities", parameters = c(.1, .9, .25, .25, 0, .5))
#' inspect(model, what = "prior_event_probabilities", given = "Y==1")
#' inspect(model, what = "data_types", complete_data = TRUE)
#' inspect(model, what = "data_types", complete_data = FALSE)
#'
#'
#' model <- update_model(model,
#'   data = data,
#'   keep_fit = TRUE,
#'   keep_event_probabilities = TRUE)
#'
#' inspect(model, what = "posterior_distribution")
#' inspect(model, what = "posterior_event_probabilities")
#' inspect(model, what = "type_posterior")
#' inspect(model, what = "data")
#' inspect(model, what = "stan_warnings")
#' inspect(model, what = "stanfit")
#' }
#'
inspect <- function(model, what = NULL, ...)
  .inspect.grab(model, what = what, print = TRUE, ...)


#' access objects from a causal model
#'
#' Returns specified elements from a \code{causal_model}.
#' Users can use \code{inspect} to extract model's components or objects implied by
#' the model structure including nodal types, causal types, parameter priors,
#' parameter posteriors, type priors, type posteriors, and other relevant elements.
#' See argument \code{what} for other options.
#'
#' @rdname inspection
#' @inheritParams CausalQueries_internal_inherit_params
#' @param what A character string specifying the component to retrieve.
#'   Available options are:
#'   \itemize{
#'   \item "\code{statement}" a character string describing causal relations using dagitty syntax,
#'   \item "\code{nodes}" A list containing the nodes in the model,
#'   \item "\code{parents_df}" A table listing nodes, whether they are root nodes or not, and the number and names of parents they have,
#'   \item "\code{parameters}" A vector of 'true' parameters,
#'   \item "\code{parameter_names}" A vector of names of parameters,
#'   \item "\code{parameter_mapping}" A matrix mapping from parameters into data types,
#'   \item "\code{parameter_matrix}" A matrix mapping from parameters into causal types,
#'   \item "\code{parameters_df}" A data frame containing parameter information,
#'   \item "\code{causal_types}" A data frame listing causal types and the nodal types that produce them,
#'   \item "\code{nodal_types}" A list with the nodal types of the model,
#'   \item "\code{data_types}" A list with all data types consistent with the model; for options see \code{?get_all_data_types},
#'   \item "\code{ambiguities_matrix}" A matrix mapping from causal types into data types,
#'   \item "\code{prior_hyperparameters}" A vector of alpha values used to parameterize Dirichlet prior distributions; optionally provide node names to reduce output, e.g., \code{inspect(prior_hyperparameters, nodes = c('M', 'Y'))},
#'   \item "\code{prior_distribution}" A data frame of the parameter prior distribution,
#'   \item "\code{posterior_distribution}" A data frame of the parameter posterior distribution,
#'   \item "\code{type_prior}" A matrix of type probabilities using priors,
#'   \item "\code{type_posterior}" A matrix of type probabilities using posteriors,
#'   \item "\code{prior_event_probabilities}" A vector of data (event) probabilities given a single realization of parameters; for options see \code{?get_event_probabilities},
#'   \item "\code{posterior_event_probabilities}" A sample of data (event) probabilities from the posterior,
#'   \item "\code{data}" A data frame with data that was provided to update the model,
#'   \item  \code{stan_summary}" A `stanfit` summary with processed parameter names,
#'   \item "\code{stanfit}" An (unprocessed) \code{stanfit} object as generated by Stan, with raw parameter names,
#'   \item "\code{stan_warnings}" Messages generated during the generation of a \code{stanfit} object.
#'   }
#' @param ... Other arguments passed to helper \code{"get_*"} functions: get_all_data_types, get_event_probabilities,  get_priors, Any such additional arguments must be named.
#' @return Quiet return of objects that can be derived from a \code{causal_model}.
#'
#' @export
#'
#' @examples
#' model <- make_model("X -> Y")
#'
#' x <- grab(model, what = "statement")
#' x

grab <- function(model, what = NULL, ...)
  .inspect.grab(model, what = what, print = FALSE, ...)

#' Helper for inspecting causal models
#' @keywords internal
#' @noRd

.inspect.grab <- function(model, what = NULL, print = TRUE, ...) {

  .small <- c(
    "statement",
    "nodes",
    "parents_df",
    "parameters",
    "parameter_names",
    "parameters_df",
    "causal_types",
    "nodal_types",
    "data_types",
    "prior_hyperparameters",
    "posterior_distribution",
    "posterior_event_probabilities",
    "type_posterior",
    "data",
    "stan_summary",
    "stanfit",
    "stan_warnings"
  )

  .large <- c(
    "parameter_mapping",
    "parameter_matrix",
    "causal_types",
    "prior_event_probabilities",
    "prior_distribution",
    "ambiguities_matrix",
    "type_prior"
  )

  if (!(what %in% c(.small, .large))) {
    stop("The object requested via what argument is not supported.
         Available objects include 'statement', 'nodes', 'parents_df', 'parameters',
         'parameter_names', 'parameter_mapping', 'parameter_matrix', 'parameters_df',
         'causal_types', 'nodal_types', 'data_types', 'ambiguities_matrix',
         'prior_hyperparameters', 'prior_distribution', 'posterior_distribution',
         'prior_event_probabilities', 'posterior_event_probabilities',
         'type_prior', 'type_posterior', 'data', 'stanfit',
          See ?inspect for more information")
  }

  if (what %in% .large) {
    model_sum <- summary(model, include = what, ...)
  } else {
    model_sum <- summary(model, ...)
  }

  if (print) print(model_sum, what = what)

  if (is.null(what)) {
    return(invisible(model_sum))
  } else {

    if (what %in% c("stanfit", "data", "type_posterior", "stan_summary", "stan_warnings")) {
      return(invisible(model_sum[["stan_objects"]][[what]]))
    } else if (what == "posterior_event_probabilities") {
      return(invisible(model_sum[["stan_objects"]][["event_probabilities"]]))
    } else if (!is.null(model_sum[[what]])) {
      return(invisible(model_sum[[what]]))
    } else {
      stop("The following requested object is not supported: ", what)
    }

  }

}