inst/doc/bcdag_getfamily.R

In BCDAG: Bayesian Structure and Causal Learning of Gaussian Directed Graphs

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
oldpar <- par(no.readonly = TRUE)
oldoptions <- options()

## ----setup--------------------------------------------------------------------
library(BCDAG)

## -----------------------------------------------------------------------------
## Generate data
set.seed(1)
q <- 8
w <- 0.2
DAG <- rDAG(q,w)
a <- q
U <- diag(1,q)
outDL <- rDAGWishart(n=1, DAG, a, U)
L <- outDL$L; D <- outDL$D
Omega <- L %*% solve(D) %*% t(L)
Sigma <- solve(Omega)
n <- 1000
X <- mvtnorm::rmvnorm(n = n, sigma = Sigma)

## ----echo = FALSE, include=FALSE----------------------------------------------
out <- learn_DAG(S = 5000, burn = 1000, data = X,
                 a, U, w, 
                 fast = FALSE, save.memory = FALSE, collapse = FALSE)

## ----eval = FALSE-------------------------------------------------------------
# ## Run MCMC
# out <- learn_DAG(S = 5000, burn = 1000, data = X,
#                  a, U, w,
#                  fast = FALSE, save.memory = FALSE, collapse = FALSE)

## ----fig.width = 7, fig.height= 6---------------------------------------------
get_diagnostics(out, ask = FALSE)

## -----------------------------------------------------------------------------
print(out)
summary(out)
plot(out)

## -----------------------------------------------------------------------------
get_edgeprobs(out)

## -----------------------------------------------------------------------------
MPMdag <- get_MPMdag(out)
MPMdag

## -----------------------------------------------------------------------------
MAPdag <- get_MAPdag(out)
MAPdag

## ----fig.width = 7------------------------------------------------------------
par(mfrow = c(1,3))
Rgraphviz::plot(as_graphNEL(DAG), main = "True DAG")
Rgraphviz::plot(as_graphNEL(MPMdag), main = "MPM DAG")
Rgraphviz::plot(as_graphNEL(MAPdag), main = "MAP DAG")

## -----------------------------------------------------------------------------
round(L, 3)

## -----------------------------------------------------------------------------
Rgraphviz::plot(as_graphNEL(DAG), main = "True DAG")

## -----------------------------------------------------------------------------
causaleffect(targets = c(4,5), response = 1, L = L, D = D)
causaleffect(targets = 4, response = 1, L = L, D = D)
causaleffect(targets = 5, response = 1, L = L, D = D)

## -----------------------------------------------------------------------------
DAG2 <- DAG
DAG2[4,5] <- 1
par(mfrow = c(1,2))
Rgraphviz::plot(as_graphNEL(DAG), main = "True DAG")
Rgraphviz::plot(as_graphNEL(DAG2), main = "Modified DAG")

## ----include = FALSE----------------------------------------------------------
par(mfrow = c(1,1))

## -----------------------------------------------------------------------------
L2 <- L
L2[4,5] <- runif(1)
L2[4,5]

## -----------------------------------------------------------------------------
causaleffect(targets = c(4,5), response = 1, L = L2, D = D)
causaleffect(targets = 4, response = 1, L = L2, D = D)
causaleffect(targets = 5, response = 1, L = L2, D = D)

## -----------------------------------------------------------------------------
effects_out <- get_causaleffect(out, targets = c(4,5), response = 1)
head(effects_out$causaleffects)

## -----------------------------------------------------------------------------
print(effects_out)
summary(effects_out)
plot(effects_out)

## ----echo = FALSE, include=FALSE----------------------------------------------
coll_out <- learn_DAG(S = 5000, burn = 1000, data = X,
                      a, U, w, 
                 fast = FALSE, save.memory = FALSE, collapse = TRUE)

## ----eval=FALSE---------------------------------------------------------------
# coll_out <- learn_DAG(S = 5000, burn = 1000, data = X,
#                       a, U, w,
#                  fast = FALSE, save.memory = FALSE, collapse = TRUE)

## -----------------------------------------------------------------------------
names(coll_out)

## ----include = FALSE----------------------------------------------------------
effects_collout <- get_causaleffect(coll_out, targets = c(4,5), response = 1)

## ----eval = FALSE-------------------------------------------------------------
# effects_collout <- get_causaleffect(coll_out, targets = c(4,5), response = 1)

## -----------------------------------------------------------------------------
round(effects_collout$post_mean, 3)

## ----include = FALSE----------------------------------------------------------
par(oldpar)
options(oldoptions)