# Using grouped sequence data with tna

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.

    library("tna")
    library("tibble")
    library("dplyr")
    library("gt")
    library("seqHMM")
    data("engagement", package = "tna")

We simulate transition probabilities to initialize the model.

    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`).

    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.

    tna_model_clus <- group_model(fit_mmm$model)

We can summarize the cluster-specific models

    summary(tna_model_clus) |>
      gt() |>
      fmt_number(decimals = 2)

metric | Cluster 1 | Cluster 2 | Cluster 3
--- | --- | --- | ---
Node Count | 3.00 | 3.00 | 3.00
Edge Count | 9.00 | 8.00 | 8.00
Network Density | 1.00 | 1.00 | 1.00
Mean Distance | 0.11 | 0.24 | 0.30
Mean Out-Strength | 1.00 | 1.00 | 1.00
SD Out-Strength | 0.21 | 0.35 | 0.47
Mean In-Strength | 1.00 | 1.00 | 1.00
SD In-Strength | 0.00 | 0.00 | 0.00
Mean Out-Degree | 3.00 | 2.67 | 2.67
SD Out-Degree | 0.00 | 0.58 | 0.58
Centralization (Out-Degree) | 0.00 | 0.25 | 0.25
Centralization (In-Degree) | 0.00 | 0.25 | 0.25
Reciprocity | 1.00 | 0.80 | 0.80

and their initial probabilities

    bind_rows(lapply(tna_model_clus, \(x) x$inits), .id = "Cluster") |>
      gt() |>
      fmt_percent()

Cluster 1 | Cluster 2 | Cluster 3
--- | --- | ---
33.98% | 75.00% | 0.00%
32.35% | 8.33% | 0.00%
33.67% | 16.67% | 100.00%

as well as transition probabilities.

    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]]

Cluster 1
From\To | Active | Average | Disengaged
--- | --- | --- | ---
Active | 85.99% | 8.92% | 5.09%
Average | 31.21% | 54.21% | 14.58%
Disengaged | 4.79% | 16.18% | 79.03%

    transitions[[2]]

Cluster 1
From\To | Active | Average | Disengaged
--- | --- | --- | ---
Active | 84.09% | 15.91% | 0.00%
Average | 9.26% | 62.96% | 27.78%
Disengaged | 15.56% | 51.11% | 33.33%

    transitions[[3]]

Cluster 1
From\To | Active | Average | Disengaged
--- | --- | --- | ---
Active | 58.33% | 12.50% | 29.17%
Average | 15.28% | 81.94% | 2.78%
Disengaged | 0.00% | 60.00% | 40.00%

We can also plot the cluster-specific transitions

    layout(t(1:3))
    plot(tna_model_clus, vsize = 20, edge.label.cex = 2)

Just like ordinary TNA models, we can prune the rare transitions

    pruned_clus <- prune(tna_model_clus, threshold = 0.1)

and plot the cluster transitions after pruning

    layout(t(1:3))
    plot(pruned_clus, vsize = 20, edge.label.cex = 2)

Centrality measures can also be computed for each cluster directly.

    centrality_measures <- c(
      "BetweennessRSP",
      "Closeness",
      "InStrength",
      "OutStrength"
    )
    centralities_per_cluster <- centralities(
      tna_model_clus,
      measures = centrality_measures
    )
    plot(
      centralities_per_cluster, ncol = 4,
      colors = c("purple", "orange", "pink")
    )