---
title: "Using grouped sequence data with tna"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Using grouped sequence data with tna}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  fig.width = 10,
  fig.height = 6,
  out.width = "100%",
  dpi = 300,
  comment = "#>"
)
suppressPackageStartupMessages({
  library("tna")
  library("tibble")
  library("dplyr")
  library("gt")
})
```

TNA also enables the analysis of transition networks constructed from grouped sequence data.
In this example, we first fit a mixed Markov model to the `engagement` data using the `seqHMM` package and build a grouped TNA model based on this model.
First, we load the packages we will use for this example.

```{r, eval = FALSE}
library("tna")
library("tibble")
library("dplyr")
library("gt")
library("seqHMM")
data("engagement", package = "tna")
```

We simulate transition probabilities to initialize the model.
```{r, eval = FALSE}
set.seed(265)
tna_model <- tna(engagement)
n_var <- length(tna_model$labels)
n_clusters <- 3
trans_probs <- simulate_transition_probs(n_var, n_clusters)
init_probs <- list(
  c(0.70, 0.20, 0.10),
  c(0.15, 0.70, 0.15),
  c(0.10, 0.20, 0.70)
)
```

Next, we building and fit the model (this step takes some time to compute, the final model object is also available in the `tna` package as `engagement_mmm`).
```{r, eval = FALSE}
mmm <- build_mmm(
  engagement,
  transition_probs = trans_probs,
  initial_probs = init_probs
)
fit_mmm <- fit_model(
  modelTrans,
  global_step = TRUE,
  control_global = list(algorithm = "NLOPT_GD_STOGO_RAND"),
  local_step = TRUE,
  threads = 60,
  control_em = list(restart = list(times = 100, n_optimum = 101))
)
```

Now, we create a new model using the cluster information from the model. 
Alternatively, if sequence data is provided to `group_model()`, the group assignments can be provided with the `group` argument.
```{r, eval = TRUE, echo = FALSE}
tna_model_clus <- group_model(engagement_mmm)
```
```{r, eval = FALSE}
tna_model_clus <- group_model(fit_mmm$model)
```

We can summarize the cluster-specific models
```{r}
summary(tna_model_clus) |>
  gt() |>
  fmt_number(decimals = 2)
```

and their initial probabilities
```{r}
bind_rows(lapply(tna_model_clus, \(x) x$inits), .id = "Cluster") |>
  gt() |>
  fmt_percent()
```

as well as transition probabilities.
```{r}
transitions <- lapply(
  tna_model_clus,
  function(x) {
    x$weights |>
      data.frame() |>
      rownames_to_column("From\\To") |>
      gt() |>
      tab_header(title = names(tna_model_clus)[1]) |>
      fmt_percent()
  }
)
transitions[[1]]
transitions[[2]]
transitions[[3]]
```

We can also plot the cluster-specific transitions
```{r, fig.width=6, fig.height=2}
layout(t(1:3))
plot(tna_model_clus)
```

Just like ordinary TNA models, we can prune the rare transitions
```{r}
pruned_clus <- prune(tna_model_clus, threshold = 0.1)
```

and plot the cluster transitions after pruning
```{r, fig.width=6, fig.height=2, message = FALSE}
layout(t(1:3))
plot(pruned_clus)
```
 
Centrality measures can also be computed for each cluster directly.
```{r, fig.width=9, fig.height=4}
centrality_measures <- c(
  "BetweennessRSP",
  "Closeness",
  "InStrength",
  "OutStrength"
)
centralities_per_cluster <- centralities(
  tna_model_clus,
  measures = centrality_measures
)
plot(
  centralities_per_cluster,
  colors = c("purple", "orange", "pink")
)
```