inst/doc/ddtlcm-demo.R

In ddtlcm: Latent Class Analysis with Dirichlet Diffusion Tree Process Prior

## ----setup,echo=FALSE,results="hide", include = FALSE-------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  echo = TRUE, warning = FALSE, message = FALSE
)
suppressPackageStartupMessages({
library(knitr)
})
hook_output = knit_hooks$get('output')
knit_hooks$set(output = function(x, options) {
  # this hook is used only when the linewidth option is not NULL
  if (!is.null(n <- options$linewidth)) {
    x = xfun::split_lines(x)
    # any lines wider than n should be wrapped
    if (any(nchar(x) > n)) x = strwrap(x, width = n)
    x = paste(x, collapse = '\n')
  }
  hook_output(x, options)
})
options(warn = -1)

## ----eval=FALSE, include=FALSE------------------------------------------------
#  install.packages("/Users/mengbing/Dropbox (University of Michigan)/from_box/research/R_packages/ddtlcm_0.1.2.tar.gz", repos = NULL, type="source")

## ----eval=FALSE---------------------------------------------------------------
#  install.packages("devtools",repos="https://cloud.r-project.org")
#  devtools::install_github("limengbinggz/ddtlcm")

## -----------------------------------------------------------------------------
library(ddtlcm)
# load the MAP tree structure obtained from the real HCHS/SOL data
data(parameter_diet)
# unlist the elements into variables in the global environment
list2env(setNames(parameter_diet, names(parameter_diet)), envir = globalenv()) 

# look at items in group 1
g <- 1
# indices of the items in group 1
item_membership_list[g]
# names of the items in group 1. The name of the list element is the major food group
item_name_list[g]

## -----------------------------------------------------------------------------
# number of individuals
N <- 496
# set random seed to generate node parameters given the tree
seed_parameter = 1
# set random seed to generate multivariate binary observations from LCM
seed_response = 1
# simulate data given the parameters
sim_data <- simulate_lcm_given_tree(tree_phylo, N, 
            class_probability, item_membership_list, Sigma_by_group, 
            root_node_location = 0, seed_parameter = 1, seed_response = 1)

## ----fig.height = 4, fig.width = 6--------------------------------------------
response_matrix <- sim_data$response_matrix
dim(response_matrix)
response_prob <- sim_data$response_prob
tree_with_parameter <- sim_data$tree_with_parameter
plot_tree_with_heatmap(tree_with_parameter, response_prob, item_membership_list)

## -----------------------------------------------------------------------------
set.seed(999)
# number of latent classes, or number of leaves on the tree
K <- 6
suppressWarnings({ 
system.time({
  result <- ddtlcm_fit(K = K, data = response_matrix, 
                     item_membership_list = item_membership_list, total_iters = 100)
})
})
print(result)
# result$tree_samples$tree_list

## ----fig.width=6, fig.height=6------------------------------------------------
par(mfrow = c(2,2))
plot(x = result, parameter_names = c("responseprob_1,1,1", "classprob_1", "c", "diffusionvar_1"), burnin = 50)

## -----------------------------------------------------------------------------
burnin <- 50
summarized_result <- summary(result, burnin, relabel = T, be_quiet = T)

## ----fig.height = 6, fig.width = 7--------------------------------------------
plot(x = summarized_result, item_name_list = item_name_list, plot_option = "all")

## -----------------------------------------------------------------------------
rmse <- sqrt(mean((summarized_result$response_probs_summary[, "Mean"] - sim_data$response_prob)**2))
cat("\nRMSE of the item response probabilities:", rmse)

## -----------------------------------------------------------------------------
predicted_class_assignments1 <- predict(summarized_result, response_matrix)
cat("\nFrequencies of predicted class memberships from posterior summaries:\n", tabulate(predicted_class_assignments1$class_assignments, K))

## -----------------------------------------------------------------------------
predicted_class_assignments2 <- predict(result, response_matrix, burnin)
cat("\nFrequencies of predicted class memberships from posterior predictive distribution:\n", tabulate(predicted_class_assignments2$class_assignments, K))