---
title: "Frequency-based TNA"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Frequency-based TNA}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  fig.width = 6,
  fig.height = 4,
  out.width = "100%",
  dev = "png",
  dpi = 150,
  comment = "#>"
)
suppressPackageStartupMessages({
  library("tna")
  library("tibble")
  library("dplyr")
  library("ggplot2")
})
options(scipen = 99)
options(digits = 2)
options(max.print = 30)
options(width = 83)
```


# FTNA tutorial

```{r}
# Install 'tna' package from CRAN if needed (uncomment if required).
# install.packages("tna")

# Load packages
library("tna")

# Load example data provided within the 'tna' package, 
# representing group regulatory interactions
data(group_regulation)

# Run FTNA on 'group_regulation' data using raw counts of 
# transitions ("absolute" type) and print the result
model <- ftna(group_regulation)

# Print the output to inspect the model
print(model)
```

```{r, fig.align='center'}
# Calculate the Transition Network Analysis (TNA) on the group_regulation 
# data with scaled weights between 0 and 1
model_scaled <- ftna(group_regulation, scaling = "minmax")
print(model_scaled) # Print the FTNA model with scaled weights
```

## Plotting

```{r, fig.align='center'}
# Plotting the two weights together to see if the scaling distorts the data

# Combine weights from absolute and scaled models into a data frame for plotting
weights_data <- data.frame(
  Absolute = as.vector(model$weights), # Extract absolute weights as a vector
  Scaled = as.vector(model_scaled$weights) # Extract scaled weights as a vector
)
corr <- cor(weights_data$Absolute, weights_data$Scaled, method = c("pearson")) |>
  round(digits = 2)

# Create a scatter plot comparing absolute vs. scaled weights
plot_abs_scaled <- ggplot(weights_data, aes(x = Absolute, y = Scaled)) +
  geom_point(color = "steelblue", alpha = 0.6, size = 2) +  # Add points with specified aesthetics
  geom_smooth(formula = y ~ x, method = "lm", color = "red", linetype = "dashed") + # Add a linear trend line
  # geom_smooth(method = lm, formula = y ~ x, se = FALSE) +
  geom_text(x = 0.1, y = 0.9, label = paste0('r = ', corr), color = 'red')
  # stat_cor(aes(label = after_stat(r.label)), label.x = 0.1, label.y = 0.9, 
  #          size = 4, color = "black", method = "spearman") + # Display Spearman correlation
  labs(x = "Absolute Weights", y = "Scaled Weights") + # Label axes
  theme_minimal() # Apply a minimal theme for the plot

# Display the scatter plot
plot_abs_scaled
```


```{r, fig.align='center', results = FALSE, message = FALSE}
# Calculate the Transition Network Analysis (TNA) on the `group_regulation` 
# data with ranked weights
model_ranked <- ftna(group_regulation, scaling = "rank")
print(model_ranked) # Print the FTNA model with ranked weights
```


```{r, fig.align='center'}
# Combine weights from absolute and ranked models into a data frame for plotting
weights_data <- data.frame(
  Absolute = as.vector(model$weights), # Extract absolute weights as a vector
  Ranked = as.vector(model_ranked$weights) # Extract ranked weights as a vector
)

# Create a scatter plot comparing Absolute vs. Ranked weights with correlation annotations
plot_abs_ranked <- ggplot(weights_data, aes(x = Absolute, y = Ranked)) +
  geom_point(color = "steelblue", alpha = 0.6, size = 2) +  # Add points with specified aesthetics
  geom_smooth(formula = y ~ x, method = "lm", color = "red", linetype = "dashed") +  # Add a linear trend line
  # stat_cor(aes(label = paste("Spearman: ", round(after_stat(r), 2))), 
  #          method = "spearman", label.x = 0.1, label.y = 0.9, size = 4, color = "black") + # Spearman correlation annotation
  # stat_cor(aes(label = paste("Pearson: ", round(after_stat(r), 2))), 
  #          method = "pearson", label.x = 0.1, label.y = 0.8, size = 4, color = "darkgreen") + # Pearson correlation annotation
  labs(x = "Absolute Weights", y = "Ranked Weights") + # Label axes
  theme_minimal() # Apply a minimal theme for the plot

# Display the scatter plot
plot_abs_ranked
```


## Pruning

```{r, fig.show='hold', fig.width=9, fig.height=9}
layout(matrix(1:4, ncol = 2))
# Pruning with different methods
pruned_threshold <- prune(model_scaled, method = "threshold", threshold = 0.1)
pruned_lowest <- prune(model_scaled, method = "lowest", lowest = 0.15)
pruned_disparity <- prune(model_scaled, method = "disparity", alpha = 0.5)

# Plotting for comparison
plot(pruned_threshold)
plot(pruned_lowest)
plot(pruned_disparity)
plot(model_scaled)
```

## Patterns

```{r, fig.align='center', fig.width=3, fig.height=2}
# Identify 2-cliques (dyads) from the FTNA model with a weight threshold, 
# excluding loops in visualization.
# A 2-clique represents a pair of nodes that are strongly connected based on 
# the specified weight threshold.
layout(matrix(1:6, ncol = 3))
cliques_of_two <- cliques(
  model_scaled,      # The FTNA model with scaled edge weights
  size = 2,          # Looking for pairs of connected nodes (dyads)
  threshold = 0.1    # Only include edges with weights greater than 0.1
)

# Print and visualize the identified 2-cliques (dyads)
print(cliques_of_two)  # Display details of 2-cliques
plot(cliques_of_two, ask = F)   # Visualize 2-cliques in the network
```
```{r, fig.align='center'}
layout(matrix(1:6, ncol = 3))
# Identify 3-cliques (triads) from the FTNA model.
# A 3-clique is a fully connected set of three nodes, indicating a strong 
# triplet structure.
cliques_of_three <- cliques(
  model_scaled,      # The FTNA model with scaled edge weights
  size = 3,          # Looking for triplets of fully connected nodes (triads)
  threshold = 0.05   # Only include edges with weights greater than 0.05
)

# Print and visualize the identified 3-cliques (triads)
# Uncomment the code below to view the results
print(cliques_of_three) # Display details of 3-cliques
plot(cliques_of_three, ask = FALSE)  # Visualize 3-cliques in the network
```
```{r, fig.align='center', fig.width=6, fig.height=4}
layout(matrix(1:6, ncol = 3))
# Identify 4-cliques (quadruples) from the FTNA model.
# A 4-clique includes four nodes where each node is connected to every other 
# node in the group.
# Uncomment the code below to view the results
cliques_of_four <- cliques(
  model_scaled,      # The FTNA model with scaled edge weights
  size = 4,          # Looking for quadruples of fully connected nodes (4-cliques)
  threshold = 0.03   # Only include edges with weights greater than 0.03
)

# Print and visualize the identified 4-cliques (quadruples) 
# Uncomment the code below to view the results
print(cliques_of_four)  # Display details of 4-cliques
plot(cliques_of_four, ask = FALSE)   # Visualize 4-cliques in the network
```
```{r, fig.align='center'}
# Identify 5-cliques (quintuples) from the FTNA model, summing edge weights.
# Here, the sum of edge weights in both directions must meet the specified 
# threshold for inclusion.
# Uncomment the code below to view the results
cliques_of_five <- cliques(
  model_scaled,      # The FTNA model with scaled edge weights
  size = 5,          # Looking for quintuples of fully connected nodes (5-cliques)
  threshold = 0.1,   # Only edges with total bidirectional weights greater than 0.1
  sum_weights = TRUE # Sum edge weight in both directions when computing  threshold
)

# Print and visualize the identified 5-cliques (quintuples)
print(cliques_of_five)  # Display details of 5-cliques
plot(cliques_of_five, ask = FALSE)   # Visualize 5-cliques in the network
```

## Graph level measures

```{r}
summary(model_scaled)
```

```{r}
summary(pruned_disparity)
```


## Node level measures

```{r, fig.width=7, fig.height=7}
# Compute centrality measures for the FTNA model
centrality_measures <- centralities(model_scaled)

# Print the calculated centrality measures in the FTNA model
print(centrality_measures)
plot(centrality_measures)
```

```{r}
# Convert the FTNA model to an igraph object and 
# calculate HITS (Hub and Authority) scores
hits_results <- igraph::hits_scores(as.igraph(model_scaled))

# Extract the hub and authority scores from the HITS results for further analysis
hub_scores <- hits_results$hub
authority_scores <- hits_results$authority
```

```{r}
# Print the hub and authority scores to view influential nodes
print(hub_scores)
print(authority_scores)
```


## Edge level measures

```{r, fig.align='center', fig.width=5, fig.height=5}
edge_between <- betweenness_network(model_scaled)
plot(edge_between)
```

## Community detection

```{r, fig.align='center', fig.width=5, fig.height=5}
detected_communities <- communities(model_scaled)
plot(detected_communities, method = "leading_eigen")
print(detected_communities, method = "leading_eigen")
```

## Bootstrapping

```{r}
# Perform bootstrapping on the FTNA model with a fixed seed for reproducibility
set.seed(265)
boot <- bootstrap(model_scaled, threshold = 0.05)

# Print the combined results data frame containing
print(summary(boot))

# View non-significant edges  which are less likely to be stable across bootstrap samples
print(boot, type = "nonsig")
```

## Comparing Models

```{r, fig.align='center', fig.height=5, fig.width=5, layout = c(1,1)}
# Create FTNA for the high-achievers subset (rows 1 to 1000)
Hi <- ftna(group_regulation[1:1000, ], scaling = "minmax")

# Create FTNA for the low-achievers subset (rows 1001 to 2000)
Lo <- ftna(group_regulation[1001:2000, ], scaling = "minmax")

# Plot a comparison of the "Hi" and "Lo" models
# The 'minimum' parameter is set to 0.001, so edges with weights >= 0.001 are shown
plot_compare(Hi, Lo, minimum = 0.0001)

# Run a permutation test to determine statistical significance of 
# differences between "Hi" and "Lo"
# The 'it' parameter is set to 1000, meaning 1000 permutations are performed
Permutation <- permutation_test(Hi, Lo, it = 1000)

# Plot the significant differences identified in the permutation test
plot(Permutation)
```

## Centrality stability

```{r, fig.width=7, fig.height=4}
Centrality_stability <- estimate_centrality_stability(model_scaled, iter = 100)
plot(Centrality_stability)
```
