R/get_type_helpers.R

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

#' Identify nodes in a statement
#'
#'@param nodes A vector of characters. It should contain quoted names of the nodes in \code{model}
#'@param statement A character. A quoted causal statement.
#'@return Returns name of nodes present in a statement
#'@keywords internal
#'@importFrom stringr boundary str_split
nodes_in_statement <- function(nodes, statement) {
    nodes[nodes %in% str_split(statement, boundary("word"))[[1]]]
}

#' Returns a list with the nodes that are not directly pointing into a node
#'
#'@inheritParams CausalQueries_internal_inherit_params
#'@return Returns a list with the nodes that are not directly pointing into a node
#'@keywords internal
list_non_parents <- function(model, node) {
    node_parents <- get_parents(model)[[node]]
    not_parents <- !model$nodes %in% c(node_parents, node)
    model$nodes[not_parents]
}
#' Adds a wildcard for every missing parent
#'@inheritParams CausalQueries_internal_inherit_params
#'@param parents A vector of characters. The \code{node}'s parents
#'@param missing_parents A vector of characters.  The \code{node}'s missing parents
#'@return A causal query expression with all parents nodes set to either 0, 1 or wildcard '.'
#'@keywords internal
add_wildcard <- function(node, statement, parents, missing_parents) {
    if (all(parents %in% missing_parents)) {
        q <- paste0(node, "[", paste0(missing_parents, " = . ", collapse = ", "), "]")
    } else if (length(missing_parents) > 0) {
        q <- gsub("\\]", paste0(", ", paste0(missing_parents, " = . ", collapse = ", "), "\\]"), statement)
    }
    return(q)
}