Nothing
#' Fit a decomposable graphical model
#' @description A generic method for structure learning in decomposable
#' graphical models
#' @param df Character data.frame
#' @param type Character ("fwd", "bwd", "tree" or "tfwd")
#' @param q Penalty term in the stopping criterion
#' where \code{0} = AIC and \code{1} = BIC. Anything in between is
#' referred to as \code{qic}
#' @param sparse_qic Logical. If \code{nrow(df)} is small, the tables
#' tends to be sparse. In these cases the usual penalty term of AIC and
#' BIC is often too restrictive. If \code{sparse_qic} is \code{TRUE}
#' this penality is computed according to a sparse criteria. The criteria
#' resembles the usual penalty as \code{nrow(df)} grows.
#' @param trace Logical indicating whether or not to trace the procedure
#' @param thres A threshold mechanism for choosing between two different ways of
#' calculating the entropy.
#' @param wrap logical specifying if the result of a run with type = "tree"
#' should be converted to a "fwd" object
#' @return A \code{gengraph} object representing a decomposable graph.
#' @examples
#'
#' g <- fit_graph(derma)
#' print(g)
#' plot(g)
#'
#' # Adjacency matrix and adjacency list
#' adjm <- adj_mat(g)
#' adjl <- adj_lst(g)
#'
#' @details
#' The types are
#' \itemize{
#' \item "fwd": forward selection
#' \item "bwd": backward selection
#' \item "tree": Chow-Liu tree (first order interactions only)
#' \item "tfwd": A combination of "tree" and "fwd". This can speed up runtime considerably in high dimensions.
#' }
#' Using \code{adj_lst} on an object returned by \code{fit_graph} gives the
#' adjacency list corresponding to the graph. Similarly one can use \code{adj_mat}
#' to obtain an adjacency matrix. Applying the \code{rip} function on an
#' adjacency list returns the cliques and separators of the graph.
#' @references \url{https://arxiv.org/abs/1301.2267}, \doi{10.1109/ictai.2004.100}
#' @seealso \code{\link{adj_lst}}, \code{\link{adj_mat}},
#' \code{\link{as_igraph}}, \code{\link{gengraph}}
#' @export
fit_graph <- function(df,
type = "fwd",
q = .5,
trace = FALSE,
sparse_qic = FALSE,
thres = 5,
wrap = TRUE)
{
n <- ncol(df)
complete <- n * (n-1L) / 2L
if (!is.data.frame(df)) stop("df must be a data.frame.")
if (!(type %in% .types())) stop(.types_msg())
if (q < 0) stop("q must be positive")
x <- gengraph(df, type, q, sparse_qic)
if (inherits(x, "fwd")) {
if (!neq_empt_chr(as.vector(x$e))) {
# If no edges are added in fwd_init, x$e = character(0)
if (trace) msg(0L, complete, 0L, "delta-qic")
return(x)
}
}
if (inherits(x, "tree")) return(fit_tree(x, df, wrap))
triv <- trivial(x, complete)
update_k <- update_iteration(x)
k <- sum(x$adj_matrix)/2
x <- walk(x = x, df = df, q = q, thres = thres)
k <- update_k(k)
if (k == triv) return(x)
stp <- stop_condition(x)
stop_val <- attr(x$e, "d_qic")
if (stp(stop_val)) return(x)
while (!stp(stop_val)) {
if (trace) msg(k, complete, stop_val, "delta-qic")
x <- walk(x = x, df = df, q = q, thres = thres)
k <- update_k(k)
if (k == triv) {
if (trace) msg(k, complete, stop_val, "delta-qic")
return(x)
}
stop_val <- attr(x$e, "d_qic")
}
if (trace) msg(k, complete, stop_val, "delta-qic")
return(x)
}
#' Fit a decomposable graphical model on each component
#' @description Structure learning in decomposable graphical models on
#' several components
#' @inheritParams fit_graph
#' @param comp A list with character vectors. Each element in the list is a
#' component in the graph (using expert knowledge)
#' @return An adjacency list object
#' @seealso \code{\link{fit_graph}}, \code{\link{adj_lst.gengraph}},
#' \code{\link{adj_mat.gengraph}}, \code{\link{walk.fwd}},
#' \code{\link{walk.bwd}}, \code{\link{gengraph}}
#' @export
fit_components <- function(df,
comp,
type = "fwd",
q = 0.5,
trace = FALSE,
thres = 5,
wrap = TRUE)
{
adj <- lapply(unname(comp), function(x) {
fit_graph(df[, x, drop = FALSE], type = type, q = q, trace = trace, thres = thres, wrap = wrap)
})
return(unlist(lapply(adj, adj_lst), recursive = FALSE))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.