tests_for_graphics/test_plot_models.R

In helske/seqHMM: Mixture Hidden Markov Models for Social Sequence Data and Other Multivariate, Multichannel Categorical Time Series

# Hidden Markov model

data("hmm_biofam")
plot(hmm_biofam)
plot(hmm_biofam, layout = "vertical", with.legend = "right")
plot(hmm_biofam, )
plot(hmm_biofam, layout = "vertical", pie = FALSE, vertex.label = "names",
  vertex.label.pos = pi/5, vertex.label.family = "serif", loops = TRUE)

data("hmm_mvad")
plot(hmm_mvad)
require("igraph")
plot(hmm_mvad, layout = layout_in_circle, edge.label = NA, legend.prop = 0.25,
  vertex.label.pos = c("bottom", "right", "top", "bottom", "right"),
  with.legend = "left", edge.curved = 0.2)
plot(hmm_mvad, layout = layout_in_circle, label.signif = 2,
  label.max.length = 3, with.legend = FALSE)
plot(hmm_mvad, layout = layout_in_circle, label.signif = 3,
  label.scientific = TRUE, label.max.length = 6, with.legend = FALSE)

# Test HMM with own legend

# Check the alphabet of the (combined) observations
alphabet(hmm_mvad$observations)
# Finding 6 observed states

# Set the alphabet
alphabet(hmm_mvad$observations) <- c("SC", "FE", "HE", "TR", "JL", "EM")

# Order by alphabet in observations
plot(hmm_mvad, legend.order = FALSE)

# New names, colours ordered by alphabet
plot(hmm_mvad, ltext = c("employed", "FE", "HE", "jobless", "school", "training"), legend.order = FALSE)

# New colours, names and order according to the alphabet
plot(hmm_mvad, 
     cpal = c("purple", "pink", "brown", "lightblue", "orange", "green"),
     legend.order = FALSE)

# New names and colours
alphabet(hmm_mvad$observations)
plot(hmm_mvad, 
     # Colours in the pies (order by alphabet of observations)
     cpal = c("purple", "pink", "brown", "lightblue", "orange", "green"),
     # Colours in the legend (matching to ltext)
     cpal.legend = c("orange", "pink", "brown", "green", "lightblue", "purple", "gray"), 
     # Labels in the legend (matching to cpal.legend)
     ltext = c("school", "further educ", "higher educ", "training", "jobless", "employed", "none"), legend.order = FALSE)

# Too few colours and labels in the legend (is fine)
plot(hmm_mvad, 
     # Colours in the pies (order by alphabet of observations)
     cpal = c("purple", "pink", "brown", "lightblue", "orange", "green"),
     # Colours in the legend (matching to ltext)
     cpal.legend = c("orange", "pink", "brown", "green", "lightblue"), 
     # Labels in the legend (matching to cpal.legend)
     ltext = c("school", "further educ", "higher educ", "training", "jobless"), legend.order = FALSE)



# Markov model

data("mvad", package = "TraMineR")

mvad_alphabet <-
  c("employment", "FE", "HE", "joblessness", "school", "training")
mvad_labels <- c("employment", "further education", "higher education",
  "joblessness", "school", "training")
mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
mvad_seq <- seqdef(mvad, 17:86, alphabet = mvad_alphabet,
  states = mvad_scodes, labels = mvad_labels, xtstep = 6)
attr(mvad_seq, "cpal") <- colorpalette[[6]]
mm_mvad <- build_mm(observations = mvad_seq)
plot(mm_mvad)
plot(mm_mvad, layout = layout_in_circle, edge.label = NA, with.legend = "bottom")
plot(mm_mvad, layout = layout_in_circle, edge.label = 1:28, with.legend = "right")
plot(mm_mvad, layout = layout_in_circle, edge.label = NA, with.legend = "left")
plot(mm_mvad, layout = layout_in_circle, edge.label = NA, with.legend = "top")


# Mixture hidden Markov model

data("mhmm_biofam")
plot(mhmm_biofam, which.plots = 1)
plot(mhmm_biofam, layout = "vertical", with.legend = "right")
plot(mhmm_biofam, ask = TRUE)
plot(mhmm_biofam, interactive = FALSE, which.plots = 2:3,
  layout = layout_as_star, edge.curved = 0, with.legend = "right")
plot(mhmm_biofam, interactive = FALSE,
  ncol = 3, layout = "vertical", with.legend = "right")

data("mhmm_mvad")
set.seed(123)
plot(mhmm_mvad, interactive = FALSE, layout = layout_nicely,
  with.legend = "right", edge.curved = 0.2, cex.edge.width = 0.5,
  edge.arrow.size = 0.7, vertex.label.pos = "bottom")


# Mixture Markov model

set.seed(123)
mmm_mvad <- build_mmm(observations = mvad_seq,
  transition_probs = simulate_transition_probs(n_states = 6, n_clusters = 2),
  initial_probs = replicate(2, rep(1/6, 6), simplify = FALSE),
  formula = ~male, data = mvad)
plot(mmm_mvad)
plot(mmm_mvad, interactive = FALSE, with.legend = "right",
  layout = layout_as_star, edge.label = NA, edge.arrow.size = 0.8,
  edge.curved = 0.2, legend.prop = 0.3,
  vertex.label.pos = c("left", "right", "right", "left", "left", "right"),
  cex.legend = 1.2)


# Latent class model

set.seed(123)
obs <- seqdef(rbind(
  matrix(sample(letters[1:3], 5000, TRUE, prob = c(0.1, 0.6, 0.3)), 500, 10),
  matrix(sample(letters[1:3], 2000, TRUE, prob = c(0.4, 0.4, 0.2)), 200, 10)))
lcm <- build_lcm(obs, n_clusters = 2)
plot(lcm)
plot(lcm, interactive = FALSE, with.legend = "right")