## ----include = FALSE-------------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  fig.width = 6,
  fig.height = 4,
  cache = TRUE,
  dev = "svg",
  fig.ext="svg",
  out.width = "100%",
  dpi = 100,
  comment = "#>"
)
suppressPackageStartupMessages({
  library("tna")
  library("tibble")
  library("dplyr")
  library("ggplot2")
})

 
options(scipen = 99)
options(digits = 2)
options(max.print = 30)
options(width = 83)

## --------------------------------------------------------------------------------
# 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)

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

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

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

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

## ----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, minimum = 0.05, cut = 0.1)

## ----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, vsize = 20)   # Visualize 2-cliques in the network

## ----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 = F)  # Visualize 3-cliques in the network

## ----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 = F)   # Visualize 4-cliques in the network

## ----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 = F)   # Visualize 5-cliques in the network

## --------------------------------------------------------------------------------
summary(model_scaled)

## --------------------------------------------------------------------------------
summary(pruned_disparity)

## ----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)

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

## --------------------------------------------------------------------------------
# Print the hub and authority scores to view influential nodes
print(hub_scores)
print(authority_scores)

## ----fig.align='center', fig.width=5, fig.height=5-------------------------------
edge_between <- betweenness_network(model_scaled)
plot(edge_between)

## ----fig.align='center', fig.width=5, fig.height=5-------------------------------
detected_communities <- communities(model_scaled)
plot(detected_communities, minimum = 0.05)
print(detected_communities)

## --------------------------------------------------------------------------------
# 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")

## ----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, minimum = 0.01)

## ----fig.width=5, fig.height=3---------------------------------------------------
Centrality_stability <- estimate_centrality_stability(model_scaled, detailed = FALSE, iter = 100)
plot(Centrality_stability)