inst/doc/introduction.R

In bgms: Bayesian Analysis of Networks of Binary and/or Ordinal Variables

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = identical(Sys.getenv("BUILD_VIGNETTE"), "true")
)

## ----setup--------------------------------------------------------------------
# library(bgms)

## ----usage2, eval=FALSE-------------------------------------------------------
# bgm(x,
#     variable_type = "ordinal",
#     reference_category,
#     iter = 1e4,
#     burnin = 1e3,
#     interaction_scale = 2.5,
#     threshold_alpha = 0.5,
#     threshold_beta = 0.5,
#     edge_selection = TRUE,
#     edge_prior = c("Bernoulli", "Beta-Bernoulli", "Stochastic-Block"),
#     inclusion_probability = 0.5,
#     beta_bernoulli_alpha = 1,
#     beta_bernoulli_beta = 1,
#     dirichlet_alpha = 1,
#     na.action = c("listwise", "impute"),
#     save = FALSE,
#     display_progress = TRUE)

## ----message=FALSE, warning=FALSE, cache=TRUE---------------------------------
# fit <-  bgm(x = Wenchuan)

## ----message=FALSE, warning=FALSE, fig.width= 7, fig.height= 7----------------
# par(mar = c(6, 5, 1, 1))
# plot(x = fit$interactions[lower.tri(fit$interactions)],
#      y = fit$indicator[lower.tri(fit$indicator)], ylim = c(0, 1),
#      xlab = "", ylab = "", axes = FALSE, pch = 21, bg = "gray", cex = 1.3)
# abline(h = 0, lty = 2, col = "gray")
# abline(h = 1, lty = 2, col = "gray")
# abline(h = .5, lty = 2, col = "gray")
# mtext("Posterior mean edge weight", side = 1, line = 3, cex = 1.7)
# mtext("Posterior inclusion probability", side = 2, line = 3, cex = 1.7)
# axis(1)
# axis(2, las = 1)

## ----message=FALSE, warning=FALSE, fig.width= 7, fig.height= 7----------------
# library(qgraph) #For plotting the estimated network
# 
# posterior.inclusion <- fit$indicator[lower.tri(fit$indicator)]
# tmp <- fit$interactions[lower.tri(fit$interactions)]
# tmp[posterior.inclusion < 0.5] = 0
# 
# median.prob.model <- matrix(0, nrow = ncol(Wenchuan), ncol = ncol(Wenchuan))
# median.prob.model[lower.tri(median.prob.model)] <- tmp
# median.prob.model <- median.prob.model + t(median.prob.model)
# 
# rownames(median.prob.model) <- colnames(Wenchuan)
# colnames(median.prob.model) <- colnames(Wenchuan)
# 
# qgraph(median.prob.model,
#        theme = "TeamFortress",
#        maximum = .5,
#        fade = FALSE,
#        color = c("#f0ae0e"), vsize = 10, repulsion = .9,
#        label.cex = 1.1, label.scale = "FALSE",
#        labels = colnames(Wenchuan))

## ----message=FALSE, warning=FALSE---------------------------------------------
# # Calculate the inclusion BFs
# prior.odds = 1
# posterior.inclusion = fit$indicator[lower.tri(fit$indicator)]
# posterior.odds = posterior.inclusion / (1 - posterior.inclusion)
# log.bayesfactor = log(posterior.odds / prior.odds)
# #The next line is used to truncate the extreme values of the Bayes factor in the plot
# log.bayesfactor[log.bayesfactor > 5] = 5

## ----message=FALSE, warning=FALSE, fig.width= 7, fig.height= 7----------------
# par(mar = c(5, 5, 1, 1) + 0.1)
# plot(fit$interactions[lower.tri(fit$interactions)], log.bayesfactor, pch = 21, bg = "#bfbfbf",
#     cex = 1.3, axes = FALSE, xlab = "", ylab = "", ylim = c(-5, 5.5),
#     xlim = c(-0.5, 1.5))
# axis(1)
# axis(2, las = 1)
# abline(h = log(1/10), lwd = 2, col = "#bfbfbf")
# abline(h = log(10), lwd = 2, col = "#bfbfbf")
# 
# text(x = 1, y = log(1 / 10), labels = "Evidence for exclusion", pos = 1,
#     cex = 1.7)
# text(x = 1, y = log(10), labels = "Evidence for inclusion", pos = 3, cex = 1.7)
# text(x = 1, y = 0, labels = "Weak evidence", cex = 1.7)
# mtext("Log-inclusion Bayes factor", side = 2, line = 3, cex = 1.5, las = 0)
# mtext("Posterior mean edge weights ", side = 1, line = 3.7, cex = 1.5, las = 0)

## ----message=FALSE, warning=FALSE, cache=TRUE---------------------------------
# fit <-  bgm(x = Wenchuan, save = TRUE)

## ----message=FALSE, warning=FALSE, fig.width= 7, fig.height= 7----------------
# den = density(fit$interactions[,1], bw = "SJ")
# i = which.min(abs(den$x - mean(fit$interactions[,1])))[1]
# x = den$x[i]
# f = den$y[i]
# par(cex.main = 1.5, mar = c(5, 6, 1, 1) + 0.1, mgp = c(3.5, 1, 0), cex.lab = 1.5, font.lab = 2, cex.axis = 1.3, bty = "n", las = 1)
# plot(den, axes = FALSE, xlab="", ylab="", main = "", frame.plot = FALSE)
# axis(1)
# axis(2)
# par(las = 0)
# mtext(text = "Edge weight", side = 1, line = 2.5, cex = 1.5)
# mtext(text = "Posterior density", side = 2, line = 2.5, cex = 1.5)
# # Add a point to indicate the posterior mean
# points(x, f, pch = 21, bg = "grey", cex = 1.7)

## ----message=FALSE, warning=FALSE---------------------------------------------
# I = 2 * fit$indicator - 1
# S = unique(I)
# nrow(S)

## ----message=FALSE, warning=FALSE---------------------------------------------
# Ps = vector(length = nrow(S))
# for(r in 1:nrow(S)) {
#   s = S[r, ]
#   tmp = I %*% s
#   Ps[r] = sum(tmp == ncol(I))
# }
# Ps = Ps / nrow(I) * 100
# max(Ps)