The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
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 | 8.00 | 9.00 | 9.00 |
| Network Density | 1.00 | 1.00 | 1.00 |
| Mean Distance | 0.29 | 0.30 | 0.27 |
| Mean Out-Strength | 1.00 | 1.00 | 1.00 |
| SD Out-Strength | 0.63 | 0.69 | 0.58 |
| Mean In-Strength | 1.00 | 1.00 | 1.00 |
| SD In-Strength | 0.00 | 0.00 | 0.00 |
| Mean Out-Degree | 2.67 | 3.00 | 3.00 |
| SD Out-Degree | 0.58 | 0.00 | 0.00 |
| Centralization (Out-Degree) | 0.25 | 0.00 | 0.00 |
| Centralization (In-Degree) | 0.25 | 0.00 | 0.00 |
| Reciprocity | 0.80 | 1.00 | 1.00 |
and their initial probabilities
bind_rows(lapply(tna_model_clus, \(x) x$inits), .id = "Cluster") |>
gt() |>
fmt_percent()| Cluster | Active | Average | Disengaged |
|---|---|---|---|
| Cluster 1 | 75.00% | 0.00% | 25.00% |
| Cluster 2 | 51.92% | 48.08% | 0.00% |
| Cluster 3 | 0.00% | 41.07% | 58.93% |
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 | 70.62% | 29.38% | 0.00% |
| Average | 51.34% | 45.98% | 2.68% |
| Disengaged | 33.33% | 38.10% | 28.57% |
transitions[[2]]| Cluster 1 | |||
| From\To | Active | Average | Disengaged |
|---|---|---|---|
| Active | 49.24% | 44.19% | 6.57% |
| Average | 32.50% | 58.61% | 8.90% |
| Disengaged | 33.33% | 57.33% | 9.33% |
transitions[[3]]| Cluster 1 | |||
| From\To | Active | Average | Disengaged |
|---|---|---|---|
| Active | 30.07% | 60.81% | 9.12% |
| Average | 15.94% | 57.32% | 26.74% |
| Disengaged | 6.58% | 47.08% | 46.35% |
We can also plot the cluster-specific transitions
layout(t(1:3))
plot(tna_model_clus)
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)
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,
colors = c("purple", "orange", "pink")
)
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.