Urbino`s University - Computing and digital innovation - Social Network Analysis

The Atlas for the Aspiring Network Scientist exercises in R

The exercises collected in this repository has been taken from:

👉 Book's pages

I've just converted the PDF document into images to extract the book's cover for reporting the book's link. Since I had all the images available, I've decided to upload all of them to the repository and display them ¯_(ツ)/¯_ You're a hero for having arrived at reading this text ᕙ( •̀ ᗜ •́ )ᕗ

⚠️ Libraries installed to solve the exercises

install.packages("here")
install.packages("e1071")
install.packages("entropy")
install.packages("igraph")
install.packages("poweRlaw")
install.packages("BiocManager")
BiocManager::install("RBGL")
install.packages("RColorBrewer")
install.packages("infotheo")
install.packages("caret")
install.packages("yardstick")
install.packages("pROC")
install.packages("PRROC")
install.packages("Matrix")
install.packages("ggplot2")
install.packages("viridis")
install.packages("biclust")
install.packages("Rtsne")
install.packages("wordVectors")
install.packages("data.table")

📝 Summary of exercises

02.10.1

Problem

    # Suppose you’re tossing two coins at the same time. They’re loaded
    # in different ways, according to the table below. Calculate the
    # probability of getting all possible outcomes:
    
    #p1(H)  p2(H) | H-H  H-T  T-H  T-T
    #---------------------------------
    # 0.5    0.5  |
    # 0.6    0.7  |
    # 0.4    0.8  |
    # 0.1    0.2  |
    # 0.3    0.4  |
    
    library(here)
    
    # Matrix creation
    
    mat <- matrix(NA, nrow = 5, ncol = 6, 
                  dimnames = list(NULL, c("p1(H)", "p2(H)", "H-H", "H-T", "T-H", "T-T")))
    
    mat[1, ] <- c(0.5, 0.5, NA, NA, NA, NA)
    mat[2, ] <- c(0.6, 0.7, NA, NA, NA, NA)
    mat[3, ] <- c(0.4, 0.8, NA, NA, NA, NA)
    mat[4, ] <- c(0.1, 0.2, NA, NA, NA, NA)
    mat[5, ] <- c(0.3, 0.4, NA, NA, NA, NA)
    
    # Write here the solution 
    
    print(mat)

Solution

    # Suppose you’re tossing two coins at the same time. They’re loaded
    # in different ways, according to the table below. Calculate the
    # probability of getting all possible outcomes:
    
    #p1(H)  p2(H) | H-H  H-T  T-H  T-T
    #---------------------------------
    # 0.5    0.5  |
    # 0.6    0.7  |
    # 0.4    0.8  |
    # 0.1    0.2  |
    # 0.3    0.4  |
    
    library(here)
    
    # Matrix creation
    
    mat <- matrix(NA, nrow = 5, ncol = 6, 
                  dimnames = list(NULL, c("p1(H)", "p2(H)", "H-H", "H-T", "T-H", "T-T")))
    
    mat[1, ] <- c(0.5, 0.5, NA, NA, NA, NA)
    mat[2, ] <- c(0.6, 0.7, NA, NA, NA, NA)
    mat[3, ] <- c(0.4, 0.8, NA, NA, NA, NA)
    mat[4, ] <- c(0.1, 0.2, NA, NA, NA, NA)
    mat[5, ] <- c(0.3, 0.4, NA, NA, NA, NA)
    
    # Solution -> Using the formula:  P ( A ∩ B ) = P ( A ) ⋅ P ( B ) 
    
    for (r in 1:nrow(mat)) {
      mat[r,3] <- mat[r,1] * mat[r,2]
      mat[r,4] <- mat[r,2] * (1 - mat[r,2])
      mat[r,5] <- (1 - mat[r,1]) * mat[r,2]
      mat[r,6] <- (1 - mat[r,1]) * (1 - mat[r,2])
    }
    
    print(mat)

02.10.2

Problem

    # 60% of the emails hitting my inbox is spam. You design a phenomenal
    #spam filter which is able to tell me, with 98% accuracy,
    #whether an email is spam or not: if an email is not spam, the system
    #has a 98% probability of saying so. The filter knows 60% of
    #emails are spam and so it will flag 60% of my emails. Suppose
    #that, at the end of the week, I look in my spam box and see 963
    #emails. Use Bayes’ Theorem to calculate how many of those 963
    #emails in my spam box I should suspect to be non-spam.
    
    library(here)
    
    percent <- function(percentValue, value) {
      return((percentValue / 100) * value)
    }
    
    totMails <- 963
    spamPercent <- 60
    filterAccuracyPercent <- 98
    
    # Write here the solution

Solution

    # 60% of the emails hitting my inbox is spam. You design a phenomenal
    #spam filter which is able to tell me, with 98% accuracy,
    #whether an email is spam or not: if an email is not spam, the system
    #has a 98% probability of saying so. The filter knows 60% of
    #emails are spam and so it will flag 60% of my emails. Suppose
    #that, at the end of the week, I look in my spam box and see 963
    #emails. Use Bayes’ Theorem to calculate how many of those 963
    #emails in my spam box I should suspect to be non-spam.
    
    library(here)
    
    percent <- function(percentValue, value) {
      return((percentValue / 100) * value)
    }
    
    totMails <- 963
    spamPercent <- 60 / 100
    filterAccuracyPercent <- 98 / 100
    
    # Solution applying Bayes’ Theorem 
    
    # P(A|B) = P(B|A) * P(A)
    #          -------------
    #               P(B)
    
    # Where P(B|A)
    PBA <- 1 - (98 / 100)
    
    # Where P(A)
    PA <- 40 / 100
    
    # Where P(B) (applying the law of total probability)
    PB <- (((60 / 100) * (98 / 100)) + ((1 - (98 / 100)) * (1 - (60 / 100))))
    
    # Total probability
    TB <- PBA * PA / PB
    
    legitMailsInSpam <- signif((963 * TB), 2)
    
    print(legitMailsInSpam)

02.10.3

Problem

    #You’re given the string: “OCZ XJMMZXO VINRZM”. Each letter
    #follows a stochastic Markov process with the rules expressed by
    #the table at http://www.networkatlas.eu/exercises/2/3/data.
    #txt. Follow the process for three steps and reconstruct the correct
    #answer. (Note, this is a Caesar cipher12 with shift 7 applied three
    #times, because the Caesar cipher is a Markov process).
    
    library(here)
    
    text <- "OCZ XJMMZXO VINRZM"
    data <- readLines(here("data.txt"))
    
    # removing the first line
    data <- data[-1]
    
    # removing "/t"
    data <- sapply(data, function(line) gsub("\t", "", line))
    
    # Write here the solution

Solution

    #You’re given the string: “OCZ XJMMZXO VINRZM”. Each letter
    #follows a stochastic Markov process with the rules expressed by
    #the table at http://www.networkatlas.eu/exercises/2/3/data.
    #txt. Follow the process for three steps and reconstruct the correct
    #answer. (Note, this is a Caesar cipher12 with shift 7 applied three
    #times, because the Caesar cipher is a Markov process).
    
    library(here)
    
    text <- "OCZ XJMMZXO VINRZM"
    data <- readLines(here("data.txt"))
    
    # removing the first line
    data <- data[-1]
    
    # removing "/t"
    data <- sapply(data, function(line) gsub("\t", "", line))
    
    # Solution
    
    # separating the char in the strings for text
    text <- strsplit(text, "")[[1]]
    
    # It is possible to ignore the data because the exercise tells that 
    # every letter (from the international alphabet) is shifted 7 * 3 positions forward, 
    # considering a circular alphabet.
    # Given that the alphabet consists of 26 letters, and the total shift is 21, 
    # we only need to shift 5 positions forward to interpret the text.
    
    # creating the alphabet
    alphabet <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", 
                  "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    
    # creating a function to decrypt from the alphabet
    Decrypt <- function(letter){
      index <- which(alphabet == letter)
      newIndex <- index + 5
      if(newIndex > 26){
        return(alphabet[newIndex - 26])
      }else{
        return(alphabet[newIndex])
      }
    }
    
    # initialing the solution variable
    solutionText <- ""
    
    # Decryption 
    for(l in text){
      if(l == " "){
        solutionText <- paste(solutionText, " ")
      }else{
        solutionText <- paste(solutionText, Decrypt(l))
      }
    }
    
    # print the solution 
    print(solutionText)

02.10.4

Problem

    # Suppose that we are examining a painting and we’re trying to
    # date it with the century when it was produced. Find out the Belief
    # and Plausibility values for all hypotheses given the following Mass
    # estimation (note that, by definition Ω = {XIV, XV, XVI} must have
    # Belief and Plausibility equal to one):
    #
    # Hypothesis  |  Mass    Belief    Plausibility
    # ---------------------------------------------
    #     ∅       |  0.00
    #    XIV      |  0.16 
    #    XV       |  0.04
    #    XVI      |  0.21
    # {XIV, XV}   |  0.34
    # {XV, XVI}   |  0.16
    # {XIV, XVI}  |  0.08
    #     Ω       |  0.01     1            1 
    
    library(here)
    
    
    # Matrix creation
    
    mat <- matrix(NA, nrow = 8, ncol = 4, 
                  dimnames = list(NULL, c("Hypothesis", "Mass", "Belief", "Plausibility")))
    
    mat[1, ] <- c("∅", 0.00, NA, NA)
    mat[2, ] <- c("XIV", 0.16, NA, NA)
    mat[3, ] <- c("XV", 0.04, NA, NA)
    mat[4, ] <- c("XVI", 0.21, NA, NA)
    mat[5, ] <- c("{XIV, XV}", 0.34, NA, NA)
    mat[6, ] <- c("{XV, XVI}", 0.16, NA, NA)
    mat[7, ] <- c("{XIV, XVI}", 0.08, NA, NA)
    mat[8, ] <- c("Ω", 0.01, 1, 1)
    
    
    # write here the solution 
    
    print(mat)

Solution

    # Suppose that we are examining a painting and we’re trying to
    # date it with the century when it was produced. Find out the Belief
    # and Plausibility values for all hypotheses given the following Mass
    # estimation (note that, by definition Ω = {XIV, XV, XVI} must have
    # Belief and Plausibility equal to one):
    #
    # Hypothesis  |  Mass    Belief    Plausibility
    # ---------------------------------------------
    #     ∅       |  0.00
    #    XIV      |  0.16 
    #    XV       |  0.04
    #    XVI      |  0.21
    # {XIV, XV}   |  0.34
    # {XV, XVI}   |  0.16
    # {XIV, XVI}  |  0.08
    #     Ω       |  0.01     1            1 
    
    library(here)
    
    
    # Matrix creation
    
    mat <- matrix(NA, nrow = 8, ncol = 4, 
                  dimnames = list(NULL, c("Hypothesis", "Mass", "Belief", "Plausibility")))
    
    mat[1, ] <- c("∅", 0.00, NA, NA)
    mat[2, ] <- c("XIV", 0.16, NA, NA)
    mat[3, ] <- c("XV", 0.04, NA, NA)
    mat[4, ] <- c("XVI", 0.21, NA, NA)
    mat[5, ] <- c("{XIV, XV}", 0.34, NA, NA)
    mat[6, ] <- c("{XV, XVI}", 0.16, NA, NA)
    mat[7, ] <- c("{XIV, XVI}", 0.08, NA, NA)
    mat[8, ] <- c("Ω", 0.01, 1, 1)
    
    
    # To calculate the Belief is necessary sum all masses of subsets contained in 
    #the hypothesis.
    
    # To calculate the Plausibility is necessary sum all masses of subsets that have 
    # a non-empty intersection with the hypothesis.
    
    # Calculating the Belief
    
    mat[1,3] <- mat[1,2]
    mat[2,3] <- mat[2,2]
    mat[3,3] <- mat[3,2]
    mat[4,3] <- mat[4,2]
    mat[5,3] <- as.numeric(mat[2,2]) + as.numeric(mat[3,2]) + as.numeric(mat[5,2])
    mat[6,3] <- as.numeric(mat[3,2]) + as.numeric(mat[4,2]) + as.numeric(mat[6,2])
    mat[7,3] <- as.numeric(mat[2,2]) + as.numeric(mat[4,2]) + as.numeric(mat[7,2])
    
    # Calculating the Plausibility
    
    mat[1,4] <- mat[1,3]
    mat[2,4] <- as.numeric(mat[2,2]) + as.numeric(mat[5,2]) + as.numeric(mat[7,2]) + as.numeric(mat[8,2])
    mat[3,4] <- as.numeric(mat[3,2]) + as.numeric(mat[5,2]) + as.numeric(mat[6,2]) + as.numeric(mat[8,2])
    mat[4,4] <- as.numeric(mat[4,2]) + as.numeric(mat[6,2]) + as.numeric(mat[7,2]) + as.numeric(mat[8,2])
    mat[5,4] <- as.numeric(mat[2,2]) + as.numeric(mat[3,2]) + as.numeric(mat[5,2]) +  as.numeric(mat[6,2]) + as.numeric(mat[7,2]) + as.numeric(mat[8,2])
    mat[6,4] <- as.numeric(mat[3,2]) + as.numeric(mat[4,2]) + as.numeric(mat[5,2]) +  as.numeric(mat[6,2]) + as.numeric(mat[7,2]) + as.numeric(mat[8,2])
    mat[7,4] <- as.numeric(mat[2,2]) + as.numeric(mat[4,2]) + as.numeric(mat[5,2]) +  as.numeric(mat[6,2]) + as.numeric(mat[7,2]) + as.numeric(mat[8,2])
    
    print(mat)

03.7.1

Problem

    #Calculate the mean, median, and standard deviation of the two
    #variables at http://www.networkatlas.eu/exercises/3/1/data.
    #txt (one variable per column).
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # write here the solution

Solution

    #Calculate the mean, median, and standard deviation of the two
    #variables at http://www.networkatlas.eu/exercises/3/1/data.
    #txt (one variable per column).
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Calculating the mean
    meanX <- mean(data$x)
    meanY <- mean(data$y)
    
    # Calculating the median 
    medianX <- median(data$x)
    medianY <- median(data$y)
    
    # Calculating the standard deviation
    SDX <- sd(data$x)
    SDY <- sd(data$y)
    
    # Print the results
    
    print(meanX)
    print(meanY)
    print(medianX)
    print(medianY)
    print(SDX)
    print(SDY)

03.7.2

Problem

    # Make a scatter plot of the variables used in the previous exercise
    # – with one variable on the x axis and the other on the y axis. Do
    # you think that they are skewed or not? Calculate their skewness to
    # motivate your answer.
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # write here the solution

Solution

    # Make a scatter plot of the variables used in the previous exercise
    # – with one variable on the x axis and the other on the y axis. Do
    # you think that they are skewed or not? Calculate their skewness to
    # motivate your answer.
    
    library(here)
    library(e1071)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Solution
    
    # writing the plot 
    plot(data$x, data$y, 
         main = "Scatter Plot", 
         xlab = "X Values", 
         ylab = "Y Values", 
         pch = 19,      # Solid circle points
         col = "blue")  # Point color
    
    # Calculating the skewness
    skewX <- skewness(data$x)
    skewY <- skewness(data$y)
    
    print(skewX)
    print(skewY)
    
    # skewX = 1.817525
    # skewY = 3.984962
    # The variables are skewed because their distribution is is right-skewed

03.7.3

Problem

    #Draw the mass function and the cumulative distribution of the
    #following outcome probabilities:
    
    #  Outcome  |    p
    #  ----------------
    #    1      |    0.1
    #    2      |    0.15
    #    3      |    0.2
    #    4      |    0.21
    #    5      |    0.17
    #    6      |    0.09
    #    7      |    0.06
    #    8      |    0.02
    
    Outcome <- 1:8
    p <- c(0.1, 0.15, 0.2, 0.21, 0.17, 0.09, 0.06, 0.02)
    
    # Write here the solution

Solution

    #Draw the mass function and the cumulative distribution of the
    #following outcome probabilities:
    
    #  Outcome  |    P
    #  ----------------
    #    1      |    0.1
    #    2      |    0.15
    #    3      |    0.2
    #    4      |    0.21
    #    5      |    0.17
    #    6      |    0.09
    #    7      |    0.06
    #    8      |    0.02
    
    Outcome <- 1:8
    P <- c(0.1, 0.15, 0.2, 0.21, 0.17, 0.09, 0.06, 0.02)
    
    # Solution
    
    # Drawing the mass function 
    barplot(P, names.arg = Outcome, 
            xlab = "Outcome", 
            ylab = "Probability", 
            main = "Mass Function",
            col = "blue")
    
    # Drawing the cumulative distribution
    
    # Calculate the cumulative distribution 
    cum_p <- cumsum(p)
    
    # Draw the graph
    plot(Outcome, cum_p, type = "s", 
         xlab = "Outcome", 
         ylab = "Cumulative Probability", 
         main = "Cumulative Distribution Function",
         col = "blue", lwd = 2)
    points(Outcome, cum_p, pch = 19, col = "red")

03.7.4

Problem

    # Which correlation coefficient should you use to calculate the corre-
    # lation between the variables used in the exercise 2? Motivate your
    # answer by calculating covariance, and the Pearson and Spearman
    #correlation coefficients (and their p-values). Does the Spearman
    # correlation coefficient agree with the Pearson correlation calculated
    # on log-transformed values?
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Write here the solution

Solution

    # Which correlation coefficient should you use to calculate the corre-
    # lation between the variables used in the exercise 2? Motivate your
    # answer by calculating covariance, and the Pearson and Spearman
    #correlation coefficients (and their p-values). Does the Spearman
    # correlation coefficient agree with the Pearson correlation calculated
    # on log-transformed values?
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Solution
    
    # Calculating the covariance
    covariance <- cov(data$x, data$y)
    cat("Covariance: ", covariance, "\n") # 673232178181
    
    # Calculating the Pearson correlation
    pearson <- cor.test(data$x, data$y, method = "pearson")
    cat("Pearson's correlation coefficient: ", pearson$estimate, "\n") # 0.4437232
    cat("Pearson's p-value: ", pearson$p.value, "\n") # 0.003246258
    
    # Calculating the Spearman correlation
    spearman <- cor.test(data$x, data$y, method = "spearman")
    cat("Spearman's correlation coefficient: ", spearman$estimate, "\n")# 0.7392432
    cat("Spearman's p-value: ", spearman$p.value, "\n")# 1.723284e-07 
    
    # Pearson is not preferable because the data is highly skewed so the Spearman is 
    # best the correlation coefficient
    
    # Pearson on log-transformed values
    log_x <- log(data$x)
    log_y <- log(data$y)
    
    pearson_log <- cor.test(log_x, log_y, method = "pearson")
    cat("Pearson's correlation on log-transformed values:", pearson_log$estimate, "p-value:", pearson_log$p.value, "\n")# 0.8280876 - 1.323059e-11
    
    # The Spearman correlation coefficient agree with the Pearson correlation because the values are close

03.7.5

Problem

    # How many bits do we need to independently encode v1 and v2
    # from http://www.networkatlas.eu/exercises/3/5/data.txt?
    # How much would we save in encoding v1 if we knew v2 ?
    
    library(here)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Write here the solution

Solution

    # How many bits do we need to independently encode v1 and v2
    # from http://www.networkatlas.eu/exercises/3/5/data.txt?
    # How much would we save in encoding v1 if we knew v2 ?
    
    library(here)
    library(entropy)
    
    data <- read.table("data.txt", header = TRUE)
    
    # Solution
    
    # Calculating the entropy of v1 & v2 
    
    # Function to compute entropy for a vector
    get_entropy <- function(vec) {
      tab <- table(vec)
      probs <- tab / sum(tab)
      entropy.empirical(probs, unit = "log2")
    }
    
    H_v1 <- get_entropy(data$v1)
    
    cat("Entropy of v1:", H_v1, "bits\n")
    
    # Calculating the conditional entropy of v1 & v2 
    get_conditional_entropy <- function(x, y) {
      tab <- table(x, y)
      joint_probs <- tab / sum(tab)
      cond_entropy <- 0
      for (j in 1:ncol(tab)) {
        p_y <- sum(joint_probs[, j])
        if (p_y > 0) {
          cond_entropy <- cond_entropy + p_y * entropy.empirical(joint_probs[, j] / p_y, unit = "log2")
        }
      }
      return(cond_entropy)
    }
    
    H_v1_given_v2 <- get_conditional_entropy(data$v1, data$v2)
    cat("Conditional entropy H(v1|v2):", H_v1_given_v2, "bits\n")
    
    # Calculating the bits saved
    bits_saved <- H_v1 - H_v1_given_v2
    cat("Bits saved in encoding v1 if v2 is known:", bits_saved, "bits\n")

04.6.1

Problem

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Imple-
    # ment the softmax function. Plot the result with the original vector
    # on the x axis and the softmax output on the y axis.
    
    library(here)
    set.seed(42)
    
    # Write here the solution

Solution

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Imple-
    # ment the softmax function. Plot the result with the original vector
    # on the x axis and the softmax output on the y axis.
    
    library(here)
    set.seed(42)
    
    # Solution
    
    # Generating the vector 
    x <- rnorm(100, mean = 0, sd = 1)
    
    # Implementing softmax function
    softmax <- function(z) {
      exp_z <- exp(z - max(z)) # For numerical stability
      exp_z / sum(exp_z)
    }
    
    y <- softmax(x)
    
    # Drawing the results.
    plot(x, y, 
         main = "Softmax Output vs Original Vector", 
         xlab = "Original Values", 
         ylab = "Softmax Output", 
         pch = 19, col = "blue")

04.6.2

Problem

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Imple-
    # ment the ReLU function. Plot the result with the original vector on
    # the x axis and the ReLU output on the y axis.
    
    library(here)
    set.seed(42)
    
    # Write here the solution

Solution

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Imple-
    # ment the ReLU function. Plot the result with the original vector on
    # the x axis and the ReLU output on the y axis.
    
    library(here)
    set.seed(42)
    
    # Solution
    
    # Generating the vector 
    x <- rnorm(100, mean = 0, sd = 1)
    
    # Implementing the ReLu function
    relu <- function(z) {
      pmax(0, z)
    }
    
    y <- relu(x)
    
    # Drawing the result 
    plot(x, y,
         main = "ReLU Output vs Original Vector",
         xlab = "Original Values",
         ylab = "ReLU Output",
         pch = 19, col = "blue")

04.6.3

Problem

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Implement the MAE and 
    # MSE functions and compare their outputs when applied to the vector, by plotting 
    # each of them.
    
    library(here)
    set.seed(42)
    
    # Write here the solution

Solution

    # Generate a random vector with 100 normally distributed random
    # values (with zero average and standard deviation of one). Implement the MAE and 
    # MSE functions and compare their outputs when applied to the vector, by plotting 
    # each of them.
    
    library(here)
    set.seed(42)
    
    # Solution
    
    # Generating the vector
    x <- rnorm(100, mean = 0, sd = 1)
    
    # Implementing MAE function 
    mae <- function(vec) {
      mean(abs(vec))
    }
    
    # Implementing MSE function 
    mse <- function(vec) {
      mean(vec^2)
    }
    
    # Calculating the result
    maey <- mae(x)
    msey <- mse(x)
    
    # Drawing the plots
    barplot(
      c(MAE = maey, MSE = msey),
      main = "Confronto tra MAE e MSE",
      ylab = "Valore dell'errore",
      col = c("blue", "red")
    )

04.6.4

Problem

    # Plot the likelihood function for p H and p T for the events { H, H, T, H, T }.
    
    library(here)
    
    seq <- c("H", "H", "T", "H", "T")
    
    # Write here the solution

Solution

    # Plot the likelihood function for p H and p T for the events { H, H, T, H, T }.
    
    library(here)
    
    seqEvents <- c("H", "H", "T", "H", "T")
    
    # Solution
    
    # Counting the number of two kind of events
    numberH <- sum(seqEvents == "H")
    numberT <- sum(seqEvents == "T")
    
    # Defining a sequence of probabilities for H
    probabilityH <- seq(0, 1, length.out = 100)
    
    # Likelihood function (ignoring constant binomial coefficient)
    likelihood <- probabilityH^numberH * (1 - probabilityH)^numberT
    
    # Writing the plot
    plot(probabilityH, likelihood, type = "l", lwd = 2, col = "blue",
         xlab = "probabilityH (probability of heads)",
         ylab = "Likelihood",
         main = "Likelihood Function for p_H")
    abline(v = numberH / (numberH + numberT), col = "red", lty = 2) # Maximum Likelihood Estimate
    legend("topright", legend = "MLE", lty = 2, col = "red")

05.8.1

Problem

    # What is the length of the vector you obtain by summing [0, 4] to
    # [5, 1]?
    
    library(here)
    
    a <- c(0, 4)
    b <- c(5, 1)
    
    # Write here the solution

Solution

    # What is the length of the vector you obtain by summing [0, 4] to
    # [5, 1]?
    
    library(here)
    
    a <- c(0, 4)
    b <- c(5, 1)
    
    # Solution
    
    result <- a + b
    print(length(result))

05.8.2

Problem

    # Suppose:
    #
    #  A=(1 0)
    #     0 2
    #
    #  B=(3 0)
    #     0 -1
    #
    #  Are these two transformations commutative? Does applying A
    #  first and B second lead to the same transformation as applying B
    #  first and A second?
    
    library(here)
    
    # Defining the matrices
    A <- matrix(c(1, 0, 0, 2), nrow = 2, byrow = TRUE)
    B <- matrix(c(3, 0, 0, -1), nrow = 2, byrow = TRUE)
    
    # Write here the solution

Solution

    # Suppose:
    #
    #  A=(1 0)
    #     0 2
    #
    #  B=(3 0)
    #     0 -1
    #
    #  Are these two transformations commutative? Does applying A
    #  first and B second lead to the same transformation as applying B
    #  first and A second?
    
    library(here)
    
    # Defining the matrices
    A <- matrix(c(1, 0, 0, 2), nrow = 2, byrow = TRUE)
    B <- matrix(c(3, 0, 0, -1), nrow = 2, byrow = TRUE)
    
    # Solution
    
    # Computing A * B and B * A (matrix multiplication)
    AB <- A %*% B
    BA <- B %*% A
    
    # Print the results
    cat("A %*% B = ", AB, "\n")
    cat("B %*% A = ", BA, "\n")
    
    # Are they equal?
    cat("Are A and B commutative? ", all(AB == BA), "\n")

05.8.3

Problem

    # Calculate the eigenvalues and the right and left eigenvectors of
    # the matrix from http://www.networkatlas.eu/exercises/5/3/
    # data.txt. Make sure to sort the eigenvalues in descending order
    # (and sort the eigenvectors accordingly). Only take the real part of
    # eigenvalues and eigenvectors, ignoring the imaginary part.
    
    library(here)
    
    mat <- as.matrix(read.table("data.txt"))
    
    # Write here the solution

Solution

    # Calculate the eigenvalues and the right and left eigenvectors of
    # the matrix from http://www.networkatlas.eu/exercises/5/3/
    # data.txt. Make sure to sort the eigenvalues in descending order
    # (and sort the eigenvectors accordingly). Only take the real part of
    # eigenvalues and eigenvectors, ignoring the imaginary part.
    
    library(here)
    
    mat <- as.matrix(read.table("data.txt"))
    
    # Solution
    
    # Calculating eigenvalues and right eigenvectors (Right eigenvectors are in eig$vectors)
    eig_right <- eigen(mat)
    
    # Calculating left eigenvectors: eigenvectors of the transposed matrix (Left eigenvectors are in eig_left$vectors)
    eig_left <- eigen(t(mat))
    
    # Taking only the real parts
    eigvals <- Re(eig_right$values)
    eigvecs_right <- Re(eig_right$vectors)
    eigvecs_left  <- Re(eig_left$vectors)
    
    # Getting sorting order
    ord <- order(eigvals, decreasing = TRUE)
    eigvals_sorted <- eigvals[ord]
    eigvecs_right_sorted <- eigvecs_right[, ord]
    eigvecs_left_sorted  <- eigvecs_left[, ord]
    
    # printing the results 
    cat("Eigenvalues (sorted):\n")
    print(eigvals_sorted)
    
    cat("\nRight eigenvectors (columns):\n")
    print(eigvecs_right_sorted)
    
    cat("\nLeft eigenvectors (columns):\n")
    print(eigvecs_left_sorted)

05.8.4

Problem

    # Perform the eigendecompositions of the matrices from exercise 2,
    # showing that you can reconstruct the originals from their eigenval-
    # ues and eigenvectors.
    
    # Matrices:
    #
    #  A=(1 0)
    #     0 2
    #
    #  B=(3 0)
    #     0 -1
    
    library(here) 
    
    # Defining the matrices
    A <- matrix(c(1, 0, 0, 2), nrow = 2, byrow = TRUE)
    B <- matrix(c(3, 0, 0, -1), nrow = 2, byrow = TRUE)
    
    # Write here the solution

Solution

    # Perform the eigendecompositions of the matrices from exercise 2,
    # showing that you can reconstruct the originals from their eigenval-
    # ues and eigenvectors.
    
    # Matrices:
    #
    #  A=(1 0)
    #     0 2
    #
    #  B=(3 0)
    #     0 -1
    
    library(here) 
    
    # Defining the matrices
    A <- matrix(c(1, 0, 0, 2), nrow = 2, byrow = TRUE)
    B <- matrix(c(3, 0, 0, -1), nrow = 2, byrow = TRUE)
    
    # Solution
    
    # Eigendecomposition for A
    eig_A <- eigen(A)
    V_A <- eig_A$vectors        # Eigenvectors matrix
    D_A <- diag(eig_A$values)   # Diagonal matrix of eigenvalues
    
    # Reconstructing A
    A_reconstructed <- V_A %*% D_A %*% solve(V_A)
    
    # Eigendecomposition for B
    eig_B <- eigen(B)
    V_B <- eig_B$vectors
    D_B <- diag(eig_B$values)
    
    # Reconstructing B
    B_reconstructed <- V_B %*% D_B %*% solve(V_B)
    
    # Printing results
    cat("Original A:\n") print(A)
    cat("Reconstructed A:\n"); print(A_reconstructed)
    
    cat("\nOriginal B:\n"); print(B)
    cat("Reconstructed B:\n"); print(B_reconstructed)

06.6.1

Problem

    # Calculate |V | and | E| for the graph in Figure 6.1(c).
    
    library(here)
    library(igraph)
    
    # Defining the graph
    
    # Let's label the nodes as 1, 2, 3, 4, 5
    # Creating edges
    edges <- c(1,2, 1,3, 1,4, 2,3, 3,4, 3,5)
    
    # Creating the graph
    g <- graph(edges=edges, n=5, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate |V | and | E| for the graph in Figure 6.1(c).
    
    library(here)
    library(igraph)
    
    # Solution
    
    # Defining the graph
    
    # Let's label the nodes as 1, 2, 3, 4, 5
    # Creating edges
    edges <- c(1,2, 1,3, 2,4, 3,4, 4,5)
    
    # Creating the graph
    g <- graph(edges=edges, n=5, directed=FALSE)
    
    # Solution
    
    # Calculate |V| and |E|
    num_vertices <- vcount(g)
    num_edges <- ecount(g)
    
    # Printing the results
    cat("|V| (number of nodes):", num_vertices, "\n")
    cat("|E| (number of edges):", num_edges, "\n")
    
    # Drawing the graph's plot (optional)
    plot(g, 
         vertex.size=30, 
         vertex.color="red", 
         vertex.label=V(g),
         edge.width=3,
         main="Graph from Figure 6.1(c)",
         layout=layout_in_circle)

06.6.2

Problem

    # Mr. A considers Ms. B a friend, but she doesn’t like him back. She
    # has a reciprocal friendship with both C and D, but only C con-
    # siders D a friend. D has also sent friend requests to E, F, G, and
    # H but, so far, only G replied. G also has a reciprocal relationship
    # with A. Draw the corresponding directed graph.
    
    library(here)
    library(igraph)
    
    # Write here the solution

Solution

    # Mr. A considers Ms. B a friend, but she doesn’t like him back. She
    # has a reciprocal friendship with both C and D, but only C con-
    # siders D a friend. D has also sent friend requests to E, F, G, and
    # H but, so far, only G replied. G also has a reciprocal relationship
    # with A. Draw the corresponding directed graph.
    
    library(here)
    library(igraph)
    
    # Solution
    
    # Creating edges
    edges <- c(
      "A", "B",
      "A", "G",
      "B", "C",
      "B", "D",
      "C", "B",
      "C", "D",
      "D", "B",
      "D", "E",
      "D", "F",
      "D", "G",
      "D", "H",
      "G", "D",
      "G", "A"
    )
    
    # Creating the directed graph
    g <- make_graph(edges = edges, directed = TRUE)
    
    # Drawing the graph's plot
    plot(
      g,
      vertex.size = 35,
      vertex.color = "red",
      vertex.label.cex = 1.2,
      edge.arrow.size = 0.7,
      main = "Friendship Directed Graph"
    )

06.6.3

Problem

    # Draw the previous graph as undirected and weighted, with the
    # weight being 2 if the connection is reciprocal, 1 otherwise.
    
    library(here)
    library(igraph)
    
    # Write here the solution

Solution

    # Draw the previous graph as undirected and weighted, with the
    # weight being 2 if the connection is reciprocal, 1 otherwise.
    
    library(here)
    library(igraph)
    
    # Solution 
    
    # Defining the edges
    edges <- c(
      "A", "B",
      "A", "G",
      "B", "C",
      "B", "D",
      "C", "D",
      "D", "E",
      "D", "F",
      "D", "G",
      "D", "H"
    )
    
    # Defining the weights
    weights <- c(
      1,  # A-B
      2,  # A-G
      2,  # B-C
      2,  # B-D
      1,  # C-D
      1,  # D-E
      1,  # D-F
      2,  # D-G
      1   # D-H
    )
    
    # Creating the undirected graph with weights
    g <- graph(edges=edges, directed=FALSE)
    E(g)$weight <- weights
    
    # Drawing the graph's plot
    plot(
      g,
      vertex.size = 35,
      vertex.color = "red",
      vertex.label.cex = 1.2,
      edge.width = E(g)$weight*1.5,
      edge.label = E(g)$weight,
      edge.label.cex = 1.2,
      main = "Friendship Network (undirected, weighted)"
    )

06.6.4

Problem

    # Draw a correlation network for the vectors in http://www.networkatlas.
    # eu/exercises/6/4/data.txt, by only drawing edges with positive
    # weights, ignoring self loops.
    
    library(here)
    library(igraph)
    
    # reading the data
    dat <- read.table("data.txt", header=TRUE)
    
    # Write here the solution

Solution

    # Draw a correlation network for the vectors in http://www.networkatlas.
    # eu/exercises/6/4/data.txt, by only drawing edges with positive
    # weights, ignoring self loops.
    
    library(here)
    library(igraph)
    
    # reading the data
    dat <- read.table("data.txt", header=TRUE)
    
    # Computing the correlation matrix
    corr <- cor(dat)
    
    # Getting indices for upper triangle (to prevent duplicates and ignore self-loops)
    edge_list <- which(corr > 0 & upper.tri(corr), arr.ind = TRUE)
    
    # Extracting the edge pairs and weights
    edges <- data.frame(
      from = colnames(corr)[edge_list[,1]],
      to   = colnames(corr)[edge_list[,2]],
      weight = corr[edge_list]
    )
    
    # Creating the graph
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    # Drawing the graph's plot
    plot(
      g,
      edge.width = edges$weight * 5,      # Make edge width proportional, tweak multiplier for visibility
      edge.label = round(edges$weight,2), # Show rounded correlation values as labels
      vertex.label.cex = 1.2,
      vertex.size = 30,
      vertex.color = "red",
      main = "Correlation Network (Positive Correlations Only)"
    )

07.7.1

Problem

    # The network in http://www.networkatlas.eu/exercises/7/1/
    # data.txt is bipartite. Identify the nodes in either type and find the
    # nodes, in either type, with the most neighbors.
    
    library(here)
    library(igraph)
    
    # Reading data 
    edges <- read.table("data.txt", header=FALSE)
    
    # Write here the solution

Solution

    # The network in http://www.networkatlas.eu/exercises/7/1/
    # data.txt is bipartite. Identify the nodes in either type and find the
    # nodes, in either type, with the most neighbors.
    
    library(here)
    library(igraph)
    
    # Reading data 
    edges <- read.table("data.txt", header=FALSE)
    
    # Solution
    
    # Generating the graph 
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Identifying bipartite types
    # Simple approach: nodes in the first column are one type, second column are the other type.
    type1 <- unique(edges$V1)
    type2 <- unique(edges$V2)
    
    #Finding degree (number of neighbors)
    deg <- degree(g)
    
    # Finding nodes with maximum degree
    max_deg <- max(deg)
    most_connected_nodes <- names(deg)[deg == max_deg]
    
    # Printing the results
    cat("Type 1 nodes:\n")
    print(type1)
    cat("\nType 2 nodes:\n")
    print(type2)
    cat("\nNode(s) with most neighbors:\n")
    print(most_connected_nodes)
    cat("Number of neighbors:", max_deg, "\n")
    
    # Seeing which type the most connected node(s) belong to
    for (node in most_connected_nodes) {
      if (node %in% type1) {
        cat(node, "is Type 1\n")
      } else if (node %in% type2) {
        cat(node, "is Type 2\n")
      }
    }

07.7.2

Problem

    # The network in http://www.networkatlas.eu/exercises/7/2/
    # data.txt is multilayer. The data has three columns: source and
    # target node, and edge type. The edge type is either the numerical
    # id of the layer, or “C” for an inter-layer coupling. Given that this is
    # a one-to-one multilayer network, determine whether this network
    # has a star, clique or chain coupling.
    
    library(here)
    
    # Reading the data
    data <- read.table("data.txt", header = FALSE, stringsAsFactors = FALSE)
    colnames(data) <- c("source", "target", "type")
    
    # Write here the solution

Solution

    # The network in http://www.networkatlas.eu/exercises/7/2/
    # data.txt is multilayer. The data has three columns: source and
    # target node, and edge type. The edge type is either the numerical
    # id of the layer, or “C” for an inter-layer coupling. Given that this is
    # a one-to-one multilayer network, determine whether this network
    # has a star, clique or chain coupling.
    
    library(here)
    
    # Reading the data
    data <- read.table("data.txt", header = FALSE, stringsAsFactors = FALSE)
    colnames(data) <- c("source", "target", "type")
    
    # Solution
    
    # Creating the graph
    g <- graph_from_data_frame(data[,c("source","target")], directed=FALSE)
    
    E(g)$color <- ifelse(data$type == "C", "red", "grey")
    E(g)$lty <- ifelse(data$type == "C", 2, 1)
    
    sources_inter <- unique(inter_layer$source)
    targets_inter <- unique(inter_layer$target)
    V(g)$color <- ifelse(V(g)$name %in% sources_inter, "skyblue",
                         ifelse(V(g)$name %in% targets_inter, "palegreen", "white"))
    
    # Plotting with legend below
    
    
    # Plotting the graph, leaving space at the bottom
    plot(
      g,
      vertex.size=30,
      vertex.label.cex=1.2,
      vertex.label.color="black",
      edge.width=2,
      main=sprintf("Multilayer network (%s coupling)", coupling_type),
      margin=0.2
    )
    
    # Addding the legend below the plot
    legend(
      x = "bottom",
      inset = -0.32, # negative inset puts legend below plot, adjust as needed
      legend = c("Intra-layer edge", "Inter-layer coupling", "Source node", "Target node"),
      col = c("grey", "red", "skyblue", "palegreen"),
      pt.cex = c(NA, NA, 2, 2),
      pch = c(NA, NA, 21, 21),
      lty = c(1, 2, NA, NA),
      lwd = c(2, 2, NA, NA),
      bty = "n",
      horiz = TRUE,
      xpd = TRUE # allowing drawing outside plot region
    )

07.7.3

Problem

    # The network in http://www.networkatlas.eu/exercises/7/3/
    # data.txt is a hypergraph, with a hyperedge per line. Transform it
    # in a unipartite network in which each hyperedge is split in edges
    # connecting all nodes in the hyperedge. Then transform it into a
    # bipartite network in which each hyperedge is a node of one type
    # and its nodes connect to it.
    
    library(here)
    #library(igraph)
    
    # Reading the hypergraph data (each line is a hyperedge)
    lines <- readLines("data.txt")
    hyperedges <- lapply(lines, function(x) strsplit(x, "\\s+")[[1]])
    
    # Write here the solution

Solution

    # The network in http://www.networkatlas.eu/exercises/7/3/
    # data.txt is a hypergraph, with a hyperedge per line. Transform it
    # in a unipartite network in which each hyperedge is split in edges
    # connecting all nodes in the hyperedge. Then transform it into a
    # bipartite network in which each hyperedge is a node of one type
    # and its nodes connect to it.
    
    library(here)
    library(igraph)
    
    # Reading the hypergraph data (each line is a hyperedge)
    lines <- readLines("data.txt")
    hyperedges <- lapply(lines, function(x) strsplit(x, "\\s+")[[1]])
    
    # Solution
    
    # Unipartiting network: clique expansion
    get_pairs <- function(nodes) {
      nodes <- as.character(nodes)
      if(length(nodes) < 2) return(NULL)
      t(combn(nodes, 2))
    }
    all_pairs <- do.call(rbind, lapply(hyperedges, get_pairs))
    all_pairs <- unique(all_pairs)
    
    ################################################################################
    # Optional: creating a plot
    
    g_unipartite <- graph_from_edgelist(all_pairs, directed = FALSE)
    
    set.seed(42)
    plot(
      g_unipartite,
      layout = layout_with_fr,
      vertex.size = 25,
      vertex.color = "orange",
      vertex.label.cex = 1.1,
      main = " Hypergraph as Unipartite Network"
    )
    
    ################################################################################
    
    # Building bipartite edge list: hyperedge node -> member node
    bipartite_edges <- data.frame(
      from = rep(paste0("H", seq_along(hyperedges)), sapply(hyperedges, length)),
      to = as.character(unlist(hyperedges))
    )
    
    ################################################################################
    # Optional: creating a plot
    
    g_bipartite <- graph_from_data_frame(bipartite_edges, directed = FALSE)
    V(g_bipartite)$type <- grepl("^H", V(g_bipartite)$name)
    V(g_bipartite)$color <- ifelse(V(g_bipartite)$type, "skyblue", "orange")
    
    # Arranging bipartite layout: hyperedges (H nodes) on top row, other nodes on bottom row
    hyper_nodes <- V(g_bipartite)$name[V(g_bipartite)$type]
    elem_nodes <- V(g_bipartite)$name[!V(g_bipartite)$type]
    
    layout_bipartite <- matrix(NA, nrow = vcount(g_bipartite), ncol = 2)
    layout_bipartite[V(g_bipartite)$type, 1] <- seq_along(hyper_nodes)
    layout_bipartite[V(g_bipartite)$type, 2] <- 1
    layout_bipartite[!V(g_bipartite)$type, 1] <- match(elem_nodes, sort(elem_nodes))
    layout_bipartite[!V(g_bipartite)$type, 2] <- 0
    
    plot(
      g_bipartite,
      layout = layout_bipartite,
      vertex.size = 22,
      vertex.label.cex = 1,
      vertex.color = V(g_bipartite)$color,
      main = "Hypergraph as Bipartite Network"
    )
    legend(
      "topright",
      legend = c("Hyperedge", "Node"),
      col = c("skyblue", "orange"),
      pch = 19,
      pt.cex = 2,
      bty = "n"
    )
    ################################################################################

07.7.4

Problem

    # The network in http://www.networkatlas.eu/exercises/7/4/
    # data.txt is dynamic, the third and fourth columns of the edge
    # list tell you the first and last snapshot in which the edge was
    # continuously present. An edge can reappear if the edge was
    # present in two discontinuous time periods. Aggregate it using a
    # disjoint window of size 3.
    
    library(here)
    #library(igraph)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE)
    colnames(dat) <- c("source", "target", "start", "end")
    
    # Write here the solution

Solution

    # The network in http://www.networkatlas.eu/exercises/7/4/
    # data.txt is dynamic, the third and fourth columns of the edge
    # list tell you the first and last snapshot in which the edge was
    # continuously present. An edge can reappear if the edge was
    # present in two discontinuous time periods. Aggregate it using a
    # disjoint window of size 3.
    
    library(here)
    library(igraph)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE)
    colnames(dat) <- c("source", "target", "start", "end")
    
    # Solution 
    
    # Window settings to aggregate edges
    window_size <- 3
    max_snapshot <- max(dat$end)
    windows <- split(1:max_snapshot, ceiling((1:max_snapshot) / window_size))
    
    # For each window, aggregating the network and plot
    if (!require(igraph)) install.packages("igraph")
    library(igraph)
    
    for (i in seq_along(windows)) {
      wsnap <- windows[[i]]
      wname <- paste0("Snapshots ", min(wsnap), "-", max(wsnap))
      # Selecting edges that are present in at least one snapshot in this window
      present <- dat[
        (dat$start <= max(wsnap)) & (dat$end >= min(wsnap)),
      ]
      cat("\nWindow", i, "(", wname, "):\n")
      print(present[,1:2])
      
    ################################################################################
    # Optional: creating a plot 
      
      if (nrow(present) > 0) {
        g <- graph_from_data_frame(present[,1:2], directed=FALSE)
        plot(g, main=paste("Aggregated network:", wname))
      }
    ################################################################################
    }

08.6.1

Problem

    # Calculate the adjacency matrix, the stochastic adjacency matrix,
    # and the graph Laplacian for the network in http://www.
    # networkatlas.eu/exercises/8/1/data.txt.
    
    library(here)
    library(igraph)
    
    # Loading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    
    # Generating a plot (optional)
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate the adjacency matrix, the stochastic adjacency matrix,
    # and the graph Laplacian for the network in http://www.
    # networkatlas.eu/exercises/8/1/data.txt.
    
    library(here)
    library(igraph)
    
    # Loading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    
    # Generating a plot (optional)
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Solution 
    
    # Calculating the Adjacency matrix
    A <- as.matrix(as_adjacency_matrix(g, sparse=FALSE))
    
    # Calculating the Stochastic adjacency matrix (row-normalized)
    row_sums <- rowSums(A)
    # Avoid division by zero
    row_sums[row_sums == 0] <- 1
    A_stochastic <- A / row_sums
    
    # Calculating the Laplacian Graph: L = D - A
    D <- diag(row_sums)
    L <- D - A
    
    # Printing the results
    cat("Adjacency Matrix:\n")
    print(A)
    
    cat("\nStochastic Adjacency Matrix:\n")
    print(round(A_stochastic, 3))
    
    cat("\nLaplacian Graph (L = D - A):\n")
    print(L)

08.6.2

Problem

    # Given the bipartite network in http://www.networkatlas.eu/
    # exercises/8/2/data.txt, calculate the stochastic adjacency matrix
    # of its projection. Project along the axis of size 248. (Note: don’t
    # ignore the weights)
    
    library(here)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(dat) <- c("from", "to", "weight")
    
    # Write here the solution

Solution

    # Given the bipartite network in http://www.networkatlas.eu/
    # exercises/8/2/data.txt, calculate the stochastic adjacency matrix
    # of its projection. Project along the axis of size 248. (Note: don’t
    # ignore the weights)
    
    library(here)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(dat) <- c("from", "to", "weight")
    
    # Solution 
    
    # Identifying the bipartite sets,
    # counting how many unique nodes for each "axis"
    nodes1 <- unique(dat$from)
    nodes2 <- unique(dat$to)
    if (length(nodes1) == 248) {
      axis_nodes <- nodes1
      axis_label <- "from"
      other_label <- "to"
    } else if (length(nodes2) == 248) {
      axis_nodes <- nodes2
      axis_label <- "to"
      other_label <- "from"
    } else {
      stop("Neither axis has 248 unique nodes!")
    }
    
    # Building the incidence matrix (rows: axis_nodes, columns: other nodes)
    all_nodes_A <- sort(unique(dat[[axis_label]]))
    all_nodes_B <- sort(unique(dat[[other_label]]))
    incidence <- matrix(0, nrow=length(all_nodes_A), ncol=length(all_nodes_B),
                        dimnames=list(all_nodes_A, all_nodes_B))
    
    for (i in 1:nrow(dat)) {
      a <- as.character(dat[i, axis_label])
      b <- as.character(dat[i, other_label])
      w <- dat[i, "weight"]
      incidence[a, b] <- w
    }
    
    # Weighted projection along axis_nodes
    # For weighted bipartite projection: P = M %*% t(M) (if projecting rows)
    projection <- incidence %*% t(incidence)
    diag(projection) <- 0 # removing self-loops
    
    # Stochastic adjacency matrix (row-normalized)
    row_sums <- rowSums(projection)
    row_sums[row_sums == 0] <- 1 # avoiding division by zero
    stochastic <- projection / row_sums
    
    # Printing the outputs 
    cat("Stochastic adjacency matrix of the projected network:\n")
    print(round(stochastic[1:10, 1:10], 3))

08.6.3

Problem

    # Calculate the eigenvalues and the right and left eigenvectors of the
    # stochastic adjacency of the network at http://www.networkatlas.
    # eu/exercises/8/2/data.txt, using the same procedure applied
    # in the previous exercise. Make sure to sort the eigenvalues in
    # descending order (and sort the eigenvectors accordingly). Only
    # take the real part of eigenvalues and eigenvectors, ignoring the
    # imaginary part.
    
    library(here)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(dat) <- c("from", "to", "weight")
    
    # Write here the solution

Solution

    # Calculate the eigenvalues and the right and left eigenvectors of the
    # stochastic adjacency of the network at http://www.networkatlas.
    # eu/exercises/8/2/data.txt, using the same procedure applied
    # in the previous exercise. Make sure to sort the eigenvalues in
    # descending order (and sort the eigenvectors accordingly). Only
    # take the real part of eigenvalues and eigenvectors, ignoring the
    # imaginary part.
    
    library(here)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(dat) <- c("from", "to", "weight")
    
    # Solution
    
    # Identifying the bipartite sets
    nodes1 <- unique(dat$from)
    nodes2 <- unique(dat$to)
    if (length(nodes1) == 248) {
      axis_nodes <- nodes1
      axis_label <- "from"
      other_label <- "to"
    } else if (length(nodes2) == 248) {
      axis_nodes <- nodes2
      axis_label <- "to"
      other_label <- "from"
    } else {
      stop("Neither axis has 248 unique nodes.")
    }
    
    # Building weighted incidence matrix (rows: axis_nodes)
    all_nodes_A <- sort(unique(dat[[axis_label]]))
    all_nodes_B <- sort(unique(dat[[other_label]]))
    incidence <- matrix(0, nrow=length(all_nodes_A), ncol=length(all_nodes_B),
                        dimnames=list(all_nodes_A, all_nodes_B))
    for (i in 1:nrow(dat)) {
      a <- as.character(dat[i, axis_label])
      b <- as.character(dat[i, other_label])
      w <- as.numeric(dat[i, "weight"])
      incidence[a, b] <- w
    }
    
    # Weighted projection along axis_nodes
    projection <- incidence %*% t(incidence)
    diag(projection) <- 0 # remove self-loops
    
    # Stochastic adjacency matrix (row-normalized)
    row_sums <- rowSums(projection)
    row_sums[row_sums == 0] <- 1
    stochastic <- projection / row_sums
    
    # Eigenvalues & eigenvectors
    eig <- eigen(stochastic)
    values <- Re(eig$values)
    right_vecs <- Re(eig$vectors)
    # For left eigenvectors -> t(stochastic) (since left eigvecs of A are right eigvecs of t(A))
    eig_left <- eigen(t(stochastic))
    left_vecs <- Re(eig_left$vectors)
    
    # Sorting eigenvalues and vectors in descending order
    idx <- order(values, decreasing=TRUE)
    values_sorted <- values[idx]
    right_vecs_sorted <- right_vecs[, idx, drop=FALSE]
    left_vecs_sorted <- left_vecs[, idx, drop=FALSE]
    
    # Printing the result
    cat("Eigenvalues (sorted, real part):\n")
    print(values_sorted)
    
    cat("\nFirst 5 right eigenvectors (columns, real part):\n")
    print(round(right_vecs_sorted[, 1:5, drop=FALSE], 4))
    
    cat("\nFirst 5 left eigenvectors (columns, real part):\n")
    print(round(left_vecs_sorted[, 1:5, drop=FALSE], 4))

08.6.4

Problem

    # Generate the indegree and outdegree Laplacians of the directed
    # graph at http://www.networkatlas.eu/exercises/8/4/data.
    # txt. Calculate their eigenvalues as well as the eigenvalue of the
    # undirected version of the graph.
    
    library(here)
    #library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    
    # Write here the solution

Solution

    # Generate the indegree and outdegree Laplacians of the directed
    # graph at http://www.networkatlas.eu/exercises/8/4/data.
    # txt. Calculate their eigenvalues as well as the eigenvalue of the
    # undirected version of the graph.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    
    # Solution
    
    # Building the graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Adjacency matrix
    A <- as.matrix(as_adjacency_matrix(g, sparse=FALSE))
    
    # Node order (for consistent matrix construction)
    nodes <- V(g)$name
    n <- length(nodes)
    
    # Out-degree Laplacian: L_out = D_out - A
    d_out <- rowSums(A)
    L_out <- diag(d_out) - A
    
    # In-degree Laplacian: L_in = D_in - A^T = diag(colSums(A)) - t(A)
    d_in <- colSums(A)
    L_in <- diag(d_in) - t(A)
    
    # Eigenvalues (real part, sorted decreasing)
    eig_out <- eigen(L_out, only.values=FALSE)
    eigvals_out <- sort(Re(eig_out$values), decreasing=TRUE)
    
    eig_in <- eigen(L_in, only.values=FALSE)
    eigvals_in <- sort(Re(eig_in$values), decreasing=TRUE)
    
    # Undirected version
    g_undir <- as.undirected(g, mode="collapse")
    A_undir <- as.matrix(as_adjacency_matrix(g_undir, sparse=FALSE))
    d_undir <- rowSums(A_undir)
    L_undir <- diag(d_undir) - A_undir
    
    eig_undir <- eigen(L_undir, only.values=FALSE)
    eigvals_undir <- sort(Re(eig_undir$values), decreasing=TRUE)
    
    # Printing the results
    cat("Eigenvalues of OUT-degree Laplacian (L_out):\n")
    print(eigvals_out)
    
    cat("\nEigenvalues of IN-degree Laplacian (L_in):\n")
    print(eigvals_in)
    
    cat("\nEigenvalues of undirected Laplacian:\n")
    print(eigvals_undir)

08.6.5

Problem

    # Generate the signed and unsigned Laplacians of the signed graph
    # at http://www.networkatlas.eu/exercises/8/5/data.txt – the
    # third column contains the sign. Calculate their eigenvalues as well
    # as the eigenvalue of the version of the graph ignoring edge signs.
    
    library(here)
    library(igraph)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE)
    colnames(dat) <- c("from", "to", "sign")
    
    # Write here the solution

Solution

    # Generate the signed and unsigned Laplacians of the signed graph
    # at http://www.networkatlas.eu/exercises/8/5/data.txt – the
    # third column contains the sign. Calculate their eigenvalues as well
    # as the eigenvalue of the version of the graph ignoring edge signs.
    
    library(here)
    library(igraph)
    
    # Reading the data
    dat <- read.table("data.txt", header=FALSE)
    colnames(dat) <- c("from", "to", "sign")
    
    # Solution
    
    # Building signed adjacency matrix
    nodes <- sort(unique(c(dat$from, dat$to)))
    n <- length(nodes)
    A_signed <- matrix(0, nrow=n, ncol=n, dimnames=list(nodes, nodes))
    
    for(i in 1:nrow(dat)){
      a <- as.character(dat$from[i])
      b <- as.character(dat$to[i])
      s <- as.numeric(dat$sign[i])
      A_signed[a, b] <- s
      A_signed[b, a] <- s # undirected
    }
    
    # Degree matrix for signed graph: sum of absolute values of row/col
    D_signed <- diag(rowSums(abs(A_signed)))
    
    # Signed Laplacian: L_signed = D_signed - A_signed
    L_signed <- D_signed - A_signed
    
    # Eigenvalues of signed Laplacian
    eig_signed <- eigen(L_signed)
    eigvals_signed <- sort(Re(eig_signed$values), decreasing=TRUE)
    
    # Unsigned adjacency (absolute values)
    A_unsigned <- abs(A_signed)
    D_unsigned <- diag(rowSums(A_unsigned))
    L_unsigned <- D_unsigned - A_unsigned
    
    # Eigenvalues of unsigned Laplacian
    eig_unsigned <- eigen(L_unsigned)
    eigvals_unsigned <- sort(Re(eig_unsigned$values), decreasing=TRUE)
    
    # Laplacian ignoring signs (as a normal undirected graph)
    # Optional working using a plot 
    g_undir <- graph_from_data_frame(dat[,1:2], directed=FALSE)
    A_undir <- as.matrix(as_adjacency_matrix(g_undir, sparse=FALSE))
    D_undir <- diag(rowSums(A_undir))
    L_undir <- D_undir - A_undir
    eig_undir <- eigen(L_undir)
    eigvals_undir <- sort(Re(eig_undir$values), decreasing=TRUE)
    
    # Printing the results
    cat("Eigenvalues of SIGNED Laplacian:\n")
    print(eigvals_signed)
    
    cat("\nEigenvalues of UNSIGNED Laplacian (use |sign| for edge weights):\n")
    print(eigvals_unsigned)
    
    cat("\nEigenvalues of Laplacian ignoring edge signs (normal graph):\n")
    print(eigvals_undir)

09.6.1

Problem

    # Write the in- and out-degree sequence for the graph in Figure
    # 9.3(a). Are there isolated nodes? Why? Why not?
    
    library(igraph)
    
    # Adjacency list based on the graph (naming nodes: E, C, D, B, A)
    edges <- data.frame(
      from = c("E", "E", "C", "D", "B"),
      to   = c("C", "D", "B", "B", "A")
    )
    
    # Write here the solution

Solution

    # Write the in- and out-degree sequence for the graph in Figure
    # 9.3(a). Are there isolated nodes? Why? Why not?
    
    library(igraph)
    
    # Adjacency list based on the image (let's name nodes: E, C, D, B, A)
    edges <- data.frame(
      from = c("E", "E", "C", "D", "B"),
      to   = c("C", "D", "B", "B", "A")
    )
    
    # Solution
    
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # In- and out-degree sequences
    indegree <- degree(g, mode="in")
    outdegree <- degree(g, mode="out")
    
    cat("In-degree sequence:\n")
    print(indegree)
    cat("\nOut-degree sequence:\n")
    print(outdegree)
    
    # So there aren't isolated nodes because every node has at least one edge.

09.6.2

Problem

    # Calculate the degree of the nodes for both node types in the
    # bipartite adjacency matrix from Figure 9.5(a). Find the isolated
    # node(s).
    
    #library(igraph)
    
    # Bipartite adjacency matrix
    A <- matrix(c(
      0,0,1,0,0,0,0,1,
      0,0,0,0,1,1,0,0,
      0,1,1,0,1,0,0,0,
      0,0,0,1,0,0,1,0,
      1,0,0,0,0,0,0,1,
      0,0,0,1,1,0,0,0,
      0,0,1,1,0,0,1,0,
      0,0,0,0,0,0,1,0
    ), nrow=8, byrow=TRUE)
    
    # Write here the solution

Solution

    # Calculate the degree of the nodes for both node types in the
    # bipartite adjacency matrix from Figure 9.5(a). Find the isolated
    # node(s).
    
    library(igraph)
    
    # Bipartite adjacency matrix
    A <- matrix(c(
      0,0,1,0,0,0,0,1,
      0,0,0,0,1,1,0,0,
      0,1,1,0,1,0,0,0,
      0,0,0,1,0,0,1,0,
      1,0,0,0,0,0,0,1,
      0,0,0,1,1,0,0,0,
      0,0,1,1,0,0,1,0,
      0,0,0,0,0,0,1,0
    ), nrow=8, byrow=TRUE)
    
    # Solution 
    
    # Degree for type 1 nodes (rows)
    degree_type1 <- rowSums(A)
    
    # Degree for type 2 nodes (columns)
    degree_type2 <- colSums(A)
    
    cat("Degree of type 1 nodes (rows):\n")
    print(degree_type1)
    
    cat("\nDegree of type 2 nodes (columns):\n")
    print(degree_type2)
    
    # Finding isolated nodes
    isolated_type1 <- which(degree_type1 == 0)
    isolated_type2 <- which(degree_type2 == 0)
    
    cat("\nIsolated type 1 nodes (rows):", if(length(isolated_type1) == 0) "none" else isolated_type1, "\n")
    cat("Isolated type 2 nodes (columns):", if(length(isolated_type2) == 0) "none" else isolated_type2, "\n")
    
    ################################################################################
    # Optional generating a graph
    
    g <- graph_from_incidence_matrix(A)
    
    V(g)$color <- ifelse(V(g)$type, "skyblue", "orange")
    
    plot(
      g,
      vertex.label=NA,
      vertex.size=25,
      layout=layout_as_bipartite,
      main="Bipartite Graph from Figure 9.5(a)"
    )
    ################################################################################

09.6.3

Problem

    # Write the degree sequence of the graph in Figure 9.7. First consid-
    # ering all layers at once, then separately for each layer.
    
    library(igraph)
    
    nodes <- as.character(1:9)
    
    # Edge lists for each layer/color (example, adapt if you see differences!)
    edges_brown <- matrix(c(1,3, 3,2, 2,4, 3,4, 6,8, 6,9), ncol=2, byrow=TRUE)
    edges_green <- matrix(c(1,4, 4,5, 5,8, 4,7, 8,9), ncol=2, byrow=TRUE)
    edges_blue  <- matrix(c(2,5, 5,7, 6,9), ncol=2, byrow=TRUE)
    edges_orange<- matrix(c(1,2, 2,5, 7,8, 7,6, 6,9), ncol=2, byrow=TRUE)
    edges_purple<- matrix(c(2,5, 5,7, 5,6, 6,8), ncol=2, byrow=TRUE)
    edges_red   <- matrix(c(1,3, 4,5), ncol=2, byrow=TRUE)
    
    # Write here the solution

Solution

    # Write the degree sequence of the graph in Figure 9.7. First consid-
    # ering all layers at once, then separately for each layer.
    
    library(igraph)
    
    nodes <- as.character(1:9)
    
    # Edge lists for each layer/color (example, adapt if you see differences!)
    edges_brown <- matrix(c(1,3, 3,2, 2,4, 3,4, 6,8, 6,9), ncol=2, byrow=TRUE)
    edges_green <- matrix(c(1,4, 4,5, 5,8, 4,7, 8,9), ncol=2, byrow=TRUE)
    edges_blue  <- matrix(c(2,5, 5,7, 6,9), ncol=2, byrow=TRUE)
    edges_orange<- matrix(c(1,2, 2,5, 7,8, 7,6, 6,9), ncol=2, byrow=TRUE)
    edges_purple<- matrix(c(2,5, 5,7, 5,6, 6,8), ncol=2, byrow=TRUE)
    edges_red   <- matrix(c(1,3, 4,5), ncol=2, byrow=TRUE)
    
    # Solution 
    
    # Combine all layers for total degree sequence
    all_edges <- rbind(
      edges_brown,
      edges_green,
      edges_blue,
      edges_orange,
      edges_purple,
      edges_red
    )
    
    g_all <- graph_from_edgelist(all_edges, directed=FALSE)
    deg_all <- degree(g_all, v=nodes)
    cat("Degree sequence considering all layers at once:\n")
    print(deg_all)
    
    # Calculate degree for each layer separately
    layers <- list(
      brown=edges_brown,
      green=edges_green,
      blue=edges_blue,
      orange=edges_orange,
      purple=edges_purple,
      red=edges_red
    )
    
    cat("\nDegree sequences for each layer:\n")
    for(layer in names(layers)) {
      # Convert edges to data frame for compatibility
      edge_df <- as.data.frame(layers[[layer]])
      names(edge_df) <- c("from", "to")
      g_layer <- graph_from_data_frame(edge_df, directed=FALSE, vertices=data.frame(name=nodes))
      deg_layer <- degree(g_layer, v=nodes)
      cat(sprintf("%s: %s\n", layer, paste(deg_layer, collapse=" ")))
    }

09.6.4

Problem

    # Plot the degree distribution of the network at http://www.networkatlas.
    # eu/exercises/9/4/data.txt. Start from a plain degree distribu-
    # tion, then in log-log scale, finally plot the complement of the
    # cumulative distribution.
    
    library(here)
    library(igraph)
    
    # Read the edge list
    edges <- read.table("data.txt", header=FALSE)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Compute degree for each node
    deg <- degree(g)
    
    # Write here the solution

Solution

    # Plot the degree distribution of the network at http://www.networkatlas.
    # eu/exercises/9/4/data.txt. Start from a plain degree distribu-
    # tion, then in log-log scale, finally plot the complement of the
    # cumulative distribution.
    
    library(here)
    library(igraph)
    
    # Read the edge list
    edges <- read.table("data.txt", header=FALSE)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Compute degree for each node
    deg <- degree(g)
    
    # Solution
    
    # Frequency table of degrees
    deg_dist <- table(deg)
    
    # Plain degree distribution plot
    plot(as.numeric(names(deg_dist)), as.numeric(deg_dist), type="h",
         xlab="Degree", ylab="Frequency", main="Degree Distribution")
    
    # Avoiding log(0) by removing zero frequencies
    nonzero <- deg_dist > 0
    plot(log10(as.numeric(names(deg_dist[nonzero]))),
         log10(as.numeric(deg_dist[nonzero])),
         xlab="log10(Degree)", ylab="log10(Frequency)", main="Degree Distribution (log-log)",
         pch=20)
    
    # Computing the cumulative distribution
    deg_values <- as.numeric(names(deg_dist))
    cum_dist <- cumsum(rev(as.numeric(deg_dist)))  # cumulative from high degree down
    ccdf <- rev(cum_dist) / sum(deg_dist)  # normalize
    
    # Plotting the CCDF in log-log
    plot(log10(deg_values), log10(ccdf), type="b", pch=20,
         xlab="log10(Degree)", ylab="log10(CCDF)", main="Complementary Cumulative Degree Distribution")

09.6.5

Problem

    # Estimate the power law exponent of the CCDF degree distribution
    # from the previous exercise. First by a linear regression on the log-
    # log plane, then by using the powerlaw package. Do they agree? Is
    # this a shifted power law? If so, what’s k min ? (Hint: powerlaw can
    # calculate this for you)
    
    library(here)
    library(igraph)
    library(poweRlaw)
    
    # Read the edge list
    edges <- read.table("data.txt", header=FALSE)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    deg <- degree(g)
    
    # Write here the solution

Solution

    # Estimate the power law exponent of the CCDF degree distribution
    # from the previous exercise. First by a linear regression on the log-
    # log plane, then by using the powerlaw package. Do they agree? Is
    # this a shifted power law? If so, what’s k min ? (Hint: powerlaw can
    # calculate this for you)
    
    library(here)
    library(igraph)
    library(poweRlaw)
    
    # Read the edge list
    edges <- read.table("data.txt", header=FALSE)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    deg <- degree(g)
    
    # Solution
    
    # Linear Regression on the Log-Log CCDF
    # Degree distribution
    deg_dist <- table(deg)
    deg_vals <- as.numeric(names(deg_dist))
    deg_freq <- as.numeric(deg_dist)
    deg_ccdf <- rev(cumsum(rev(deg_freq))) / sum(deg_freq)
    
    # Removing degrees with zero frequency
    nonzero <- deg_ccdf > 0
    
    # Preparing log-log data
    log_deg <- log10(deg_vals[nonzero])
    log_ccdf <- log10(deg_ccdf[nonzero])
    
    # Linear regression (excluding degree=0)
    fit <- lm(log_ccdf ~ log_deg)
    
    cat("Estimated exponent (linear regression):", -coef(fit)[2], "\n")
    summary(fit)
    
    # Create a discrete power law object
    pl_model <- displ$new(deg)
    
    # Estimate xmin and alpha automatically
    est <- estimate_xmin(pl_model)
    pl_model$setXmin(est)
    
    cat("poweRlaw estimated xmin (k_min):", pl_model$getXmin(), "\n")
    cat("poweRlaw estimated exponent (alpha):", pl_model$pars, "\n")
    
    if (pl_model$getXmin() > 1) {
      cat("This is a shifted power law, starting from k_min =", pl_model$getXmin(), "\n")
    } else {
      cat("This is not a shifted power law (k_min = 1).\n")
    }
    
    # So they agreeing because is a shit powerlaw!

09.6.6

Problem

    # Find a way to fit the truncated power law of the network at http:
    #  //www.networkatlas.eu/exercises/9/6/data.net. Hint: use the
    # scipy.optimize.curve_fit to fit an arbitrary function and use the
    # functional form I provide in the text.
    
    library(here)
    library(igraph)
    # library(poweRlaw)
    
    # Read the Pajek network
    g <- read_graph("data.net", format="pajek")
    
    # Get degree sequence
    deg <- degree(g)
    
    # Write here the solution

Solution

    # Find a way to fit the truncated power law of the network at http:
    #  //www.networkatlas.eu/exercises/9/6/data.net. Hint: use the
    # scipy.optimize.curve_fit to fit an arbitrary function and use the
    # functional form I provide in the text.
    
    library(here)
    library(igraph)
    library(poweRlaw)
    
    # Read the Pajek network
    g <- read_graph("data.net", format="pajek")
    
    # Get degree sequence
    deg <- degree(g)
    
    # Solution 
    
    # Preparing the Degree Distribution
    deg_tab <- table(deg)
    deg_vals <- as.numeric(names(deg_tab))
    deg_freq <- as.numeric(deg_tab)
    
    # Fitting a Truncated Power Law
    
    # Creating data for fitting (exclude zeros)
    fit_idx <- deg_vals > 0
    x <- deg_vals[fit_idx]
    y <- deg_freq[fit_idx]
    
    # Normalizing y for probability (optional, but better for fit)
    y <- y / sum(y)
    
    # Nonlinear fit: y ~ C * x^(-alpha) * exp(-lambda * x)
    tplaw <- nls(y ~ C * x^(-alpha) * exp(-lambda * x),
                 start=list(C=1, alpha=2, lambda=0.1),
                 control = nls.control(maxiter = 100))
    
    summary(tplaw)
    
    # Plotting the fit
    
    plot(x, y, log="xy", pch=20, xlab="Degree", ylab="P(k)", main="Truncated Power Law Fit")
    lines(x, predict(tplaw), col="red", lwd=2)
    legend("topright", legend="TPL fit", col="red", lwd=2)
    
    ################################################################################
    # Optional: Using poweRlaw for Comparison
    
    # Suppose deg is the degree vector
    m <- displ$new(deg)
    
    # Estimating xmin and exponent (alpha)
    est <- estimate_xmin(m)
    m$setXmin(est)
    est_pars <- estimate_pars(m)
    m$setPars(est_pars$pars)
    
    # Plotting the data and the fit
    plot(m, main="Using poweRlaw for Comparison")
    lines(m, col="red")
    ################################################################################

10.6.1

Problem

    # Write the code to perform a random walk of arbitrary length on
    # the network in http://www.networkatlas.eu/exercises/10/1/
    # data.txt.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # For printing all node's name
    #print(V(g)$name)
    
    ################################################################################
    # Optional: plotting the graph
    
    plot(g,
         vertex.size=3,
         vertex.label=NA,
         edge.arrow.size=0.3,
         main="Network Graph from data.txt")
    
    ################################################################################
    
    # Parameters for the random walk
    walk_length <- 100 # Setting walk length
    start_node_name <- "100" # Setting start node name
    
    # Checking if the node's name exist 
    start_node <- which(V(g)$name == start_node_name)
    
    if (length(start_node) == 0) {
      stop(paste("Node", start_node_name, "not found in the network!"))
    }
    
    # Write here the solution

Solution

    # Write the code to perform a random walk of arbitrary length on
    # the network in http://www.networkatlas.eu/exercises/10/1/
    # data.txt.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # For printing all node's name
    #print(V(g)$name)
    
    ################################################################################
    # Optional: plotting the graph
    
    plot(g,
         vertex.size=3,
         vertex.label=NA,
         edge.arrow.size=0.3,
         main="Network Graph from data.txt")
    
    ################################################################################
    
    # Parameters for the random walk
    walk_length <- 100 # Setting walk length
    start_node_name <- "100" # Setting start node name
    
    # Checking if the node's name exist 
    start_node <- which(V(g)$name == start_node_name)
    
    if (length(start_node) == 0) {
      stop(paste("Node", start_node_name, "not found in the network!"))
    }
    
    # Solution 
    
    # Performing the random walk
    walk <- random_walk(g, start=start_node, steps=walk_length, mode="all")
    
    # Printing the sequence of visited nodes
    cat("Random walk:\n")
    print(V(g)[walk]$name)

10.6.2

Problem

    # Find all cycles in the network in http://www.networkatlas.eu/
    # exercises/10/2/data.txt. Note: the network is directed.
    
    library(here)
    library(RBGL)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header = FALSE, stringsAsFactors = FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    
    # Write here the solution

Solution

    # Find all cycles in the network in http://www.networkatlas.eu/
    # exercises/10/2/data.txt. Note: the network is directed.
    
    library(here)
    library(RBGL)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header = FALSE, stringsAsFactors = FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    
    # Solution (this should be the solution, but I have problems to compile RBGL)
    
    # Creating a directed graphNEL object
    gNEL <- new("graphNEL", nodes = as.character(nodes), edgemode = "directed")
    for(i in 1:nrow(edges)) {
      gNEL <- addEdge(as.character(edges$V1[i]), as.character(edges$V2[i]), gNEL)
    }
    
    # Finding all cycles
    cycles <- johnson.all.cycles(gNEL)
    
    # Printing cycles
    cat("All cycles found:\n")
    for (cyc in cycles) {
      cat(paste(cyc, collapse = " -> "), "\n")
    }

10.6.3

Problem

    # What is the average reciprocity in the network used in the previous
    # question? How many nodes have a reciprocity of zero?
    
    library(here)
    library(igraph)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=TRUE)
    
    # Write here the solution

Solution

    # What is the average reciprocity in the network used in the previous
    # question? How many nodes have a reciprocity of zero?
    
    library(here)
    library(igraph)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=TRUE)
    
    # Solution
    
    # Calculating the Average reciprocity
    avg_reciprocity <- reciprocity(g)
    cat(sprintf("Average reciprocity of the network: %.3f\n", avg_reciprocity))
    
    # Calculating the Reciprocity per node
    node_recip <- reciprocity(g, mode="ratio") # returning a vector, one per node
    
    # Calculating How many nodes have a reciprocity of zero?
    num_zero_recip_nodes <- sum(node_recip == 0)
    cat(sprintf("Number of nodes with reciprocity zero: %d\n", num_zero_recip_nodes))
    
    ################################################################################
    # Optional - printing those nodes:
    
    zero_recip_nodes <- V(g)$name[node_recip == 0]
    cat("Nodes with reciprocity zero:\n")
    print(zero_recip_nodes)
    ################################################################################

10.6.4

Problem

    # How many weakly and strongly connected component does the
    # network used in the previous question have? Compare their sizes,
    # in number of nodes, with the entire network. Which nodes are in
    # these two components?
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=TRUE)
    
    # Write here the solution

Solution

    # How many weakly and strongly connected component does the
    # network used in the previous question have? Compare their sizes,
    # in number of nodes, with the entire network. Which nodes are in
    # these two components?
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=TRUE)
    
    # Solution
    
    # Calculating the Strongly Connected Components
    scc <- components(g, mode="strong")
    num_scc <- scc$no
    sizes_scc <- scc$csize
    
    # Calculating the Weakly Connected Components
    wcc <- components(g, mode="weak")
    num_wcc <- wcc$no
    sizes_wcc <- wcc$csize
    
    # Printing the result
    num_nodes <- vcount(g)
    cat(sprintf("Total nodes: %d\n", num_nodes))
    cat(sprintf("Number of strongly connected components: %d\n", num_scc))
    cat(sprintf("Sizes of SCCs: %s\n", paste(sizes_scc, collapse=", ")))
    cat(sprintf("Number of weakly connected components: %d\n", num_wcc))
    cat(sprintf("Sizes of WCCs: %s\n", paste(sizes_wcc, collapse=", ")))
    
    ################################################################################
    # Optional
    
    # List the nodes in each SCC
    cat("\nStrongly connected components:\n")
    for(i in seq_len(num_scc)) {
      nodes_in_scc <- V(g)$name[which(scc$membership == i)]
      cat(sprintf("SCC %d (%d nodes): %s\n", i, length(nodes_in_scc), paste(nodes_in_scc, collapse=", ")))
    }
    
    # List the nodes in each WCC
    cat("\nWeakly connected components:\n")
    for(i in seq_len(num_wcc)) {
      nodes_in_wcc <- V(g)$name[which(wcc$membership == i)]
      cat(sprintf("WCC %d (%d nodes): %s\n", i, length(nodes_in_wcc), paste(nodes_in_wcc, collapse=", ")))
    }
    ################################################################################

11.8.1

Problem

    # Calculate the stationary distribution of the network at http://
    # www.networkatlas.eu/exercises/11/1/data.txt in three ways: by
    # raising the stochastic adjacency to a high power, by looking at the
    # leading left eigenvector, and by normalizing the degree. Verify that
    # they are all equivalent.
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # Calculate the stationary distribution of the network at http://
    # www.networkatlas.eu/exercises/11/1/data.txt in three ways: by
    # raising the stochastic adjacency to a high power, by looking at the
    # leading left eigenvector, and by normalizing the degree. Verify that
    # they are all equivalent.
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution 
    
    # Building adjacency matrix
    N <- length(nodes)
    adj <- matrix(0, nrow=N, ncol=N)
    for(i in 1:nrow(edges)) {
      from <- match(edges$V1[i], nodes)
      to   <- match(edges$V2[i], nodes)
      adj[from, to] <- 1
    }
    row_sums <- rowSums(adj)
    
    # Building the stochastic matrix with fix for dangling nodes
    P <- adj
    for (i in 1:N) {
      if (row_sums[i] == 0) {
        P[i, ] <- 1/N
      } else {
        P[i, ] <- adj[i, ] / row_sums[i]
      }
    }
    
    # Stationary by power
    Pn <- P
    for(i in 1:100) Pn <- Pn %*% P
    stat1 <- Pn[1,]; stat1 <- stat1 / sum(stat1)
    
    # Stationary by left eigenvector
    eig <- eigen(t(P))
    stat2 <- Re(eig$vectors[,which.max(Re(eig$values))])
    stat2 <- stat2 / sum(stat2)
    
    # Stationary by degree
    deg <- row_sums
    # assigning 1 to dangling nodes as well (for consistency)
    deg[deg == 0] <- 1
    stat3 <- deg / sum(deg)
    
    # 6. Comparing
    cat("By matrix power:\n"); print(round(stat1, 5))
    cat("By eigenvector:\n"); print(round(stat2, 5))
    cat("By degree normalization:\n"); print(round(stat3, 5))
    cat("Matrix power vs eigenvector: ", all.equal(stat1, stat2, tolerance=1e-6), "\n")
    cat("Matrix power vs degree: ", all.equal(stat1, stat3, tolerance=1e-6), "\n")

11.8.2

Problem

    # Calculate the non-backtracking matrix of the network used for the
    # previous question. (The network is undirected)
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header = FALSE)
    colnames(edges) <- c("from", "to")
    
    # Write here the solution

Solution

    # Calculate the non-backtracking matrix of the network used for the
    # previous question. (The network is undirected)
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header = FALSE)
    colnames(edges) <- c("from", "to")
    
    # This should be the solution...
    
    # Making sure all edges are unique and undirected
    edges <- unique(data.frame(from = pmin(edges$from, edges$to), to = pmax(edges$from, edges$to)))
    
    # Creating directed edges (both directions for each undirected edge)
    directed_edges <- rbind(
      data.frame(from = edges$from, to = edges$to),
      data.frame(from = edges$to, to = edges$from)
    )
    n_dir <- nrow(directed_edges)
    
    # Building the non-backtracking matrix
    B <- matrix(0, nrow = n_dir, ncol = n_dir)
    for (i in 1:n_dir) {
      for (j in 1:n_dir) {
        # edge i: a -> b
        # edge j: c -> d
        if (directed_edges$to[i] == directed_edges$from[j] &&
            directed_edges$from[i] != directed_edges$to[j]) {
          B[i, j] <- 1
        }
      }
    }
    
    # Assigning row/col names for clarity
    rownames(B) <- paste(directed_edges$from, "->", directed_edges$to)
    colnames(B) <- paste(directed_edges$from, "->", directed_edges$to)
    
    # Printing the result
    print(B)

11.8.3

Problem

    # Calculate the hitting time matrix of the network at http://www.
    # networkatlas.eu/exercises/11/3/data.txt. Note: for various
    # reasons, a naive implementation in python using numpy and scipy
    # might lead to the wrong result. I would advise to try and do this
    # in Octave (or Matlab).
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header = FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # Calculate the hitting time matrix of the network at http://www.
    # networkatlas.eu/exercises/11/3/data.txt. Note: for various
    # reasons, a naive implementation in python using numpy and scipy
    # might lead to the wrong result. I would advise to try and do this
    # in Octave (or Matlab).
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header = FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution
    
    # Building adjacency matrix
    
    N <- length(nodes)
    adj <- matrix(0, nrow = N, ncol = N)
    for(i in 1:nrow(edges)) {
      from <- match(edges$V1[i], nodes)
      to   <- match(edges$V2[i], nodes)
      adj[from, to] <- 1
      adj[to, from] <- 1  # undirected
    }
    
    # Row-stochastic transition matrix
    row_sums <- rowSums(adj)
    P <- adj / row_sums
    
    # Hitting time matrix function
    hitting_time_matrix <- function(P) {
      N <- nrow(P)
      H <- matrix(0, nrow=N, ncol=N)
      for (target in 1:N) {
        A <- diag(N)
        b <- rep(1, N)
        A[target,] <- 0
        A[target, target] <- 1
        b[target] <- 0
        for (i in setdiff(1:N, target)) {
          A[i,] <- -P[i,]
          A[i,i] <- 1
        }
        h <- solve(A, b)
        H[,target] <- h
      }
      rownames(H) <- nodes
      colnames(H) <- nodes
      H
    }
    
    # 4. Computing and printing hitting times
    H <- hitting_time_matrix(P)
    print(round(H,2))

11.8.4

Problem

    # Calculate the effective resistance matrix of the network at http:
    # //www.networkatlas.eu/exercises/11/3/data.txt and prove it is
    # equal to the commute time divided by 2| E|. Note: differently from
    # above, the effective resistance matrix can be calculated in python
    # without an issue. But the second part of the exercise might fail if
    # not done in Octave (or Matlab).
    
    library(here)
    library(MASS)
    
    # Reading data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # Calculate the effective resistance matrix of the network at http:
    # //www.networkatlas.eu/exercises/11/3/data.txt and prove it is
    # equal to the commute time divided by 2| E|. Note: differently from
    # above, the effective resistance matrix can be calculated in python
    # without an issue. But the second part of the exercise might fail if
    # not done in Octave (or Matlab).
    
    library(here)
    library(MASS)
    
    # Reading data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution 
    
    # Building the Laplacian
    N <- length(nodes)
    adj <- matrix(0, nrow=N, ncol=N)
    for(i in 1:nrow(edges)) {
      from <- match(edges$V1[i], nodes)
      to <- match(edges$V2[i], nodes)
      adj[from, to] <- 1
      adj[to, from] <- 1
    }
    deg <- rowSums(adj)
    L <- diag(deg) - adj
    
    # Computing the pseudoinverse of the Laplacian
    Lplus <- ginv(L)
    
    # Computing the effective resistance matrix
    R_eff <- matrix(0, N, N)
    for(i in 1:N) {
      for(j in 1:N) {
        R_eff[i,j] <- Lplus[i,i] + Lplus[j,j] - 2*Lplus[i,j]
      }
    }
    rownames(R_eff) <- nodes
    colnames(R_eff) <- nodes
    
    # Computing the commute time matrix
    n_edges <- nrow(edges)
    C <- 2 * n_edges * R_eff
    
    # Printing the values and Confirming the relation
    cat("Effective resistance\n")
    print(R_eff)
    cat("Commute time / (2*|E|)\n")
    print(C/(2*n_edges))
    cat("\nIs effective resistance == commute time / (2*|E|)?\n")
    print(all.equal(R_eff, C/(2*n_edges), tolerance=1e-8))

11.8.5

Problem

    # Draw the spectral plot of the network at http://www.networkatlas.
    # eu/exercises/11/5/data.txt, showing the relationship between
    # the second and third eigenvectors of its Laplacian. Can you find
    # clusters?
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # Draw the spectral plot of the network at http://www.networkatlas.
    # eu/exercises/11/5/data.txt, showing the relationship between
    # the second and third eigenvectors of its Laplacian. Can you find
    # clusters?
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution 
    
    # Building the adjacency matrix
    N <- length(nodes)
    adj <- matrix(0, nrow=N, ncol=N)
    for (i in 1:nrow(edges)) {
      from <- match(edges$V1[i], nodes)
      to   <- match(edges$V2[i], nodes)
      adj[from, to] <- 1
      adj[to, from] <- 1  # undirected
    }
    
    # Compute the Laplacian matrix
    deg <- rowSums(adj)
    L <- diag(deg) - adj
    
    # Computing the eigenvalues/vectors of the Laplacian
    eig <- eigen(L)
    
    # Spectral plot: second (eig$vectors[,N-1]) and third (eig$vectors[,N-2]) smallest eigenvectors
    x <- eig$vectors[, N-1]
    y <- eig$vectors[, N-2]
    
    # Plotting
    plot(x, y, pch=19, col='blue', xlab="2nd eigenvector", ylab="3rd eigenvector", main="Spectral plot of the Laplacian")
    text(x, y, labels=nodes, pos=3, cex=0.7, col="darkred")
    
    # Trying basic clustering (e.g., k-means with k=3)
    km <- kmeans(cbind(x, y), 3)
    points(x, y, col=km$cluster, pch=19)
    print(data.frame(node=nodes, cluster=km$cluster))

12.6.1

Problem

    # Calculate the density of hypothetical undirected networks with
    # the following statistics: |V | = 26, | E| = 180; |V | = 44, | E| = 221;
    # |V | = 8, | E| = 201. Which of these networks is an impossible
    # topology (unless we allow it to be a multigraph)?
    
    # Defining the statistics
    networks <- data.frame(
      V = c(26, 44, 8),
      E = c(180, 221, 201)
    )
    
    # Write here the solution

Solution

    # Calculate the density of hypothetical undirected networks with
    # the following statistics: |V | = 26, | E| = 180; |V | = 44, | E| = 221;
    # |V | = 8, | E| = 201. Which of these networks is an impossible
    # topology (unless we allow it to be a multigraph)?
    
    # Defining the statistics
    networks <- data.frame(
      V = c(26, 44, 8),
      E = c(180, 221, 201)
    )
    
    # Solution 
    
    # Computing densities and checking if each network is a simple graph
    networks$density <- with(networks, 2 * E / (V * (V - 1)))
    networks$max_edges <- with(networks, V * (V - 1) / 2)
    networks$impossible <- networks$E > networks$max_edges
    
    # Printing the result 
    print(networks)

12.6.2

Problem

    # Calculate the density of hypothetical directed networks with the
    # following statistics: |V | = 15, | E| = 380; |V | = 77, | E| = 391;
    # |V | = 101, | E| = 566. Which of these networks is an impossible
    # topology (unless we allow it to be a multigraph)?
    
    # Defining network statistics
    networks <- data.frame(
      V = c(15, 77, 101),
      E = c(380, 391, 566)
    )
    
    # Write here the solution

Solution

    # Calculate the density of hypothetical directed networks with the
    # following statistics: |V | = 15, | E| = 380; |V | = 77, | E| = 391;
    # |V | = 101, | E| = 566. Which of these networks is an impossible
    # topology (unless we allow it to be a multigraph)?
    
    # Defining network statistics
    networks <- data.frame(
      V = c(15, 77, 101),
      E = c(380, 391, 566)
    )
    
    # Solution
    
    # Compute density and check feasibility
    networks$density <- with(networks, E / (V * (V - 1)))
    networks$max_edges <- with(networks, V * (V - 1))
    networks$impossible <- networks$E > networks$max_edges
    
    # Printing the result
    print(networks)

12.6.3

Problem

    # Calculate the global, average and local clustering coefficient for
    # the network in http://www.networkatlas.eu/exercises/12/3/
    # data.txt.
    
    library(here)
    #library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # Calculate the global, average and local clustering coefficient for
    # the network in http://www.networkatlas.eu/exercises/12/3/
    # data.txt.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution 
    
    # Building the Adjacency Matrix
    N <- length(nodes)
    adj <- matrix(0, nrow=N, ncol=N)
    for (i in 1:nrow(edges)) {
      a <- match(edges$V1[i], nodes)
      b <- match(edges$V2[i], nodes)
      adj[a, b] <- 1
      adj[b, a] <- 1
    }
    
    # Computing Local Clustering Coefficients
    local_clustering <- function(adj) {
      N <- nrow(adj)
      c_vec <- numeric(N)
      for (i in 1:N) {
        neighbors <- which(adj[i, ] == 1)
        k <- length(neighbors)
        if (k < 2) {
          c_vec[i] <- 0
        } else {
          subgraph <- adj[neighbors, neighbors]
          edges_between_neighbors <- sum(subgraph) / 2
          c_vec[i] <- (2 * edges_between_neighbors) / (k * (k - 1))
        }
      }
      names(c_vec) <- nodes
      return(c_vec)
    }
    C_local <- local_clustering(adj)
    
    # Averaging Clustering Coefficient
    C_average <- mean(C_local)
    
    # Calculating the Global Clustering Coefficient
    g <- graph_from_adjacency_matrix(adj, mode="undirected")
    C_global <- transitivity(g, type="global")
    
    # Printing the results 
    cat("Global clustering coefficient:", C_global, "\n")
    cat("Average clustering coefficient:", C_average, "\n")
    cat("First few local clustering coefficients:\n")
    print(head(C_local))

12.6.4

Problem

    # What is the size in number of nodes of the largest maximal clique
    # of the network used in the previous question? Which nodes are
    # part of it?
    
    library(here)
    #library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Write here the solution

Solution

    # What is the size in number of nodes of the largest maximal clique
    # of the network used in the previous question? Which nodes are
    # part of it?
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    nodes <- sort(unique(c(edges$V1, edges$V2)))
    
    # Solution
    
    # Building igraph object with explicit node names
    g <- graph_from_data_frame(edges, directed=FALSE, vertices=data.frame(name=nodes))
    
    # Finding all maximal cliques
    cliques <- maximal.cliques(g)
    
    # Finding the largest clique(s)
    max_size <- max(sapply(cliques, length))
    largest_cliques <- cliques[sapply(cliques, length) == max_size]
    
    # Printing the results
    cat("Size of the largest maximal clique:", max_size, "\n")
    cat("Nodes in the largest maximal clique(s):\n")
    for (i in seq_along(largest_cliques)) {
      clique_nodes <- V(g)$name[as.integer(largest_cliques[[i]])]
      cat("Clique", i, ":", sort(clique_nodes), "\n")
    }

12.6.5

Problem

    # What is the size in number of nodes of the largest independent
    # set of the network used in the previous question? (Approximate
    # answers are acceptable) Which nodes are part of it?
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Write here the solution

Solution

    # What is the size in number of nodes of the largest independent
    # set of the network used in the previous question? (Approximate
    # answers are acceptable) Which nodes are part of it?
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, colClasses="character")
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Solution
    
    # Greedy algorithm: iteratively add lowest-degree vertex to the independent set
    independent_set <- c()
    remaining <- V(g)
    
    while(length(remaining) > 0) {
      degs <- degree(g, v=remaining)
      v <- remaining[which.min(degs)]
      independent_set <- c(independent_set, v)
      neighbors <- neighbors(g, v)
      to_remove <- union(v, neighbors)
      remaining <- setdiff(remaining, to_remove)
    }
    
    cat("Approximate size of large independent set found:", length(independent_set), "\n")
    cat("Nodes in the independent set:\n")
    print(V(g)$name[independent_set])

13.7.1

Problem

    # Label the nodes of the graph in Figure 13.12(a) in the order of
    # exploration of a BFS. Start from the node in the bottom right
    # corner.
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Label the nodes of the graph in Figure 13.12(a) in the order of
    # exploration of a BFS. Start from the node in the bottom right
    # corner.
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
    1,2,
    1,3,
    2,3,
    2,4,
    2,5,
    3,5,
    3,4,
    4,5,
    5,6,
    5,7,
    6,7,
    6,8,
    6,9,
    7,8,
    7,9,
    8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution
    
    # BFS from node 9 (bottom right)
    bfs_result <- bfs(g, root=9, order=TRUE)
    bfs_order <- bfs_result$order
    labels <- rep(NA, vcount(g))
    labels[bfs_order] <- seq_along(bfs_order)
    
    # Layout for nice visual match to figure
    layout_coords <- matrix(c(
      0.2, 1.0,   # node 1
      0.8, 1.0,   # node 2
      0.5, 0.8,   # node 3
      0.9, 0.5,   # node 4
      0.5, 0.6,   # node 5
      0.5, 0.4,   # node 6
      0.2, 0.3,   # node 7
      0.5, 0.2,   # node 8
      0.8, 0.2    # node 9 (start)
    ), byrow=TRUE, ncol=2)
    
    # Plot the graph
    plot(
      g, 
      layout=layout_coords, 
      vertex.color="red", 
      vertex.size=30, 
      vertex.label=labels, 
      vertex.label.color="white", 
      edge.width=4, 
      edge.color="darkgrey", 
      main="BFS Exploration Order (Start: Node 9)"
    )
    legend("bottomleft", legend="Node labels = BFS order", bty="n")

13.7.2

Problem

    # Label the nodes of the graph in Figure 13.12(a) in the order of
    # exploration of a DFS. Start from the node in the bottom right
    # corner.
    
    library(here)
    library(igraph)
    
    # Edge list for the undirected graph (no doubled links!)
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    
    # Build the undirected graph
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Label the nodes of the graph in Figure 13.12(a) in the order of
    # exploration of a DFS. Start from the node in the bottom right
    # corner.
    
    library(here)
    library(igraph)
    
    # Edge list for the undirected graph (no doubled links!)
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    
    # Build the undirected graph
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution
    
    # DFS from node 9 (bottom right)
    dfs_result <- dfs(g, root=9, order=TRUE)
    dfs_order <- dfs_result$order
    labels <- rep(NA, vcount(g))
    labels[dfs_order] <- seq_along(dfs_order)
    
    # Layout to match the "grid" visually
    layout_coords <- matrix(c(
      0.2, 1.0,   # node 1 (top left)
      0.8, 1.0,   # node 2 (top right)
      0.5, 0.8,   # node 3 (upper center)
      0.9, 0.5,   # node 4 (middle right)
      0.5, 0.6,   # node 5 (center)
      0.5, 0.4,   # node 6 (lower center)
      0.2, 0.3,   # node 7 (middle left)
      0.5, 0.2,   # node 8 (bottom center)
      0.8, 0.2    # node 9 (bottom right, START)
    ), byrow=TRUE, ncol=2)
    
    # Ploting the graph
    plot(
      g, 
      layout=layout_coords, 
      vertex.color="red", 
      vertex.size=30, 
      vertex.label=labels, 
      vertex.label.color="white", 
      edge.width=4, 
      edge.color="darkgrey", 
      main="DFS Exploration Order (Start: Node 9)"
    )
    legend("bottomleft", legend="Node labels = DFS order", bty="n")

13.7.3

Problem

    # Calculate all shortest paths for the graph in Figure 13.12(a).
    
    library(here)
    library(igraph)
    
    # Create the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate all shortest paths for the graph in Figure 13.12(a).
    
    library(here)
    library(igraph)
    
    # Create the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution
    
    # Number of nodes
    n <- vcount(g)
    
    # Printing all shortest paths between every pair of nodes
    cat("All shortest paths between every pair of nodes:\n\n")
    for (from in 1:n) {
      for (to in 1:n) {
        if (from < to) { # Only print each pair once
          spaths <- all_shortest_paths(g, from=from, to=to)$res
          cat(sprintf("Shortest path(s) from %d to %d:\n", from, to))
          for (p in spaths) {
            cat("  ", paste(p, collapse = " -> "), "\n")
          }
          cat("\n")
        }
      }
    }

13.7.4

Problem

    # What’s the diameter of the graph in Figure 13.12(a)? What’s its
    # average path length?
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # What’s the diameter of the graph in Figure 13.12(a)? What’s its
    # average path length?
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution 
    
    # Calculating the diameter (longest shortest path)
    graph_diameter <- diameter(g)
    cat("Diameter of the graph:", graph_diameter, "\n")
    
    # Calculating the average shortest path length
    avg_path_length <- average.path.length(g)
    cat("Average path length of the graph:", avg_path_length, "\n")

14.10.1

Problem

    # Based on the paths you calculated for your answer in the previous
    # chapter, calculate the closeness centrality of the nodes in Figure
    # 13.12(a).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Based on the paths you calculated for your answer in the previous
    # chapter, calculate the closeness centrality of the nodes in Figure
    # 13.12(a).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution
    
    # Computing closeness centrality for all nodes
    clo <- closeness(g, normalized=TRUE)
    
    # Printing closeness centrality
    cat("Closeness centrality for each node:\n")
    for(i in 1:vcount(g)) {
      cat(sprintf("Node %d: %.4f\n", i, clo[i]))
    }

14.10.2

Problem

    # Calculate the betweenness centrality of the nodes in Figure
    # 13.12(a). Use to your advantage the fact that there is a bottle-
    # neck node which makes the calculation of the shortest paths easier.
    # Don’t forget to discount paths with alternative routes.
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate the betweenness centrality of the nodes in Figure
    # 13.12(a). Use to your advantage the fact that there is a bottle-
    # neck node which makes the calculation of the shortest paths easier.
    # Don’t forget to discount paths with alternative routes.
    
    library(here)
    library(igraph)
    
    # Building the undirected graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution 
    
    # Calculating betweenness centrality
    bc <- betweenness(g, normalized=FALSE)
    
    # Printing betweenness centrality for each node
    cat("Betweenness centrality for each node:\n")
    for (i in 1:vcount(g)) {
      cat(sprintf("Node %d: %.2f\n", i, bc[i]))
    }

14.10.3

Problem

    # Calculate the reach centrality for the network in http://www.
    # networkatlas.eu/exercises/14/3/data.txt. Keep in mind that
    # the network is directed and should be loaded as such. What’s the
    # most central node? How does its reach centrality compare with the
    # average reach centrality of all nodes in the network?
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Write here the solution

Solution

    # Calculate the reach centrality for the network in http://www.
    # networkatlas.eu/exercises/14/3/data.txt. Keep in mind that
    # the network is directed and should be loaded as such. What’s the
    # most central node? How does its reach centrality compare with the
    # average reach centrality of all nodes in the network?
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Solution 
    
    # For each node, computing the number of reachable nodes (excluding itself)
    reach_centrality <- sapply(V(g), function(v) {
      # Use subcomponent to get all nodes reachable from v (mode = 'out')
      reachable <- subcomponent(g, v, mode = "out")
      # Exclude self
      length(reachable) - 1
    })
    
    # Find the most central nodes
    max_reach <- max(reach_centrality)
    most_central_nodes <- which(reach_centrality == max_reach)
    
    # Average reach centrality
    avg_reach <- mean(reach_centrality)
    
    cat("Reach centrality for each node:\n")
    for (i in 1:length(reach_centrality)) {
      cat(sprintf("Node %s: %d\n", V(g)[i]$name, reach_centrality[i]))
    }
    cat("\n")
    
    cat("Most central node(s):", paste(V(g)[most_central_nodes]$name, collapse=", "), "\n")
    cat("Their reach centrality:", max_reach, "\n")
    cat("Average reach centrality:", avg_reach, "\n")
    cat(sprintf("The most central node's reach centrality is %.2f times the average.\n",
                max_reach / avg_reach))

14.10.4

Problem

    # What’s the most central node in the network used for the previous
    # exercise according to PageRank? How does PageRank compares
    # with the in-degree? (for instance, you could calculate the Spear-
    # man and/or Pearson correlation between the two)
    
    library(here)
    library(igraph)
    
    # Building the graph (reusing your code)
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Write here the solution

Solution

    # What’s the most central node in the network used for the previous
    # exercise according to PageRank? How does PageRank compares
    # with the in-degree? (for instance, you could calculate the Spear-
    # man and/or Pearson correlation between the two)
    
    library(here)
    library(igraph)
    
    # Building the graph (reusing your code)
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Solution 
    
    # Calculating PageRank for each node
    pr <- page.rank(g)$vector
    
    # Finding the most central node(s) by PageRank
    max_pr <- max(pr)
    most_central_pagerank_nodes <- which(pr == max_pr)
    
    # Calculating in-degree for each node
    in_deg <- degree(g, mode = "in")
    
    # Comparing PageRank with in-degree using correlations
    spearman_cor <- cor(pr, in_deg, method = "spearman")
    pearson_cor <- cor(pr, in_deg, method = "pearson")
    
    # Printing results
    cat("PageRank for each node:\n")
    for (i in 1:length(pr)) {
      cat(sprintf("Node %s: %.4f\n", V(g)[i]$name, pr[i]))
    }
    cat("\n")
    
    cat("Most central node(s) by PageRank:", paste(V(g)[most_central_pagerank_nodes]$name, collapse=", "), "\n")
    cat("Highest PageRank value:", max_pr, "\n")
    cat("\n")
    
    cat("In-degree for each node:\n")
    for (i in 1:length(in_deg)) {
      cat(sprintf("Node %s: %d\n", V(g)[i]$name, in_deg[i]))
    }
    cat("\n")
    
    cat(sprintf("Spearman correlation between PageRank and in-degree: %.4f\n", spearman_cor))
    cat(sprintf("Pearson correlation between PageRank and in-degree: %.4f\n", pearson_cor))

14.10.5

Problem

    # Which is the most authoritative node in the network used for
    # the previous question? Which one is the best hub? Use the HITS
    # algorithm to motivate your answer (if using networkx, use the
    # scipy version of the algorithm).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Write here the solution

Solution

    # Which is the most authoritative node in the network used for
    # the previous question? Which one is the best hub? Use the HITS
    # algorithm to motivate your answer (if using networkx, use the
    # scipy version of the algorithm).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=TRUE)
    
    # Solution
    
    # Computing PageRank for each node
    pr <- page.rank(g)$vector
    
    # Computing in-degree for each node
    indeg <- degree(g, mode="in")
    
    # Finding the most central node(s) by PageRank
    max_pr <- max(pr)
    most_central_nodes <- which(pr == max_pr)
    cat("Most central node(s) by PageRank (numeric ID):", most_central_nodes, "\n")
    cat("Highest PageRank value:", max_pr, "\n\n")
    
    # Printing a table of
    cat("Node\tPageRank\tIn-degree\n")
    for (i in 1:vcount(g)) {
      cat(sprintf("%d\t%.4f\t\t%d\n", i, pr[i], indeg[i]))
    }
    
    cat("\n")
    
    # Calculating Spearman and Pearson correlation between PageRank and in-degree
    spearman_corr <- cor(pr, indeg, method="spearman")
    pearson_corr  <- cor(pr, indeg, method="pearson")
    cat(sprintf("Spearman correlation between PageRank and in-degree: %.4f\n", spearman_corr))
    cat(sprintf("Pearson correlation between PageRank and in-degree: %.4f\n", pearson_corr))

14.10.6

Problem

    # Based on the paths you calculated for your answer in the previous
    # chapter, calculate the harmonic centrality of the nodes in Figure
    # 13.12(a).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Based on the paths you calculated for your answer in the previous
    # chapter, calculate the harmonic centrality of the nodes in Figure
    # 13.12(a).
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- matrix(c(
      1,2,
      1,3,
      2,3,
      2,4,
      2,5,
      3,5,
      3,4,
      4,5,
      5,6,
      5,7,
      6,7,
      6,8,
      6,9,
      7,8,
      7,9,
      8,9
    ), byrow=TRUE, ncol=2)
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution 
    
    # Compute all-pairs shortest paths
    dists <- distances(g)
    
    # Harmonic centrality: sum of 1/distance (excluding self, and ignoring infinite)
    harmonic_centrality <- sapply(1:vcount(g), function(i) {
      di <- dists[i, ]
      # Exclude self, and handle Inf (disconnected, not needed here as graph is connected)
      sum(1/di[di != 0])
    })
    
    cat("Harmonic centrality for each node:\n")
    for (i in 1:length(harmonic_centrality)) {
      cat(sprintf("Node %d: %.4f\n", i, harmonic_centrality[i]))
    }

14.10.7

Problem

    # Calculate the k-core decomposition of the network in http://www.
    # networkatlas.eu/exercises/14/7/data.txt. What’s the highest
    # core number in the network? How many nodes are part of the
    # maximum core?
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate the k-core decomposition of the network in http://www.
    # networkatlas.eu/exercises/14/7/data.txt. What’s the highest
    # core number in the network? How many nodes are part of the
    # maximum core?
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution 
    
    core_numbers <- coreness(g)
    max_core <- max(core_numbers)
    num_max_core_nodes <- sum(core_numbers == max_core)
    
    cat("Highest core number (max k):", max_core, "\n")
    cat("Number of nodes in the maximum core:", num_max_core_nodes, "\n")
    cat("Nodes in the maximum core:\n")
    print(V(g)[core_numbers == max_core])

14.10.8

Problem

    # What’s the degree of centralization of the network used in the
    # previous question? Compare the answer you’d get by using, as
    # your centrality measure, the degree, closeness, and betweenness
    # centrality.
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # What’s the degree of centralization of the network used in the
    # previous question? Compare the answer you’d get by using, as
    # your centrality measure, the degree, closeness, and betweenness
    # centrality.
    
    library(here)
    library(igraph)
    
    # Building the graph
    edges <- as.matrix(read.table("data.txt"))
    g <- graph_from_edgelist(edges, directed=FALSE)
    
    # Solution
    
    # Calculating centralization measures
    deg_cent <- centr_degree(g, normalized=TRUE)$centralization
    clo_cent <- centr_clo(g, normalized=TRUE)$centralization
    bet_cent <- centr_betw(g, normalized=TRUE)$centralization
    
    cat(sprintf("Degree centralization:      %.4f\n", deg_cent))
    cat(sprintf("Closeness centralization:  %.4f\n", clo_cent))
    cat(sprintf("Betweenness centralization:%.4f\n", bet_cent))

15.5.1

Problem

    # For the network at http://www.networkatlas.eu/exercises/15/
    # 1/data.txt, I precomputed communities (http://www.networkatlas.
    # eu/exercises/15/1/comms.txt). Use betweenness centrality to
    # distinguish between brokers (high centrality nodes equally con-
    # necting to different communities) and gatekeepers (high centrality
    # nodes connecting with different communities but preferring their
    # own).
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    comms <- read.table("comms.txt", header=FALSE, col.names=c("node", "community"))
    
    # Building the graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    V(g)$community <- comms$community[match(V(g)$name, comms$node)]
    
    # Write here the solution

Solution

    # For the network at http://www.networkatlas.eu/exercises/15/
    # 1/data.txt, I precomputed communities (http://www.networkatlas.
    # eu/exercises/15/1/comms.txt). Use betweenness centrality to
    # distinguish between brokers (high centrality nodes equally con-
    # necting to different communities) and gatekeepers (high centrality
    # nodes connecting with different communities but preferring their
    # own).
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    comms <- read.table("comms.txt", header=FALSE, col.names=c("node", "community"))
    
    # Building the graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    V(g)$community <- comms$community[match(V(g)$name, comms$node)]
    
    # Solution 
    
    # Betweenness centrality
    V(g)$betweenness <- betweenness(g, normalized=TRUE)
    
    # Community mixing
    get_neighbor_comms <- function(graph, v) {
      neighbor_comm <- V(graph)$community[neighbors(graph, v)]
      table(neighbor_comm)
    }
    V(g)$own_comm_frac <- sapply(V(g), function(v) {
      neighbor_comms <- get_neighbor_comms(g, v)
      own_comm <- V(g)$community[v]
      own <- neighbor_comms[as.character(own_comm)]
      total <- sum(neighbor_comms)
      ifelse(is.na(own), 0, own/total)
    })
    
    # Identifying brokers and gatekeepers
    bet_threshold <- quantile(V(g)$betweenness, 0.9)
    V(g)$role <- "other"
    V(g)$role[V(g)$betweenness >= bet_threshold & V(g)$own_comm_frac <= 0.5] <- "broker"
    V(g)$role[V(g)$betweenness >= bet_threshold & V(g)$own_comm_frac > 0.5] <- "gatekeeper"
    
    # Printing the results 
    results <- data.frame(
      node = V(g)$name,
      community = V(g)$community,
      betweenness = V(g)$betweenness,
      own_comm_frac = V(g)$own_comm_frac,
      role = V(g)$role
    )
    print(results[order(-results$betweenness), ])

15.5.2

Problem

    # Use the network from the previous question to distinguish be-
    # tween core community nodes (high degree nodes with all their
    # connections going to members of their own community) and
    # peripheral community nodes (low degree nodes with all their
    # connections going to members of their own community).
    
    library(here)
    library(igraph)
    
    # Reading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    comms <- read.table("comms.txt", header=FALSE, col.names=c("node", "community"))
    
    # Building the graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    V(g)$community <- comms$community[match(V(g)$name, comms$node)]
    
    # Write here the solution

Solution

    # Use the network from the previous question to distinguish be-
    # tween core community nodes (high degree nodes with all their
    # connections going to members of their own community) and
    # peripheral community nodes (low degree nodes with all their
    # connections going to members of their own community).
    
    library(here)
    library(igraph)
    
    # Reading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    comms <- read.table("comms.txt", header=FALSE, col.names=c("node", "community"))
    
    # Building the graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    V(g)$community <- comms$community[match(V(g)$name, comms$node)]
    
    # Solution 
    
    # Computing degree and neighbor community fractions
    V(g)$degree <- degree(g)
    
    V(g)$own_comm_frac <- sapply(V(g), function(v) {
      neighbor_comms <- V(g)$community[neighbors(g, v)]
      own_comm <- V(g)$community[v]
      if (length(neighbor_comms) == 0) return(NA)
      sum(neighbor_comms == own_comm) / length(neighbor_comms)
    })
    
    # Classifying nodes
    high_degree_threshold <- quantile(V(g)$degree, 0.75)
    low_degree_threshold  <- quantile(V(g)$degree, 0.25)
    
    V(g)$comm_role <- NA
    V(g)$comm_role[V(g)$own_comm_frac == 1 & V(g)$degree >= high_degree_threshold] <- "core"
    V(g)$comm_role[V(g)$own_comm_frac == 1 & V(g)$degree <= low_degree_threshold]  <- "peripheral"
    V(g)$comm_role[is.na(V(g)$comm_role)] <- "other"
    
    # Printign the results
    results <- data.frame(
      node = V(g)$name,
      community = V(g)$community,
      degree = V(g)$degree,
      own_comm_frac = V(g)$own_comm_frac,
      comm_role = V(g)$comm_role
    )
    print(results[order(-results$degree), ])

15.5.3

Problem

    # Calculate the structural equivalence of all pairs of nodes from the
    # network used in the previous question. Which two nodes are the
    # most similar? (Note: there could be ties)
    # Calculate the structural equivalence of all pairs of nodes from the
    # network used in the previous question. Which two nodes are the
    # most similar? (Note: there could be ties)
    
    library(here)
    library(igraph)
    
    # Reading data and build the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Calculate the structural equivalence of all pairs of nodes from the
    # network used in the previous question. Which two nodes are the
    # most similar? (Note: there could be ties)
    # Calculate the structural equivalence of all pairs of nodes from the
    # network used in the previous question. Which two nodes are the
    # most similar? (Note: there could be ties)
    
    library(here)
    library(igraph)
    
    # Reading data and build the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Solution 
    
    # Computing Jaccard similarity for all pairs (excluding self-similarities)
    jac <- similarity(g, mode="all", method="jaccard")
    diag(jac) <- NA
    
    # Finding the maximum similarity (excluding self-pairs)
    max_sim <- max(jac, na.rm=TRUE)
    
    # Getting all pairs with this maximum similarity
    max_pairs <- which(jac == max_sim, arr.ind=TRUE)
    node_names <- V(g)$name
    
    # Printing all most similar pairs
    cat("Most structurally equivalent pairs (Jaccard similarity =", max_sim, "):\n")
    for (i in 1:nrow(max_pairs)) {
      cat(node_names[max_pairs[i,1]], "<->", node_names[max_pairs[i,2]], "\n")
    }

16.7.1

Problem

    # Consider the network in http://www.networkatlas.eu/exercises/
    # 16/1/data.txt. Generate an Erdős-Rényi graph with the same
    # number of nodes and edges. Plot both networks’ degree CCDFs,
    # in log-log scale. Discuss the salient differences between these
    # istributions.
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # Consider the network in http://www.networkatlas.eu/exercises/
    # 16/1/data.txt. Generate an Erdős-Rényi graph with the same
    # number of nodes and edges. Plot both networks’ degree CCDFs,
    # in log-log scale. Discuss the salient differences between these
    # istributions.
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Solution 
    
    # Erdős-Rényi graph
    n_nodes <- vcount(g)
    n_edges <- ecount(g)
    set.seed(42)
    g_er <- sample_gnm(n=n_nodes, m=n_edges, directed=FALSE)
    
    # Degree CCDFs
    degree_ccdf <- function(degrees) {
      degs <- sort(unique(degrees))
      ccdf <- sapply(degs, function(k) mean(degrees >= k))
      data.frame(degree=degs, ccdf=ccdf)
    }
    
    deg_g   <- degree(g)
    deg_er  <- degree(g_er)
    ccdf_g  <- degree_ccdf(deg_g)
    ccdf_er <- degree_ccdf(deg_er)
    
    # printign the plot 
    plot(ccdf_g$degree, ccdf_g$ccdf, log="xy", type="b", col="blue", pch=19,
         xlab="Degree (log)", ylab="CCDF (log)", main="Degree CCDF (log-log)")
    points(ccdf_er$degree, ccdf_er$ccdf, col="red", pch=17, type="b")
    legend("bottomleft", legend=c("Original Network", "Erdős-Rényi"),
           col=c("blue", "red"), pch=c(19,17), lty=1)
    
    # Discussion: 
    
    # - Original Network: Often has a "heavy tail" (some nodes with much higher 
    # degree than the average), suggesting hubs or scale-free structure.
    
    # - Erdős-Rényi: Degree distribution is binomial/Poisson-like, so the CCDF 
    # drops off exponentially, with very small chance of high-degree nodes.

16.7.2

Problem

    # Generate a series of Erdős-Rényi graphs with 1, 000 nodes and
    # n increasing p value, from .00025 to .0025, with increments of
    # .000025. Make a plot with the p value on the x axis and the size of
    # the largest connected component on the y axis. Can you find the
    # phase transition?
    
    library(here)
    library(igraph)
    
    # Setting up the parameters
    n <- 1000
    p_vals <- seq(0.00025, 0.0025, by=0.000025)
    largest_cc_sizes <- numeric(length(p_vals))
    set.seed(42) # For reproducibility
    
    # Write here the solution

Solution

    # Generate a series of Erdős-Rényi graphs with 1, 000 nodes and
    # n increasing p value, from .00025 to .0025, with increments of
    # .000025. Make a plot with the p value on the x axis and the size of
    # the largest connected component on the y axis. Can you find the
    # phase transition?
    
    library(here)
    library(igraph)
    
    # Setting up the parameters
    n <- 1000
    p_vals <- seq(0.00025, 0.0025, by=0.000025)
    largest_cc_sizes <- numeric(length(p_vals))
    set.seed(42) # For reproducibility
    
    # Solution 
    
    # Generating Graphs and Computing largest component size
    for (i in seq_along(p_vals)) {
      g <- sample_gnp(n, p_vals[i], directed=FALSE)
      comps <- components(g)
      largest_cc_sizes[i] <- max(comps$csize)
    }
    
    # Plotting the results
    plot(p_vals, largest_cc_sizes, type="b", pch=19,
         xlab="p (edge probability)",
         ylab="Largest Connected Component Size",
         main="Phase Transition in Erdős-Rényi Graph (n = 1000)")
    
    # In the plot, should be visible that the real network’s degree CCDF decreases 
    # more slowly and exhibits a heavier tail than the Erdős-Rényi graph, indicating 
    # the presence of nodes with much higher degree (hubs), while the Erdős-Rényi 
    # graph’s CCDF drops off rapidly, reflecting its narrow, random degree 
    # distribution.

16.7.3

Problem

    # Generate a series of Erdős-Rényi graphs with p = .02 and increas-
    # ing number of nodes, from 200 to 1, 400 with increments of 200.
    # Make a plot with the |V | value on the x axis and the average path
    # length on the y axis. Since the graph might not be connected, only
    # consider the largest connected component. How does the APL
    # scale with the number of nodes?
    
    library(here)
    library(igraph)
    
    # Setting parameters
    p <- 0.02
    v_vals <- seq(200, 1400, by=200)
    apl_vals <- numeric(length(v_vals))  # to store average path length
    set.seed(42)  # for reproducibility
    
    # Write here the solution

Solution

    # Generate a series of Erdős-Rényi graphs with p = .02 and increas-
    # ing number of nodes, from 200 to 1, 400 with increments of 200.
    # Make a plot with the |V | value on the x axis and the average path
    # length on the y axis. Since the graph might not be connected, only
    # consider the largest connected component. How does the APL
    # scale with the number of nodes?
    
    library(here)
    library(igraph)
    
    # Setting parameters
    p <- 0.02
    v_vals <- seq(200, 1400, by=200)
    apl_vals <- numeric(length(v_vals))  # to store average path length
    set.seed(42)  # for reproducibility
    
    # Solution 
    
    # Generating Graphs and extracting the largest connected component
    for (i in seq_along(v_vals)) {
      n <- v_vals[i]
      g <- sample_gnp(n, p, directed=FALSE)
      
      # Extract the largest connected component
      comps <- components(g)
      giant <- which.max(comps$csize)
      v_giant <- V(g)[comps$membership == giant]
      g_giant <- induced_subgraph(g, v_giant)
      
      # Compute average path length
      apl_vals[i] <- average.path.length(g_giant)
    }
    
    # Plotting the result 
    plot(v_vals, apl_vals, type="b", pch=19, col="blue",
         xlab="Number of nodes (|V|)", ylab="Average Path Length (APL)",
         main="APL of Erdős-Rényi Graphs (p = 0.02)")
    
    # Interpretation
    
    # - The APL in Erdős-Rényi graphs typically grows like (\log(|V|)) for fixed (p)
    # (if the graph is connected or for the giant component).
    
    # - Your plot should show a slowly increasing curve, roughly resembling a 
    # logarithmic function

16.7.4

Problem

    # Generate an Erdős-Rényi graph with the same number of nodes
    # and edges as the network used for question 1. Calculate and
    # compare the networks’ clustering coefficients. Compare this with
    # the connection probability p of the random graph (which you
    # should derive from the number of edges and number of nodes
    # using the formula I show in this chapter).
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Number of nodes and edges
    n_nodes <- vcount(g)
    n_edges <- ecount(g)
    
    # Write here the solution

Solution

    # Generate an Erdős-Rényi graph with the same number of nodes
    # and edges as the network used for question 1. Calculate and
    # compare the networks’ clustering coefficients. Compare this with
    # the connection probability p of the random graph (which you
    # should derive from the number of edges and number of nodes
    # using the formula I show in this chapter).
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Number of nodes and edges
    n_nodes <- vcount(g)
    n_edges <- ecount(g)
    
    # Solution 
    
    # ER connection probability
    p_er <- 2 * n_edges / (n_nodes * (n_nodes - 1))
    cat("Nodes:", n_nodes, "Edges:", n_edges, "\n")
    cat("Connection probability p (ER):", p_er, "\n")
    
    # Generating ER random graph
    set.seed(42)
    g_er <- sample_gnm(n_nodes, n_edges, directed=FALSE)
    
    # Clustering coefficients
    cc_real <- transitivity(g, type="global")
    cc_er   <- transitivity(g_er, type="global")
    cat("Clustering coefficient (real network):", cc_real, "\n")
    cat("Clustering coefficient (ER):", cc_er, "\n")
    
    ################################################################################
    # Optional
    # Plotting both graphs side by side
    par(mfrow=c(1,2), mar=c(1,1,2,1))
    plot(g,
         vertex.size=5,
         vertex.label=NA,
         edge.arrow.size=0.5,
         layout=layout_with_fr,
         main="Original Network")
    plot(g_er,
         vertex.size=5,
         vertex.label=NA,
         edge.arrow.size=0.5,
         layout=layout_with_fr,
         main="Erdős-Rényi Random Graph")
    par(mfrow=c(1,1))
    ################################################################################

17.5.1

Problem

    # Generate a connected caveman graph with 10 cliques, each with
    # 10 nodes. Generate a small world graph with 100 nodes, each
    # connected to 8 of their neighbors. Add shortcuts for each edge
    # with probability of .05. The two graphs have approximately the
    # same number of edges. Compare their clustering coefficients and
    # their average path lengths.
    
    library(here)
    library(igraph)
    
    ##################### Making graphs #####################
    # g_cave <- make_connected_caveman(10, 10) # sostitute of this line
    
    # Parameters
    num_cliques <- 10
    clique_size <- 10
    
    # Create empty graph
    g_cave <- make_empty_graph(n = 0, directed = FALSE)
    
    # Add cliques one by one
    for (i in 0:(num_cliques-1)) {
      # Each clique's nodes
      nodes <- (i*clique_size + 1):((i+1)*clique_size)
      clique <- make_full_graph(clique_size)
      # Relabel the clique to correct node numbers
      clique <- set_vertex_attr(clique, "name", value=as.character(nodes))
      # Union with the main graph
      g_cave <- g_cave %u% clique
    }
    
    # Connect each clique to the next by rewiring one edge
    for (i in 1:(num_cliques-1)) {
      g_cave <- add_edges(g_cave, c(i*clique_size, i*clique_size + 1))
    }
    
    # Last graph 
    g_sw <- sample_smallworld(dim=1, size=100, nei=4, p=0.05)
    
    #####################               #####################
    
    # Write here the solution

Solution

    # Generate a connected caveman graph with 10 cliques, each with
    # 10 nodes. Generate a small world graph with 100 nodes, each
    # connected to 8 of their neighbors. Add shortcuts for each edge
    # with probability of .05. The two graphs have approximately the
    # same number of edges. Compare their clustering coefficients and
    # their average path lengths.
    
    library(here)
    library(igraph)
    
    ##################### Making graphs #####################
    # g_cave <- make_connected_caveman(10, 10) # Error at this line, but 
    
    # Parameters
    num_cliques <- 10
    clique_size <- 10
    
    # Create empty graph
    g_cave <- make_empty_graph(n = 0, directed = FALSE)
    
    # Add cliques one by one
    for (i in 0:(num_cliques-1)) {
      # Each clique's nodes
      nodes <- (i*clique_size + 1):((i+1)*clique_size)
      clique <- make_full_graph(clique_size)
      # Relabel the clique to correct node numbers
      clique <- set_vertex_attr(clique, "name", value=as.character(nodes))
      # Union with the main graph
      g_cave <- g_cave %u% clique
    }
    
    # Connect each clique to the next by rewiring one edge
    for (i in 1:(num_cliques-1)) {
      g_cave <- add_edges(g_cave, c(i*clique_size, i*clique_size + 1))
    }
    
    # last graph 
    g_sw <- sample_smallworld(dim=1, size=100, nei=4, p=0.05)
    
    #####################               #####################
    
    # Solution 
    
    # Edge counting (for comparison)
    cat("Caveman edges:", ecount(g_cave), "\n")
    cat("Small world edges:", ecount(g_sw), "\n")
    
    # Clustering coefficients
    cc_cave <- transitivity(g_cave, type="global")
    cc_sw   <- transitivity(g_sw, type="global")
    
    # Average path lengths
    apl_cave <- average.path.length(g_cave)
    apl_sw   <- average.path.length(g_sw)
    
    cat("Caveman clustering coefficient:", cc_cave, "\n")
    cat("Small world clustering coefficient:", cc_sw, "\n")
    cat("Caveman average path length:", apl_cave, "\n")
    cat("Small world average path length:", apl_sw, "\n")
    
    ################################################################################
    # Optional:
    # Plotting both graphs side by side
    
    par(mfrow=c(1,2), mar=c(1,1,2,1))
    plot(g_cave,
         vertex.size=5,
         vertex.label=NA,
         edge.arrow.size=0.5,
         layout=layout_with_fr,
         main="Connected Caveman Graph")
    plot(g_sw,
         vertex.size=5,
         vertex.label=NA,
         edge.arrow.size=0.5,
         layout=layout_with_fr,
         main="Small World Graph")
    par(mfrow=c(1,1))
    ################################################################################

17.5.2

Problem

    # Generate a preferential attachment network with 2, 000 nodes and
    # average degree of 2. Estimate its degree distribution exponent
    # (you can use either the powerlaw package, or do a simple log-log
    # regression of the CCDF).
    
    library(here)
    library(igraph)
    
    # Generate the network
    set.seed(42)
    g <- sample_pa(n = 2000, m = 1, directed = FALSE)
    
    # Write here the solution

Solution

    # Generate a preferential attachment network with 2, 000 nodes and
    # average degree of 2. Estimate its degree distribution exponent
    # (you can use either the powerlaw package, or do a simple log-log
    # regression of the CCDF).
    
    library(here)
    library(igraph)
    
    # Generate the network
    set.seed(42)
    g <- sample_pa(n = 2000, m = 1, directed = FALSE)
    
    # Solution 
    
    # Calculating the degree sequence
    deg <- degree(g)
    
    # Computing the CCDF (Complementary Cumulative Distribution Function)
    deg_tab <- table(deg)
    deg_vals <- as.numeric(names(deg_tab))
    deg_prob <- as.numeric(deg_tab) / sum(deg_tab)
    ccdf <- rev(cumsum(rev(deg_prob)))
    
    # Log-log regression (excluding degree 0)
    min_deg <- 1
    sel <- deg_vals >= min_deg
    log_k <- log(deg_vals[sel])
    log_ccdf <- log(ccdf[sel])
    
    fit <- lm(log_ccdf ~ log_k)
    gamma_est <- -coef(fit)[2] + 1
    
    # Plotting the results
    plot(deg_vals, ccdf, log="xy", xlab="Degree (k)", ylab="CCDF", pch=19,
         main="Degree CCDF (log-log) for Preferential Attachment")
    abline(fit, col="red")
    legend("bottomleft", legend=paste("Estimated gamma =", round(gamma_est, 2)), bty="n")
    
    # Printing last elaboration
    cat("Estimated power-law exponent (gamma):", gamma_est, "\n")

17.5.3

Problem

    # Implement the link selection model to grow the graph in http:
    # //www.networkatlas.eu/exercises/17/3/data.txt to 2, 000 nodes
    # (for each incoming node, copy 2 edges already present in the net-
    # work). Compare the number of edges and the degree distribution
    # exponent with a preferential attachment network with 2, 000 nodes
    # and average degree of 2.
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE)
    # Finding all unique node labels and create a mapping to 1:N
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    
    # Remapping the edge list
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    
    # Building the graph
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Implement the link selection model to grow the graph in http:
    # //www.networkatlas.eu/exercises/17/3/data.txt to 2, 000 nodes
    # (for each incoming node, copy 2 edges already present in the net-
    # work). Compare the number of edges and the degree distribution
    # exponent with a preferential attachment network with 2, 000 nodes
    # and average degree of 2.
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE)
    # Finding all unique node labels and create a mapping to 1:N
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    
    # Remapping the edge list
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    
    # Building the graph
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution
    
    # Growing with link selection model
    set.seed(42)
    while (vcount(g) < 2000) {
      new_node <- vcount(g) + 1
      edge_indices <- sample(ecount(g), 2, replace=FALSE)
      ends_mat <- ends(g, edge_indices)
      targets <- apply(ends_mat, 1, function(x) sample(x, 1))
      g <- add_vertices(g, 1)
      g <- add_edges(g, c(rbind(new_node, targets)))
    }
    
    # Preferential attachment
    g_pa <- sample_pa(n=2000, m=1, directed=FALSE)
    
    # Compare edge counts
    cat("Link selection graph edges:", ecount(g), "\n")
    cat("Preferential attachment graph edges:", ecount(g_pa), "\n")
    
    # Degree exponents
    degree_exp <- function(g) {
      deg <- degree(g)
      tab <- table(deg)
      deg_vals <- as.numeric(names(tab))
      deg_prob <- as.numeric(tab) / sum(tab)
      ccdf <- rev(cumsum(rev(deg_prob)))
      sel <- deg_vals >= 1
      fit <- lm(log(ccdf[sel]) ~ log(deg_vals[sel]))
      gamma <- -coef(fit)[2] + 1
      list(gamma=gamma, deg_vals=deg_vals, ccdf=ccdf, fit=fit)
    }
    le <- degree_exp(g)
    pa <- degree_exp(g_pa)
    
    cat(sprintf("Link selection model degree exponent: %.2f\n", le$gamma))
    cat(sprintf("Preferential attachment degree exponent: %.2f\n", pa$gamma))
    
    # Plotting degree distributions
    plot(le$deg_vals, le$ccdf, log="xy", col="blue", pch=19,
         xlab="Degree (k)", ylab="CCDF", main="Degree CCDF (log-log)",
         xlim=c(1, max(le$deg_vals, pa$deg_vals)), ylim=c(1e-4, 1))
    points(pa$deg_vals, pa$ccdf, col="red", pch=19)
    legend("bottomleft", legend=c("Link selection", "Pref. Attach."),
           col=c("blue", "red"), pch=19)

17.5.4

Problem

    # Implement the copying model to grow the graph in http://www.
    # networkatlas.eu/exercises/17/4/data.txt to 2, 000 nodes (for
    # each incoming node, copy one edge from 2 nodes already present
    # in the network). Compare the number of edges and the degree
    # distribution exponent with networks generated with the strategies
    # from the previous two questions.
    
    library(here)
    library(igraph)
    
    # Reading and remapping edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Implement the copying model to grow the graph in http://www.
    # networkatlas.eu/exercises/17/4/data.txt to 2, 000 nodes (for
    # each incoming node, copy one edge from 2 nodes already present
    # in the network). Compare the number of edges and the degree
    # distribution exponent with networks generated with the strategies
    # from the previous two questions.
    
    library(here)
    library(igraph)
    
    # Reading and remapping edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution 
    
    # Growing with copying model
    set.seed(42)
    while (vcount(g) < 2000) {
      new_node <- vcount(g) + 1
      existing_nodes <- sample(1:(new_node-1), 2, replace=FALSE)
      targets <- c()
      for (v in existing_nodes) {
        neighbors_v <- neighbors(g, v)
        if (length(neighbors_v) > 0) {
          tgt <- sample(neighbors_v, 1)
          targets <- c(targets, tgt)
        } else {
          targets <- c(targets, sample(1:(new_node-1), 1))
        }
      }
      g <- add_vertices(g, 1)
      g <- add_edges(g, c(rbind(new_node, targets)))
    }
    
    # Preferential attachment
    g_pa <- sample_pa(2000, m=1, directed=FALSE)
    
    # Exponent estimation
    estimate_exponent <- function(graph) {
      deg <- degree(graph)
      deg_tab <- table(deg)
      deg_vals <- as.numeric(names(deg_tab))
      deg_prob <- as.numeric(deg_tab) / sum(deg_tab)
      ccdf <- rev(cumsum(rev(deg_prob)))
      sel <- deg_vals >= 1
      fit <- lm(log(ccdf[sel]) ~ log(deg_vals[sel]))
      gamma <- -coef(fit)[2] + 1
      list(gamma=gamma, deg_vals=deg_vals, ccdf=ccdf, fit=fit)
    }
    
    exp_copy <- estimate_exponent(g)
    exp_pa <- estimate_exponent(g_pa)
    
    # Printing the results 
    
    cat("Copying model edges:", ecount(g), "\n")
    cat(sprintf("Copying model degree exponent: %.2f\n", exp_copy$gamma))
    cat("Pref. attach. model edges:", ecount(g_pa), "\n")
    cat(sprintf("Pref. attach. model degree exponent: %.2f\n", exp_pa$gamma))
    
    # Plotting the results
    plot(exp_copy$deg_vals, exp_copy$ccdf, log="xy", col="blue", pch=19,
         xlab="Degree (k)", ylab="CCDF", main="Degree CCDF (log-log)",
         xlim=c(1, max(exp_copy$deg_vals, exp_pa$deg_vals)), ylim=c(1e-4, 1))
    points(exp_pa$deg_vals, exp_pa$ccdf, col="red", pch=19)
    legend("bottomleft", legend=c("Copying model", "Pref. Attach."),
           col=c("blue", "red"), pch=19)

18.6.1

Problem

    # Generate a configuration model with the same degree distribution
    # as the network in http://www.networkatlas.eu/exercises/18/1/
    # data.txt. Perform the Kolmogorov-Smirnov test between the two
    # degree distributions.
    
    library(here)
    library(igraph)
    
    # Reading edge list and remapping node IDs
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Generate a configuration model with the same degree distribution
    # as the network in http://www.networkatlas.eu/exercises/18/1/
    # data.txt. Perform the Kolmogorov-Smirnov test between the two
    # degree distributions.
    
    library(here)
    library(igraph)
    
    # Reading edge list and remapping node IDs
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution
    
    # Creating configuration model with the same degree distribution
    deg_seq <- degree(g)
    g_conf <- sample_degseq(deg_seq, method="simple")
    
    # Kolmogorov-Smirnov test
    deg_g <- degree(g)
    deg_conf <- degree(g_conf)
    ks <- ks.test(deg_g, deg_conf)
    print(ks)
    
    ################################################################################
    # OptionaL
    # Plotting the graph
    hist(deg_g, breaks=50, col=rgb(0,0,1,0.5), xlim=range(c(deg_g, deg_conf)), 
         xlab="Degree", main="Degree Distributions")
    hist(deg_conf, breaks=50, col=rgb(1,0,0,0.5), add=TRUE)
    legend("topright", legend=c("Original", "Config Model"), fill=c(rgb(0,0,1,0.5), rgb(1,0,0,0.5)))
    ################################################################################

18.6.2

Problem

    # Remove the self-loops and parallel edges from the synthetic
    # network you generated in the previous question. Note the % of
    # edges you lost. Re-perform the Kolmogorov-Smirnov test with the
    # original network’s degree distribution.
    
    library(here)
    library(igraph)
    
    # Reading edge list and remapping node IDs
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Creating configuration model with the same degree distribution
    deg_seq <- degree(g)
    g_conf <- sample_degseq(deg_seq, method="simple")
    
    # Write here the solution

Solution

    # Remove the self-loops and parallel edges from the synthetic
    # network you generated in the previous question. Note the % of
    # edges you lost. Re-perform the Kolmogorov-Smirnov test with the
    # original network’s degree distribution.
    
    library(here)
    library(igraph)
    
    # Reading edge list and remapping node IDs
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Creating configuration model with the same degree distribution
    deg_seq <- degree(g)
    g_conf <- sample_degseq(deg_seq, method="simple")
    
    # Solution 
    
    # Removing self-loops and parallel edges
    g_conf_simple <- simplify(g_conf, remove.multiple=TRUE, remove.loops=TRUE)
    
    # Calculating % of edges lost
    edges_before <- ecount(g_conf)
    edges_after <- ecount(g_conf_simple)
    percent_lost <- 100 * (edges_before - edges_after) / edges_before
    cat(sprintf("Percentage of edges lost: %.2f%%\n", percent_lost))
    
    # KS test again
    deg_g <- degree(g)
    deg_conf_simple <- degree(g_conf_simple)
    ks2 <- ks.test(deg_g, deg_conf_simple)
    print(ks2)
    
    ################################################################################
    # OptionaL
    # Plotting the result
    hist(deg_g, breaks=50, col=rgb(0,0,1,0.5), xlim=range(c(deg_g, deg_conf_simple)), 
         xlab="Degree", main="Degree Distributions (Simple)")
    hist(deg_conf_simple, breaks=50, col=rgb(1,0,0,0.5), add=TRUE)
    legend("topright", legend=c("Original", "Config Model (simple)"), 
           fill=c(rgb(0,0,1,0.5), rgb(1,0,0,0.5)))
    ################################################################################

18.6.3

Problem

    # Generate an LFR benchmark with 100, 000 nodes, a degree expo-
    # nent α = 3.13, a community exponent of 1.1, a mixing parameter
    # µ = 0.1, average degree of 10, and minimum community size of
    # 10, 000. (Note: there’s a networkx function to do this). Can you
    # recover the α value by fitting the degree distribution?
    
    library(here)
    library(igraph)
    
    # Solution

Solution

    # Generate an LFR benchmark with 100, 000 nodes, a degree expo-
    # nent α = 3.13, a community exponent of 1.1, a mixing parameter
    # µ = 0.1, average degree of 10, and minimum community size of
    # 10, 000. (Note: there’s a networkx function to do this). Can you
    # recover the α value by fitting the degree distribution?
    
    library(here)
    library(igraph)
    
    # Solution 
    
    # Generating LFR benchmark
    set.seed(123)
    g_lfr <- sample_lfr(
      n = 100000,
      tau1 = 3.13,
      tau2 = 1.1,
      mu = 0.1,
      average_degree = 10,
      min_community = 10000
    )
    
    # Estimating alpha (degree exponent)
    deg <- degree(g_lfr)
    deg_tab <- table(deg)
    deg_vals <- as.numeric(names(deg_tab))
    deg_prob <- as.numeric(deg_tab) / sum(deg_tab)
    ccdf <- rev(cumsum(rev(deg_prob)))
    
    sel <- deg_vals > 0
    log_k <- log(deg_vals[sel])
    log_ccdf <- log(ccdf[sel])
    
    fit <- lm(log_ccdf ~ log_k)
    alpha_est <- -coef(fit)[2] + 1
    
    cat(sprintf("Recovered degree exponent (alpha): %.2f\n", alpha_est))
    
    ################################################################################
    # Optional
    # Plotting the results
    plot(deg_vals, ccdf, log="xy", xlab="Degree (k)", ylab="CCDF", pch=19, main="LFR Degree Distribution")
    abline(fit, col="red")
    legend("bottomleft", legend=paste("α =", round(alpha_est, 2)), bty="n")
    ################################################################################

18.6.4

Problem

    # Use kron function from numpy to implement a Kronecker graph
    # generator. Plot the CCDF degree distribution of a Kronecker graph
    # with the following seed matrix multiplied 4 times (setting the main
    # diagonal to zero once you’re done):
    
    #     1 1 1 0
    # A = 1 1 1 0
    #     1 1 1 1 
    #     0 0 1 1 
    
    library(here)
    library(igraph)
    
    # Defining the seed matrix
    A <- matrix(c(
      1, 1, 1, 0,
      1, 1, 1, 0,
      1, 1, 1, 1,
      0, 0, 1, 1
    ), nrow=4, byrow=TRUE)
    
    # Write here the solution

Solution

    # Use kron function from numpy to implement a Kronecker graph
    # generator. Plot the CCDF degree distribution of a Kronecker graph
    # with the following seed matrix multiplied 4 times (setting the main
    # diagonal to zero once you’re done):
    
    #     1 1 1 0
    # A = 1 1 1 0
    #     1 1 1 1 
    #     0 0 1 1 
    
    library(here)
    library(igraph)
    
    # Defining the seed matrix
    A <- matrix(c(
      1, 1, 1, 0,
      1, 1, 1, 0,
      1, 1, 1, 1,
      0, 0, 1, 1
    ), nrow=4, byrow=TRUE)
    
    # Solution 
    
    # Kronecker multiply 4 times
    K <- A
    for (i in 1:3) {
      K <- K %x% A
    }
    
    # Setting main diagonal to zero
    diag(K) <- 0
    
    # Creating the graph
    g <- graph_from_adjacency_matrix(K, mode="undirected", diag=FALSE)
    
    ################################################################################
    # Optional 
    # Plotting the CCDF of the degree distribution
    deg <- degree(g)
    deg_tab <- table(deg)
    deg_vals <- as.numeric(names(deg_tab))
    deg_prob <- as.numeric(deg_tab) / sum(deg_tab)
    ccdf <- rev(cumsum(rev(deg_prob)))
    plot(deg_vals, ccdf, log="xy", pch=19, xlab="Degree", ylab="CCDF", main="Kronecker Graph Degree CCDF")
    ################################################################################

19.4.1

Problem

    # Perform 1, 000 edge swaps, creating a null version of the network
    # in http://www.networkatlas.eu/exercises/19/1/data.txt. Make
    # sure you don’t create parallel edges. Calculate the Kolmogorov-
    # Smirnov distance between the two degree distributions. Can you
    # tell the difference?
    
    library(here)
    library(igraph)
    
    # Reading data and create the graph
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Perform 1, 000 edge swaps, creating a null version of the network
    # in http://www.networkatlas.eu/exercises/19/1/data.txt. Make
    # sure you don’t create parallel edges. Calculate the Kolmogorov-
    # Smirnov distance between the two degree distributions. Can you
    # tell the difference?
    
    library(here)
    library(igraph)
    
    # Reading data and create the graph
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution 
    
    # Performing 1,000 edge swaps (null model)
    set.seed(42)
    g_null <- rewire(g, with = keeping_degseq(niter = 1000))
    
    # Kolmogorov-Smirnov test
    deg_orig <- degree(g)
    deg_null <- degree(g_null)
    ks <- ks.test(deg_orig, deg_null)
    cat("Kolmogorov-Smirnov D-statistic:", ks$statistic, "\n")
    cat("p-value:", ks$p.value, "\n")
    
    ################################################################################
    # Optional 
    # Creating a graph
    
    hist(deg_orig, breaks=30, col=rgb(0,0,1,0.5), xlim=range(c(deg_orig, deg_null)), 
         main="Degree Distributions", xlab="Degree")
    hist(deg_null, breaks=30, col=rgb(1,0,0,0.5), add=TRUE)
    legend("topright", legend=c("Original", "Null (1000 swaps)"), 
           fill=c(rgb(0,0,1,0.5), rgb(1,0,0,0.5)))
    ################################################################################

19.4.2

Problem

    # Do you get larger KS distances if you perform 2, 000 swaps? Do
    # you get smaller KS distances if you perform 500?
    
    library(here)
    library(igraph)
    
    # Reading data and Creating the graph
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Do you get larger KS distances if you perform 2, 000 swaps? Do
    # you get smaller KS distances if you perform 500?
    
    library(here)
    library(igraph)
    
    # Reading data and Creating the graph
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution 
    
    # Function to perform swaps and return KS statistic
    ks_for_swaps <- function(g, n_swaps) {
      set.seed(42)
      g_null <- rewire(g, with = keeping_degseq(niter = n_swaps))
      deg_orig <- degree(g)
      deg_null <- degree(g_null)
      ks <- ks.test(deg_orig, deg_null)
      return(ks$statistic)
    }
    
    ks_500 <- ks_for_swaps(g, 500)
    ks_1000 <- ks_for_swaps(g, 1000)
    ks_2000 <- ks_for_swaps(g, 2000)
    
    cat("KS statistic for 500 swaps: ", ks_500, "\n")
    cat("KS statistic for 1000 swaps:", ks_1000, "\n")
    cat("KS statistic for 2000 swaps:", ks_2000, "\n")

19.4.3

Problem

    # Generate 50 Gn,m null versions of the network in http://www.
    # networkatlas.eu/exercises/19/3/data.txt, respecting the number
    # of nodes and edges. Derive the number of standard deviations
    # between the observed values and the null average of clustering
    # and average path length. (Consider only the largest connected
    # component) Which of these two is statistically significant?
    
    library(here)
    library(igraph)
    
    # Reading the data and creating the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Generate 50 Gn,m null versions of the network in http://www.
    # networkatlas.eu/exercises/19/3/data.txt, respecting the number
    # of nodes and edges. Derive the number of standard deviations
    # between the observed values and the null average of clustering
    # and average path length. (Consider only the largest connected
    # component) Which of these two is statistically significant?
    
    library(here)
    library(igraph)
    
    # Reading the data and creating the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution 
    
    # Largest component
    cl <- clusters(g)
    giant <- induced_subgraph(g, which(cl$membership == which.max(cl$csize)))
    n <- vcount(giant)
    m <- ecount(giant)
    
    # Observed stats
    obs_clustering <- transitivity(giant, type="global")
    obs_path <- average.path.length(giant)
    
    # Null models
    null_clustering <- numeric(50)
    null_path <- numeric(50)
    set.seed(42)
    for (i in 1:50) {
      null_g <- erdos.renyi.game(n, m, type="gnm", directed=FALSE)
      comps <- clusters(null_g)
      largest <- induced_subgraph(null_g, which(comps$membership == which.max(comps$csize)))
      null_clustering[i] <- transitivity(largest, type="global")
      null_path[i] <- average.path.length(largest)
    }
    
    # Z-scores
    mean_clust <- mean(null_clustering)
    sd_clust <- sd(null_clustering)
    z_clust <- (obs_clustering - mean_clust) / sd_clust
    
    mean_path <- mean(null_path)
    sd_path <- sd(null_path)
    z_path <- (obs_path - mean_path) / sd_path
    
    cat(sprintf("Observed clustering: %.4f\n", obs_clustering))
    cat(sprintf("Null mean clustering: %.4f, SD: %.4f, z-score: %.2f\n", mean_clust, sd_clust, z_clust))
    cat(sprintf("Observed avg path: %.4f\n", obs_path))
    cat(sprintf("Null mean avg path: %.4f, SD: %.4f, z-score: %.2f\n", mean_path, sd_path, z_path))
    
    ################################################################################
    # Optional 
    # printing a plot of the network 
    plot(
      giant,
      vertex.size = 4,
      vertex.label = NA,
      edge.arrow.size = 0.3,
      main = "Largest Connected Component"
    )
    ################################################################################

19.4.4

Problem

    # Repeat the experiment in the previous question, but now generate
    # 50 Watts-Strogatz small world models, with the same number of
    # nodes as the original network and setting k = 16 and p = 0.1.
    
    library(here)
    library(igraph)
    
    # Reading the data and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Repeat the experiment in the previous question, but now generate
    # 50 Watts-Strogatz small world models, with the same number of
    # nodes as the original network and setting k = 16 and p = 0.1.
    
    library(here)
    library(igraph)
    
    # Reading the data and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    
    # Solution 
    
    # Largest component
    cl <- clusters(g)
    giant <- induced_subgraph(g, which(cl$membership == which.max(cl$csize)))
    n <- vcount(giant)
    
    # Observed stats
    obs_clustering <- transitivity(giant, type="global")
    obs_path <- average.path.length(giant)
    
    # Watts-Strogatz null models
    ws_clustering <- numeric(50)
    ws_path <- numeric(50)
    set.seed(42)
    for (i in 1:50) {
      ws_g <- sample_smallworld(dim=1, size=n, nei=8, p=0.1) # k=16 -> nei=8
      comps <- clusters(ws_g)
      largest <- induced_subgraph(ws_g, which(comps$membership == which.max(comps$csize)))
      ws_clustering[i] <- transitivity(largest, type="global")
      ws_path[i] <- average.path.length(largest)
    }
    
    # Z-scores
    mean_clust <- mean(ws_clustering)
    sd_clust <- sd(ws_clustering)
    z_clust <- (obs_clustering - mean_clust) / sd_clust
    
    mean_path <- mean(ws_path)
    sd_path <- sd(ws_path)
    z_path <- (obs_path - mean_path) / sd_path
    
    cat(sprintf("Observed clustering: %.4f\n", obs_clustering))
    cat(sprintf("WS mean clustering: %.4f, SD: %.4f, z-score: %.2f\n", mean_clust, sd_clust, z_clust))
    cat(sprintf("Observed avg path: %.4f\n", obs_path))
    cat(sprintf("WS mean avg path: %.4f, SD: %.4f, z-score: %.2f\n", mean_path, sd_path, z_path))
    
    ################################################################################
    # Optional 
    # Plotting the graph
    plot(
      giant,
      vertex.size = 4,
      vertex.label = NA,
      edge.arrow.size = 0.3,
      main = "Largest Connected Component"
    )
    ################################################################################

20.5.1

Problem

    # Implement an SI model on the network at http://www.networkatlas.
    # eu/exercises/20/1/data.txt. Run it 10 times with different β values:
    # 0.05, 0.1, and 0.2. For each run (in this and all following
    # questions) pick a random node and place it in the Infected state.
    # What’s the average time step in which each of those β infects 80%
    # of the network?
    
    library(here)
    library(igraph)
    
    # Reading the data and build the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # Write here the solution

Solution

    # Implement an SI model on the network at http://www.networkatlas.
    # eu/exercises/20/1/data.txt. Run it 10 times with different β values:
    # 0.05, 0.1, and 0.2. For each run (in this and all following
    # questions) pick a random node and place it in the Infected state.
    # What’s the average time step in which each of those β infects 80%
    # of the network?
    
    library(here)
    library(igraph)
    
    # Reading the data and build the graph 
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # Solution 
    
    # SI simulation function
    SI_simulation <- function(g, beta, target_frac=0.8) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      # Random initial infected node
      patient_zero <- sample(1:N, 1)
      infected[patient_zero] <- TRUE
      t <- 0
      num_infected <- 1
      while (num_infected < target_frac * N) {
        t <- t + 1
        new_infected <- infected
        # For each infected node, infect susceptible neighbors with probability beta
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && runif(1) < beta) {
              new_infected[nbr_idx] <- TRUE
            }
          }
        }
        if (sum(new_infected) == num_infected) break # no more infections
        infected <- new_infected
        num_infected <- sum(infected)
      }
      return(t)
    }
    
    # Run simulations for each beta
    betas <- c(0.05, 0.1, 0.2)
    results <- data.frame(beta=numeric(), avg_time=numeric())
    set.seed(123)
    
    # Printing the results 
    
    for (b in betas) {
      times <- numeric(10)
      for (i in 1:10) {
        times[i] <- SI_simulation(g, b, target_frac=0.8)
      }
      avg_t <- mean(times)
      cat(sprintf("Beta = %.2f: average time to 80%% infected = %.2f (over 10 runs)\n", b, avg_t))
      results <- rbind(results, data.frame(beta=b, avg_time=avg_t))
    }
    
    print(results)

20.5.2

Problem

    # Run the same SI model on the network at http://www.networkatlas.
    # eu/exercises/20/2/data.txt as well. One of the two networks is
    # a Gn,p graph while the other has a power law degree distribution.
    # Can you tell which is which by how much the disease takes to
    # infect 80% of the network for the same starting conditions used in
    # the previous question?
    
    library(here)
    library(igraph)
    
    # Loading data and remapping the first network 
    edges1 <- read.table("data1.txt", header=FALSE)
    nodes1 <- unique(c(edges1$V1, edges1$V2))
    map1 <- setNames(seq_along(nodes1), nodes1)
    edges1_mapped <- as.data.frame(lapply(edges1, function(col) map1[as.character(col)]))
    g1 <- graph_from_edgelist(as.matrix(edges1_mapped), directed=FALSE)
    
    # Loading data and remapping the second network 
    edges2 <- read.table("data2.txt", header=FALSE)
    nodes2 <- unique(c(edges2$V1, edges2$V2))
    map2 <- setNames(seq_along(nodes2), nodes2)
    edges2_mapped <- as.data.frame(lapply(edges2, function(col) map2[as.character(col)]))
    g2 <- graph_from_edgelist(as.matrix(edges2_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Run the same SI model on the network at http://www.networkatlas.
    # eu/exercises/20/2/data.txt as well. One of the two networks is
    # a Gn,p graph while the other has a power law degree distribution.
    # Can you tell which is which by how much the disease takes to
    # infect 80% of the network for the same starting conditions used in
    # the previous question?
    
    library(here)
    library(igraph)
    
    # Loading data and remapping the first network 
    edges1 <- read.table("data1.txt", header=FALSE)
    nodes1 <- unique(c(edges1$V1, edges1$V2))
    map1 <- setNames(seq_along(nodes1), nodes1)
    edges1_mapped <- as.data.frame(lapply(edges1, function(col) map1[as.character(col)]))
    g1 <- graph_from_edgelist(as.matrix(edges1_mapped), directed=FALSE)
    
    # Loading data and remapping the second network 
    edges2 <- read.table("data2.txt", header=FALSE)
    nodes2 <- unique(c(edges2$V1, edges2$V2))
    map2 <- setNames(seq_along(nodes2), nodes2)
    edges2_mapped <- as.data.frame(lapply(edges2, function(col) map2[as.character(col)]))
    g2 <- graph_from_edgelist(as.matrix(edges2_mapped), directed=FALSE)
    
    # Solution 
    
    # Creating SI Model Function
    SI_simulation <- function(g, beta, target_frac=0.8) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      patient_zero <- sample(1:N, 1)
      infected[patient_zero] <- TRUE
      t <- 0
      num_infected <- 1
      while (num_infected < target_frac * N) {
        t <- t + 1
        new_infected <- infected
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && runif(1) < beta) {
              new_infected[nbr_idx] <- TRUE
            }
          }
        }
        if (sum(new_infected) == num_infected) break
        infected <- new_infected
        num_infected <- sum(infected)
      }
      return(t)
    }
    
    # Running SI Simulations on Both Networks
    set.seed(42)
    betas <- c(0.05, 0.1, 0.2)
    results1 <- data.frame(beta=betas, avg_time=NA)
    results2 <- data.frame(beta=betas, avg_time=NA)
    
    for (j in seq_along(betas)) {
      b <- betas[j]
      times1 <- times2 <- numeric(10)
      for (i in 1:10) {
        times1[i] <- SI_simulation(g1, b, target_frac=0.8)
        times2[i] <- SI_simulation(g2, b, target_frac=0.8)
      }
      results1$avg_time[j] <- mean(times1)
      results2$avg_time[j] <- mean(times2)
    }
    
    # Printing the results
    print("Network 1 (data1.txt) - avg time to 80% infected:")
    print(results1)
    print("Network 2 (data2.txt) - avg time to 80% infected:")
    print(results2)
    
    # How do you tell which network is which?
    
    
      
    # _Gn,p (Erdős–Rényi random graph):_
    
    #  More homogeneous degree distribution.
    
    #  SI infection spreads moderately fast.
    
    
    
    # _Power law (scale-free) network:_
    
    # Some nodes (hubs) have very high degree.
    
    # SI infection spreads much faster (especially for larger β), as hubs accelerate t
    # he process.
    
    
    
    # So:
    
    
    
    # The network where the disease spreads faster (lower average time to 80% 
    # infected) is the power law (scale-free) network.
    
    # The network where it takes longer is the random (Gn,p) network.

20.5.3

Problem

    # Extend your SI model to an SIS. With β = 0.2, run the model
    # with µ values of 0.05, 0.1, and 0.2 on both networks used in the
    # previous questions. Run the SIS model, with a random node as a
    # starting Infected set, for 100 steps and plot the share of nodes in
    # the Infected state. For which of these values and networks do you
    # have an endemic state? How big is the set of nodes in state I com-
    # pared to the number of nodes in the network? (Note, randomness
    # might affect your results. Run the experiment multiple times)
    
    library(here)
    library(igraph)
    
    # Loading data and remapping the first network 
    edges1 <- read.table("data1.txt", header=FALSE)
    nodes1 <- unique(c(edges1$V1, edges1$V2))
    map1 <- setNames(seq_along(nodes1), nodes1)
    edges1_mapped <- as.data.frame(lapply(edges1, function(col) map1[as.character(col)]))
    g1 <- graph_from_edgelist(as.matrix(edges1_mapped), directed=FALSE)
    
    # Loading data and remapping the second network 
    edges2 <- read.table("data2.txt", header=FALSE)
    nodes2 <- unique(c(edges2$V1, edges2$V2))
    map2 <- setNames(seq_along(nodes2), nodes2)
    edges2_mapped <- as.data.frame(lapply(edges2, function(col) map2[as.character(col)]))
    g2 <- graph_from_edgelist(as.matrix(edges2_mapped), directed=FALSE)
    
    # Write here the solution

Solution

20.5.4

Problem

    # Extend your SI model to an SIR. With β = 0.2, run the model for
    # 400 steps with µ values of 0.01, 0.02, and 0.04 and plot the share of
    # nodes in the Removed state for both the networks used in Q1 and
    # Q2. How quickly does it converge to a full R state network?
    
    library(here)  
    library(igraph)
    
    # Loading data and remapping the first network 
    edges1 <- read.table("data1.txt", header=FALSE)
    nodes1 <- unique(c(edges1$V1, edges1$V2))
    map1 <- setNames(seq_along(nodes1), nodes1)
    edges1_mapped <- as.data.frame(lapply(edges1, function(col) map1[as.character(col)]))
    g1 <- graph_from_edgelist(as.matrix(edges1_mapped), directed=FALSE)
    
    # Loading data and remapping the second network 
    edges2 <- read.table("data2.txt", header=FALSE)
    nodes2 <- unique(c(edges2$V1, edges2$V2))
    map2 <- setNames(seq_along(nodes2), nodes2)
    edges2_mapped <- as.data.frame(lapply(edges2, function(col) map2[as.character(col)]))
    g2 <- graph_from_edgelist(as.matrix(edges2_mapped), directed=FALSE)
    
    # Write here the solution

Solution

    # Extend your SI model to an SIR. With β = 0.2, run the model for
    # 400 steps with µ values of 0.01, 0.02, and 0.04 and plot the share of
    # nodes in the Removed state for both the networks used in Q1 and
    # Q2. How quickly does it converge to a full R state network?
    
    library(here)  
    library(igraph)
      
    # Loading data and remapping the first network 
    edges1 <- read.table("data1.txt", header=FALSE)
    nodes1 <- unique(c(edges1$V1, edges1$V2))
    map1 <- setNames(seq_along(nodes1), nodes1)
    edges1_mapped <- as.data.frame(lapply(edges1, function(col) map1[as.character(col)]))
    g1 <- graph_from_edgelist(as.matrix(edges1_mapped), directed=FALSE)
    
    # Loading data and remapping the second network 
    edges2 <- read.table("data2.txt", header=FALSE)
    nodes2 <- unique(c(edges2$V1, edges2$V2))
    map2 <- setNames(seq_along(nodes2), nodes2)
    edges2_mapped <- as.data.frame(lapply(edges2, function(col) map2[as.character(col)]))
    g2 <- graph_from_edgelist(as.matrix(edges2_mapped), directed=FALSE)
    
    # This should be the Solution 
    
    # Creating SIR Simulation Function
    SIR_simulation <- function(g, beta, mu, steps=400) {
      N <- vcount(g)
      # 0 = S, 1 = I, 2 = R
      state <- rep(0, N)
      state[sample(1:N, 1)] <- 1 # Start with 1 random infected
      removed_frac <- numeric(steps)
      
      for (t in 1:steps) {
        new_state <- state
        for (node in 1:N) {
          if (state[node] == 1) { # Infected
            # Try to infect susceptible neighbors
            nbrs <- neighbors(g, node)
            for (nbr in nbrs) {
              nbr_idx <- as.integer(nbr)
              if (state[nbr_idx] == 0 && runif(1) < beta) {
                new_state[nbr_idx] <- 1
              }
            }
            # Try to recover
            if (runif(1) < mu) {
              new_state[node] <- 2 # Removed
            }
          }
        }
        state <- new_state
        removed_frac[t] <- mean(state == 2)
        # Optional: Breaking if all infected are gone
        if (sum(state == 1) == 0) break
      }
      # Filling remaining with final value if ended early
      if (t < steps) removed_frac[(t+1):steps] <- removed_frac[t]
      return(removed_frac)
    }
    
    # Running and Plotting for All Parameters
    betas <- 0.2
    mus <- c(0.01, 0.02, 0.04)
    steps <- 400
    n_runs <- 10 # For averaging
    
    par(mfrow=c(2,1))
    set.seed(42)
    
    # For each network
    for (net_idx in 1:2) {
      g <- if (net_idx == 1) g1 else g2
      netname <- if (net_idx == 1) "Network 1" else "Network 2"
      
      plot(NULL, xlim=c(1, steps), ylim=c(0, 1), type="n",
           xlab="Time step", ylab="Fraction Removed",
           main=paste0(netname, ": SIR, beta=0.2"))
      
      cols <- c("blue", "red", "green")
      legend_labels <- character()
      
      for (i in seq_along(mus)) {
        mu <- mus[i]
        removed_mat <- matrix(NA, nrow=n_runs, ncol=steps)
        for (r in 1:n_runs) {
          removed_mat[r,] <- SIR_simulation(g, beta=betas, mu=mu, steps=steps)
        }
        avg_removed <- colMeans(removed_mat)
        lines(avg_removed, col=cols[i], lwd=2)
        legend_labels <- c(legend_labels, sprintf("mu=%.2f", mu))
      }
      legend("bottomright", legend=legend_labels, col=cols, lwd=2)
    }
    
    # Interpretation
    
    
    # The plot shows, for each (\mu), how quickly the network approaches the full R 
    # (Removed) state (i.e., everyone recovered).
    
    # Faster convergence = steeper/faster rise in curve.
    
    # Compare across (\mu): higher recovery ((\mu)) generally leads to fewer people 
    # infected at the same time, but the R fraction still eventually reaches 1 if the 
    # network is well connected.
    
    # Time to full R: Look for when the curve first reaches 1 (or very close).
    
    # You may find that the power-law network converges faster or slower depending 
    # on its structure (hubs accelerate infections, but may also get depleted 
    # quickly).

21.6.1

Problem

    # Modify the SI model developed in the exercises of the previous
    # chapter so that it works with a threshold trigger. Set κ = 2 and run
    # the threshold trigger on the network at http://www.networkatlas.
    # eu/exercises/21/1/data.txt. Show the curves of the size of
    # the I state for it (average over 10 runs, each run of 50 steps) and
    # compare it with a simple (no reinforcement) SI model with β =
    # 0.2.
    
    library(here)
    library(igraph)
    
    # Reading the data and remapping the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # Write here the solution

Solution

    # Modify the SI model developed in the exercises of the previous
    # chapter so that it works with a threshold trigger. Set κ = 2 and run
    # the threshold trigger on the network at http://www.networkatlas.
    # eu/exercises/21/1/data.txt. Show the curves of the size of
    # the I state for it (average over 10 runs, each run of 50 steps) and
    # compare it with a simple (no reinforcement) SI model with β =
    # 0.2.
    
    library(here)
    library(igraph)
    
    # Reading the data and remapping the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # This should be the Solution 
    
    # Threshold SI Model (κ = 2)
    threshold_SI <- function(g, kappa=2, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(!infected)) {
          nbrs <- neighbors(g, node)
          if (sum(infected[as.integer(nbrs)]) >= kappa) {
            new_infected[node] <- TRUE
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Classic SI Model (β = 0.2)
    classic_SI <- function(g, beta=0.2, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && runif(1) < beta) {
              new_infected[nbr_idx] <- TRUE
            }
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Running simulations and plotting results
    steps <- 50
    runs <- 10
    set.seed(42)
    
    # Threshold SI
    thr_mat <- replicate(runs, threshold_SI(g, kappa=2, steps=steps))
    thr_mean <- rowMeans(thr_mat)
    
    # Classic SI
    si_mat <- replicate(runs, classic_SI(g, beta=0.2, steps=steps))
    si_mean <- rowMeans(si_mat)
    
    # Plot
    plot(thr_mean, type="l", col="red", lwd=2, ylim=c(0,1),
         ylab="Fraction Infected (I)", xlab="Step", main="Threshold SI vs Classic SI (mean of 10 runs)")
    lines(si_mean, col="blue", lwd=2)
    legend("bottomright", legend=c("Threshold SI (κ=2)", "Classic SI (β=0.2)"),
           col=c("red", "blue"), lwd=2)
    
    # Interpretation
    
    # Threshold SI (κ = 2): Nodes only become infected if at least 2 neighbors are 
    # infected. This usually slows the spread and can sometimes prevent a full 
    # outbreak if the initial conditions or the network structure do not allow cascades.
    
    # Classic SI: Any infected neighbor can transmit, so the epidemic grows faster.
    
    
    
    # _Comparing the curves:_
    
    
    # The blue curve (classic SI) typically rises faster and reaches full infection 
    # sooner.
    
    # The red curve (threshold SI) often rises more slowly, and sometimes may not 
    # reach full infection depending on the network's connectivity.

21.6.2

Problem

    # Modify the SI model developed in the previous exercise so that
    # it works with a cascade trigger. Set β = 0.1 and compare the I
    # infection curves for the three triggers on the network used in the
    # previous exercise (average over 10 runs, each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Read and remap the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # write here the solution

Solution

    # Modify the SI model developed in the previous exercise so that
    # it works with a cascade trigger. Set β = 0.1 and compare the I
    # infection curves for the three triggers on the network used in the
    # previous exercise (average over 10 runs, each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Read and remap the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # this should be the Solution 
    
    # Classic SI (probabilistic trigger, β)
    classic_SI <- function(g, beta=0.2, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && runif(1) < beta) {
              new_infected[nbr_idx] <- TRUE
            }
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Threshold SI (κ = 2)
    threshold_SI <- function(g, kappa=2, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(!infected)) {
          nbrs <- neighbors(g, node)
          if (sum(infected[as.integer(nbrs)]) >= kappa) {
            new_infected[node] <- TRUE
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Cascade SI (each susceptible node with at least one infected neighbor becomes 
    # infected with probability β)
    cascade_SI <- function(g, beta=0.1, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(!infected)) {
          nbrs <- neighbors(g, node)
          if (any(infected[as.integer(nbrs)])) {
            if (runif(1) < beta) {
              new_infected[node] <- TRUE
            }
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Running 10 Simulations and Averaging for Each Model
    steps <- 50
    runs <- 10
    set.seed(42)
    
    # Classic SI (β=0.2 as before)
    classic_mat <- replicate(runs, classic_SI(g, beta=0.2, steps=steps))
    classic_mean <- rowMeans(classic_mat)
    
    # Threshold SI (κ=2)
    threshold_mat <- replicate(runs, threshold_SI(g, kappa=2, steps=steps))
    threshold_mean <- rowMeans(threshold_mat)
    
    # Cascade SI (β=0.1)
    cascade_mat <- replicate(runs, cascade_SI(g, beta=0.1, steps=steps))
    cascade_mean <- rowMeans(cascade_mat)
    
    # Plotting and Comparing Infection Curves
    plot(classic_mean, type="l", col="blue", lwd=2, ylim=c(0,1),
         ylab="Fraction Infected (I)", xlab="Step", main="SI Model Comparison (mean of 10 runs)")
    lines(threshold_mean, col="red", lwd=2)
    lines(cascade_mean, col="darkgreen", lwd=2)
    legend("bottomright",
           legend=c("Classic SI (β=0.2)", "Threshold SI (κ=2)", "Cascade SI (β=0.1)"),
           col=c("blue", "red", "darkgreen"), lwd=2)
    
    # Interpretation
    
    
    # Classic SI: Any infected neighbor can transmit; spread is typically fastest.
    
    # Threshold SI: Infection requires at least κ infected neighbors; spread is 
    # typically slowest.
    
    # Cascade SI: Any susceptible node with at least one infected neighbor can become
    # infected with probability β; spread is intermediate (β-dependent).
    
    # The curves will show you which mechanism leads to faster or slower spread, and 
    # how the final epidemic size differs.

21.6.3

Problem

    # Modify the simple SI model so that nodes become resistant after
    # the second failed infection attempt. Compare the I infection curves
    # of the SI model before and after this operation on the network
    # used in the previous exercise, with β = 0.3 (average over 10 runs,
    # each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Read and remap the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # Write here the solution

Solution

    # Modify the simple SI model so that nodes become resistant after
    # the second failed infection attempt. Compare the I infection curves
    # of the SI model before and after this operation on the network
    # used in the previous exercise, with β = 0.3 (average over 10 runs,
    # each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Read and remap the edge list
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # This should be the Solution 
    
    # Classic SI Model
    classic_SI <- function(g, beta=0.3, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && runif(1) < beta) {
              new_infected[nbr_idx] <- TRUE
            }
          }
        }
        infected <- new_infected
        I_frac[t] <- mean(infected)
        if (all(infected)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Modified SI Model with Resistance after 2 Failed Attempts
    resist_SI <- function(g, beta=0.3, steps=50) {
      N <- vcount(g)
      infected <- rep(FALSE, N)
      resistant <- rep(FALSE, N)
      failed_attempts <- rep(0, N)
      infected[sample(1:N, 1)] <- TRUE
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_infected <- infected
        new_resistant <- resistant
        new_failed <- failed_attempts
        for (node in which(infected)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (!infected[nbr_idx] && !resistant[nbr_idx]) {
              if (runif(1) < beta) {
                new_infected[nbr_idx] <- TRUE
              } else {
                new_failed[nbr_idx] <- new_failed[nbr_idx] + 1
                if (new_failed[nbr_idx] >= 2) {
                  new_resistant[nbr_idx] <- TRUE
                }
              }
            }
          }
        }
        infected <- new_infected
        resistant <- new_resistant
        failed_attempts <- new_failed
        I_frac[t] <- mean(infected)
        if (all(infected | resistant)) break
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(I_frac[length(I_frac)], steps - length(I_frac)))
      return(I_frac)
    }
    
    # Running Simulations and Plotting Results
    steps <- 50
    runs <- 10
    set.seed(42)
    
    # Classic SI
    classic_mat <- replicate(runs, classic_SI(g, beta=0.3, steps=steps))
    classic_mean <- rowMeans(classic_mat)
    
    # Modified SI with resistance
    resist_mat <- replicate(runs, resist_SI(g, beta=0.3, steps=steps))
    resist_mean <- rowMeans(resist_mat)
    
    # Plotting
    plot(classic_mean, type="l", col="blue", lwd=2, ylim=c(0,1),
         ylab="Fraction Infected (I)", xlab="Step",
         main="SI vs SI with Resistance after 2 Failed Attempts (mean of 10 runs)")
    lines(resist_mean, col="red", lwd=2)
    legend("bottomright", legend=c("Classic SI", "Resistant after 2 fails"),
           col=c("blue", "red"), lwd=2)
    
    # Interpretation
    
    
    # The classic SI curve (blue) will typically rise quickly and reach 1 
    # (full infection).
    
    # The resistance SI curve (red) will generally rise more slowly and may plateau 
    # below 1, as some nodes become resistant and never get infected.

21.6.4

Problem

    # Run a classical SIR model on the network used in the previous
    # exercise, but set the recovery probability µ = 0. At each timestep,
    # before the infection phase pick a random node. Pick one random
    # neighbor in status S, if it has one, and transition it to the R state.
    # Compare the I infection curves with and without immunization,
    # with β = 0.1 (average over 10 runs, each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Reading the network
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # Write here the solution

Solution

    # Run a classical SIR model on the network used in the previous
    # exercise, but set the recovery probability µ = 0. At each timestep,
    # before the infection phase pick a random node. Pick one random
    # neighbor in status S, if it has one, and transition it to the R state.
    # Compare the I infection curves with and without immunization,
    # with β = 0.1 (average over 10 runs, each run of 50 steps).
    
    library(here)
    library(igraph)
    
    # Reading the network
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_map <- setNames(seq_along(nodes), nodes)
    edges_mapped <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g <- graph_from_edgelist(as.matrix(edges_mapped), directed=FALSE)
    N <- vcount(g)
    
    # This should be the solution 
    
    # Classic SIR Model (µ = 0, only infection, no recovery)
    classic_SIR <- function(g, beta=0.1, steps=50) {
      N <- vcount(g)
      state <- rep(0, N) # 0 = S, 1 = I, 2 = R
      state[sample(1:N, 1)] <- 1 # Random initial infected
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        new_state <- state
        for (node in which(state == 1)) { # For each infected node
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (state[nbr_idx] == 0 && runif(1) < beta) {
              new_state[nbr_idx] <- 1
            }
          }
        }
        state <- new_state
        I_frac[t] <- mean(state == 1)
        if (all(state != 1)) break # No more infected
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(0, steps - length(I_frac)))
      return(I_frac)
    }
    
    # SIR Model With Immunization
    SIR_immunization <- function(g, beta=0.1, steps=50) {
      N <- vcount(g)
      state <- rep(0, N) # 0 = S, 1 = I, 2 = R
      state[sample(1:N, 1)] <- 1 # Random initial infected
      I_frac <- numeric(steps)
      for (t in 1:steps) {
        # Immunization phase: pick random node, immunize 1 susceptible neighbor if possible
        chosen <- sample(1:N, 1)
        nbrs <- neighbors(g, chosen)
        s_nbrs <- nbrs[state[as.integer(nbrs)] == 0]
        if (length(s_nbrs) > 0) {
          to_immunize <- sample(s_nbrs, 1)
          state[as.integer(to_immunize)] <- 2
        }
        # Infection phase
        new_state <- state
        for (node in which(state == 1)) {
          nbrs <- neighbors(g, node)
          for (nbr in nbrs) {
            nbr_idx <- as.integer(nbr)
            if (state[nbr_idx] == 0 && runif(1) < beta) {
              new_state[nbr_idx] <- 1
            }
          }
        }
        state <- new_state
        I_frac[t] <- mean(state == 1)
        if (all(state != 1)) break # No more infected
      }
      if (length(I_frac) < steps) I_frac <- c(I_frac, rep(0, steps - length(I_frac)))
      return(I_frac)
    }
    
    # Running Simulations and Plotting Results
    steps <- 50
    runs <- 10
    set.seed(42)
    
    # Classic SIR
    classic_mat <- replicate(runs, classic_SIR(g, beta=0.1, steps=steps))
    classic_mean <- rowMeans(classic_mat)
    
    # SIR with Immunization
    immun_mat <- replicate(runs, SIR_immunization(g, beta=0.1, steps=steps))
    immun_mean <- rowMeans(immun_mat)
    
    # Plot
    plot(classic_mean, type="l", col="blue", lwd=2, ylim=c(0,1),
         ylab="Fraction Infected (I)", xlab="Step",
         main="SIR Model: With vs Without Immunization (mean of 10 runs)")
    lines(immun_mean, col="red", lwd=2)
    legend("topright", legend=c("Classic SIR", "SIR with Immunization"),
           col=c("blue", "red"), lwd=2)
    
    # Interpretation
    
    # The red curve (SIR with immunization) should show a noticeably slower and/or 
    # smaller epidemic than the blue curve (classic SIR).
    
    # Immunization before the infection phase reduces the number of susceptible 
    # nodes, thereby limiting the spread.

22.6.1

Problem

    # Plot the number of nodes in the largest connected component
    # as you remove 2, 000 random nodes, one at a time, from the net-
    # work at http://www.networkatlas.eu/exercises/22/1/data.txt.
    # (Repeat 10 times and plot the average result)
    
    library(here)
    library(igraph)
    
    # Loading and remapping the network, assigning unique character names to vertices
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_names <- as.character(nodes)
    node_map <- setNames(node_names, nodes)
    edges_named <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g_full <- graph_from_edgelist(as.matrix(edges_named), directed=FALSE)
    V(g_full)$name <- as.character(V(g_full)$name) # Ensuring names are character
    
    # Write here the solution

Solution

    # Plot the number of nodes in the largest connected component
    # as you remove 2, 000 random nodes, one at a time, from the net-
    # work at http://www.networkatlas.eu/exercises/22/1/data.txt.
    # (Repeat 10 times and plot the average result)
    
    library(here)
    library(igraph)
    
    # Loading and remapping the network, assigning unique character names to vertices
    edges <- read.table("data.txt", header=FALSE)
    nodes <- unique(c(edges$V1, edges$V2))
    node_names <- as.character(nodes)
    node_map <- setNames(node_names, nodes)
    edges_named <- as.data.frame(lapply(edges, function(col) node_map[as.character(col)]))
    g_full <- graph_from_edgelist(as.matrix(edges_named), directed=FALSE)
    V(g_full)$name <- as.character(V(g_full)$name) # Ensuring names are character
    
    # Solution 
    
    steps <- 2000
    runs <- 10
    set.seed(42)
    largest_cc_mat <- matrix(NA, nrow=steps+1, ncol=runs)
    
    for (r in 1:runs) {
      g <- g_full
      remaining_names <- V(g)$name
      largest_cc <- numeric(steps+1)
      largest_cc[1] <- max(components(g)$csize)
      remove_order <- sample(remaining_names, steps)
      for (i in 1:steps) {
        if (remove_order[i] %in% V(g)$name) {
          g <- delete_vertices(g, remove_order[i])
        }
        if (vcount(g) > 0) {
          largest_cc[i+1] <- max(components(g)$csize)
        } else {
          largest_cc[(i+1):(steps+1)] <- 0
          break
        }
      }
      largest_cc_mat[,r] <- largest_cc
    }
    
    # Averaging over runs
    mean_largest_cc <- rowMeans(largest_cc_mat)
    
    # Plotting
    plot(0:steps, mean_largest_cc, type="l", lwd=2,
         xlab="Number of nodes removed",
         ylab="Size of largest connected component (average over 10 runs)",
         main="Random Node Removal: Largest Connected Component")

22.6.2

Problem

    # Perform the same operation as the one from the previous exercise,
    # but for the network at http://www.networkatlas.eu/exercises/
    # 22/2/data.txt. Can you tell which is the network with a power
    # law degree distribution and which is the Gn,p network?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph
    edge_list <- read.table("data.txt", header=FALSE)
    colnames(edge_list) <- c("from", "to")
    
    edge_list[] <- lapply(edge_list, as.character)
    
    g <- graph_from_edgelist(as.matrix(edge_list), directed = FALSE)
    
    # Write here the solution

Solution

    # Perform the same operation as the one from the previous exercise,
    # but for the network at http://www.networkatlas.eu/exercises/
    # 22/2/data.txt. Can you tell which is the network with a power
    # law degree distribution and which is the Gn,p network?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph
    edge_list <- read.table("data.txt", header=FALSE)
    colnames(edge_list) <- c("from", "to")
    
    edge_list[] <- lapply(edge_list, as.character)
    
    g <- graph_from_edgelist(as.matrix(edge_list), directed = FALSE)
    
    # Solution 
    
    num_remove <- 2000
    num_runs <- 10
    lcc_sizes <- matrix(NA, nrow = num_remove, ncol = num_runs)
    
    set.seed(42)
    for(run in 1:num_runs) {
      g_temp <- g
      nodes <- V(g_temp)$name
      nodes_to_remove <- sample(nodes, num_remove)
      for(i in 1:num_remove) {
        g_temp <- delete_vertices(g_temp, nodes_to_remove[i])
        cl <- components(g_temp)
        lcc_sizes[i, run] <- if (vcount(g_temp) > 0) max(cl$csize) else 0
      }
    }
    
    avg_lcc <- rowMeans(lcc_sizes)
    
    # Plotting the results
    plot(1:num_remove, avg_lcc, type = "l",
         xlab = "Number of nodes removed",
         ylab = "Size of largest connected component",
         main = "Network Robustness: Random Node Removal")

22.6.3

Problem

    # Plot the number of nodes in the largest connected component
    # as you remove 2, 000 nodes, one at a time, in descending degree
    # order, from the networks used for the previous exercises. Does the
    # result confirm your answer to the previous question about which
    # network is of which type?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph
    edge_list <- read.table("data.txt", header=FALSE)
    colnames(edge_list) <- c("from", "to")
    edge_list[] <- lapply(edge_list, as.character)
    g <- graph_from_edgelist(as.matrix(edge_list), directed = FALSE)
    
    # Write here the solution

Solution

    # Plot the number of nodes in the largest connected component
    # as you remove 2, 000 nodes, one at a time, in descending degree
    # order, from the networks used for the previous exercises. Does the
    # result confirm your answer to the previous question about which
    # network is of which type?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph
    edge_list <- read.table("data.txt", header=FALSE)
    colnames(edge_list) <- c("from", "to")
    edge_list[] <- lapply(edge_list, as.character)
    g <- graph_from_edgelist(as.matrix(edge_list), directed = FALSE)
    
    # Solution 
    
    num_remove <- 2000
    lcc_sizes <- numeric(num_remove)
    
    g_temp <- g
    for (i in 1:num_remove) {
      if (vcount(g_temp) == 0) {
        lcc_sizes[i:num_remove] <- 0
        break
      }
      degs <- degree(g_temp)
      # Picking the node(s) with the highest degree (randomly if tie)
      max_deg <- max(degs)
      candidates <- names(degs)[degs == max_deg]
      to_remove <- sample(candidates, 1)
      g_temp <- delete_vertices(g_temp, to_remove)
      cl <- components(g_temp)
      lcc_sizes[i] <- if (vcount(g_temp) > 0) max(cl$csize) else 0
    }
    
    # Plotting the results 
    plot(1:num_remove, lcc_sizes, type = "l",
         xlab = "Number of nodes removed (highest degree first)",
         ylab = "Size of largest connected component",
         main = paste("Targeted Attack: Largest Component vs. Nodes Removed\n", filename))

22.6.4

Problem

    # The network at http://www.networkatlas.eu/exercises/22/4/
    # data.txt has nodes metadata at http://www.networkatlas.eu/
    # exercises/22/4/node_metadata.txt, telling you the current load
    # and the maximum load. If the current load exceeds the maximum
    # load, the node will shut down and equally distribute all of its
    # current load to its neighbors. Some nodes have a current load
    # higher than their maximum load. Run the cascade failure and
    # report how many nodes are left standing once the cascade finishes.
    
    library(here)
    library(igraph)
    
    # Loading the network
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Loading metadata
    meta <- read.delim("node_metadata.txt", header=TRUE, check.names=FALSE, stringsAsFactors=FALSE)
    # Cleaning up column names: remove leading/trailing spaces, replace multiple spaces/tabs with "_"
    colnames(meta) <- gsub("[ \t]+", "_", trimws(colnames(meta)))
    
    meta$node <- as.character(meta$node)
    
    # Get the correct column names for current and max load
    current_col <- grep("^current.*load$", colnames(meta), ignore.case=TRUE, value=TRUE)
    max_col <- grep("^max.*load$", colnames(meta), ignore.case=TRUE, value=TRUE)
    
    current_load <- setNames(meta[[current_col]], meta$node)
    max_load <- setNames(meta[[max_col]], meta$node)
    standing <- setNames(rep(TRUE, length(current_load)), names(current_load))
    
    # Solution

Solution

    # The network at http://www.networkatlas.eu/exercises/22/4/
    # data.txt has nodes metadata at http://www.networkatlas.eu/
    # exercises/22/4/node_metadata.txt, telling you the current load
    # and the maximum load. If the current load exceeds the maximum
    # load, the node will shut down and equally distribute all of its
    # current load to its neighbors. Some nodes have a current load
    # higher than their maximum load. Run the cascade failure and
    # report how many nodes are left standing once the cascade finishes.
    
    library(here)
    library(igraph)
    
    # Loading the network
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Loading metadata
    meta <- read.delim("node_metadata.txt", header=TRUE, check.names=FALSE, stringsAsFactors=FALSE)
    # Cleaning up column names: remove leading/trailing spaces, replace multiple spaces/tabs with "_"
    colnames(meta) <- gsub("[ \t]+", "_", trimws(colnames(meta)))
    
    meta$node <- as.character(meta$node)
    
    # Get the correct column names for current and max load
    current_col <- grep("^current.*load$", colnames(meta), ignore.case=TRUE, value=TRUE)
    max_col <- grep("^max.*load$", colnames(meta), ignore.case=TRUE, value=TRUE)
    
    current_load <- setNames(meta[[current_col]], meta$node)
    max_load <- setNames(meta[[max_col]], meta$node)
    standing <- setNames(rep(TRUE, length(current_load)), names(current_load))
    
    # Solution 
    
    repeat {
      overloaded <- names(current_load)[standing & (current_load > max_load)]
      if(length(overloaded) == 0) break
      
      for(node in overloaded) {
        neighbors_vec <- neighbors(g, node)
        # Only distribute to standing neighbors
        neighbors_ids <- names(current_load)[neighbors_vec %in% which(standing)]
        n_neighbors <- length(neighbors_ids)
        if(n_neighbors > 0) {
          load_to_give <- current_load[node]
          current_load[neighbors_ids] <- current_load[neighbors_ids] + load_to_give / n_neighbors
        }
        current_load[node] <- 0
        standing[node] <- FALSE
      }
    }
    
    # Printing results
    n_standing <- sum(standing)
    cat("Number of nodes left standing after cascade:", n_standing, "\n")

23.9.1

Problem

    # What are the ten most likely edges to appear in the network at
    # http://www.networkatlas.eu/exercises/23/1/data.txt accord-
    # ing to the preferential attachment index?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Write here the solution

Solution

    # What are the ten most likely edges to appear in the network at
    # http://www.networkatlas.eu/exercises/23/1/data.txt accord-
    # ing to the preferential attachment index?
    
    library(here)
    library(igraph)
    
    # Reading the edge list and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Solution 
    
    # Getting all node pairs NOT currently connected (potential edges)
    all_nodes <- V(g)$name
    missing_edges <- t(combn(all_nodes, 2))
    missing_edges <- missing_edges[!apply(missing_edges, 1, function(pair) {
      are.connected(g, pair[1], pair[2])
    }), , drop=FALSE]
    
    # Computing preferential attachment for each missing edge
    deg <- degree(g)
    pa_scores <- apply(missing_edges, 1, function(pair) {
      deg[pair[1]] * deg[pair[2]]
    })
    
    # Finding the top 10 by score
    top_idx <- order(pa_scores, decreasing=TRUE)[1:10]
    top_edges <- missing_edges[top_idx, , drop=FALSE]
    top_scores <- pa_scores[top_idx]
    
    # Printing the results
    cat("Top 10 most likely edges (by preferential attachment):\n")
    for(i in 1:nrow(top_edges)) {
      cat(sprintf("%s -- %s (score = %d)\n", top_edges[i,1], top_edges[i,2], top_scores[i]))
    }

23.9.2

Problem

    # Compare the top ten edges predicted for the previous question
    # with the ones predicted by the jaccard, Adamic-Adar, and resource
    # allocation indexes.
    
    library(here)
    library(igraph)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading edge list
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Write here the solution

Solution

    # Compare the top ten edges predicted for the previous question
    # with the ones predicted by the jaccard, Adamic-Adar, and resource
    # allocation indexes.
    
    library(here)
    library(igraph)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading edge list
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Solution 
    
    # All possible node pairs not in the graph
    all_nodes <- V(g)$name
    all_pairs <- t(combn(all_nodes, 2))
    non_edges <- all_pairs[!apply(all_pairs, 1, function(pair) are.connected(g, pair[1], pair[2])), , drop=FALSE]
    
    # Preferential Attachment
    deg <- degree(g)
    pa_scores <- apply(non_edges, 1, function(pair) deg[pair[1]] * deg[pair[2]])
    
    # Jaccard
    jaccard_scores <- apply(non_edges, 1, function(pair) {
      jaccard_similarity(g, pair[1], pair[2])
    })
    
    # Adamic-Adar
    adamic_adar_scores <- apply(non_edges, 1, function(pair) {
      adamic_adar_similarity(g, pair[1], pair[2])
    })
    
    # Resource Allocation
    ra_scores <- apply(non_edges, 1, function(pair) {
      resource_allocation_index(g, pair[1], pair[2])
    })
    
    get_top10 <- function(pairs, scores) {
      idx <- order(scores, decreasing=TRUE)[1:10]
      data.frame(node1=pairs[idx,1], node2=pairs[idx,2], score=scores[idx])
    }
    
    top10_pa <- get_top10(non_edges, pa_scores)
    top10_jaccard <- get_top10(non_edges, jaccard_scores)
    top10_adamic_adar <- get_top10(non_edges, adamic_adar_scores)
    top10_ra <- get_top10(non_edges, ra_scores)
    
    cat("Top 10 Preferential Attachment:\n"); print(top10_pa)
    cat("\nTop 10 Jaccard:\n"); print(top10_jaccard)
    cat("\nTop 10 Adamic-Adar:\n"); print(top10_adamic_adar)
    cat("\nTop 10 Resource Allocation:\n"); print(top10_ra)
    
    ################### Optional: seeing overlap ###################################
    
    cat("\nOverlap (node1, node2) between indices:\n")
    cat(sprintf("PA & Jaccard: %d\n", nrow(merge(top10_pa, top10_jaccard, by=c("node1","node2")))))
    cat(sprintf("PA & Adamic-Adar: %d\n", nrow(merge(top10_pa, top10_adamic_adar, by=c("node1","node2")))))
    cat(sprintf("PA & RA: %d\n", nrow(merge(top10_pa, top10_ra, by=c("node1","node2")))))
    cat(sprintf("Jaccard & Adamic-Adar: %d\n", nrow(merge(top10_jaccard, top10_adamic_adar, by=c("node1","node2")))))
    cat(sprintf("Jaccard & RA: %d\n", nrow(merge(top10_jaccard, top10_ra, by=c("node1","node2")))))
    cat(sprintf("Adamic-Adar & RA: %d\n", nrow(merge(top10_adamic_adar, top10_ra, by=c("node1","node2")))))

23.9.3

Problem

    # Use the mutual information function from scikit-learn to im-
    # plement a mutual information link predictor. Compare it with the
    # results from the previous questions.
    
    library(here)
    library(igraph)
    library(infotheo)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the edge list and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Write here the solution

Solution

    # Use the mutual information function from scikit-learn to im-
    # plement a mutual information link predictor. Compare it with the
    # results from the previous questions.
    
    library(here)
    library(igraph)
    library(infotheo)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the edge list and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    # Solution 
    
    # Non-edges (potential links)
    all_nodes <- V(g)$name
    all_pairs <- t(combn(all_nodes, 2))
    non_edges <- all_pairs[!apply(all_pairs, 1, function(pair) are.connected(g, pair[1], pair[2])), , drop=FALSE]
    
    # Preferential Attachment
    deg <- degree(g)
    pa_scores <- apply(non_edges, 1, function(pair) deg[pair[1]] * deg[pair[2]])
    
    # Jaccard
    jaccard_scores <- apply(non_edges, 1, function(pair) {
      jaccard_similarity(g, pair[1], pair[2])
    })
    
    # Adamic-Adar
    adamic_adar_scores <- apply(non_edges, 1, function(pair) {
      adamic_adar_similarity(g, pair[1], pair[2])
    })
    
    # Resource Allocation
    ra_scores <- apply(non_edges, 1, function(pair) {
      resource_allocation_index(g, pair[1], pair[2])
    })
    
    # Mutual Information
    A <- as.matrix(as_adjacency_matrix(g, sparse=FALSE))
    mi_scores <- apply(non_edges, 1, function(pair) {
      v1 <- pair[1]
      v2 <- pair[2]
      idx1 <- which(all_nodes == v1)
      idx2 <- which(all_nodes == v2)
      # Removing self and each other from vectors
      vec1 <- A[idx1, -c(idx1, idx2)]
      vec2 <- A[idx2, -c(idx1, idx2)]
      mutinformation(factor(vec1), factor(vec2))
    })
    
    # Getting Top 10 for each method
    get_top10 <- function(pairs, scores) {
      idx <- order(scores, decreasing=TRUE)[1:10]
      data.frame(node1=pairs[idx,1], node2=pairs[idx,2], score=scores[idx], stringsAsFactors=FALSE)
    }
    top10_pa <- get_top10(non_edges, pa_scores)
    top10_jaccard <- get_top10(non_edges, jaccard_scores)
    top10_adamic_adar <- get_top10(non_edges, adamic_adar_scores)
    top10_ra <- get_top10(non_edges, ra_scores)
    top10_mi <- get_top10(non_edges, mi_scores)
    
    # Printing Top 10 Mutual Information
    cat("Top 10 Mutual Information edges:\n")
    print(top10_mi)
    
    # Comparison: overlap and edge pairs
    compare_top10 <- function(df1, df2, name1, name2) {
      m <- merge(df1, df2, by=c("node1","node2"))
      cat(sprintf("\nOverlap between %s and %s: %d edges\n", name1, name2, nrow(m)))
      if (nrow(m) > 0) print(m[,c("node1","node2")])
    }
    
    compare_top10(top10_mi, top10_pa, "Mutual Information", "Preferential Attachment")
    compare_top10(top10_mi, top10_jaccard, "Mutual Information", "Jaccard")
    compare_top10(top10_mi, top10_adamic_adar, "Mutual Information", "Adamic-Adar")
    compare_top10(top10_mi, top10_ra, "Mutual Information", "Resource Allocation")

23.9.4

Problem

    # Use your code to calculate the hitting time (from exercise 3 of
    # Chapter 11) to implement a hit time link predictor – use the com-
    # mute time since the network is undirected. Compare it with the
    # results from the previous questions.
    
    library(here)
    library(igraph)
    library(infotheo)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g)$name
    n <- length(all_nodes)
    A <- as.matrix(as_adjacency_matrix(g, sparse=FALSE))
    
    # Write here the solution

Solution

    # Use your code to calculate the hitting time (from exercise 3 of
    # Chapter 11) to implement a hit time link predictor – use the com-
    # mute time since the network is undirected. Compare it with the
    # results from the previous questions.
    
    library(here)
    library(igraph)
    library(infotheo)
    
    ########################### Helper functions ###################################
    jaccard_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) 0 else intersect_len / union_len
    }
    
    adamic_adar_similarity <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(graph, comm)))
    }
    
    resource_allocation_index <- function(graph, v1, v2) {
      n1 <- neighbors(graph, v1)
      n2 <- neighbors(graph, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(graph, comm))
    }
    
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph 
    edges <- read.table("data.txt", header=FALSE)
    edges[] <- lapply(edges, as.character)
    g <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g)$name
    n <- length(all_nodes)
    A <- as.matrix(as_adjacency_matrix(g, sparse=FALSE))
    
    # Solution 
    
    # Computing hitting time and commute time matrices via Laplacian pseudoinverse
    D <- diag(rowSums(A))
    L <- D - A
    
    # Computing Moore-Penrose pseudoinverse with eigen-decomposition (L is symmetric, positive semi-definite)
    eig <- eigen(L)
    # Setting a threshold for zero eigenvalues
    tol <- 1e-10
    inv_eigvals <- ifelse(abs(eig$values) < tol, 0, 1 / eig$values)
    Lplus <- eig$vectors %*% diag(inv_eigvals) %*% t(eig$vectors)
    
    # The commute time between nodes i and j is: C_ij = vol(G) * (L+_ii + L+_jj - 2*L+_ij)
    volG <- sum(A)
    commute_time_mat <- matrix(NA, n, n)
    for(i in 1:n) {
      for(j in 1:n) {
        commute_time_mat[i, j] <- volG * (Lplus[i,i] + Lplus[j,j] - 2 * Lplus[i,j])
      }
    }
    rownames(commute_time_mat) <- all_nodes
    colnames(commute_time_mat) <- all_nodes
    
    # Finding all potential links (non-edges)
    all_pairs <- t(combn(all_nodes, 2))
    non_edges <- all_pairs[!apply(all_pairs, 1, function(pair) are.connected(g, pair[1], pair[2])), , drop=FALSE]
    
    # Commuting time predictor: lower = more likely
    commute_times <- apply(non_edges, 1, function(pair) {
      commute_time_mat[pair[1], pair[2]]
    })
    
    get_top10 <- function(pairs, scores, decreasing=TRUE) {
      idx <- order(scores, decreasing=decreasing)[1:10]
      data.frame(node1=pairs[idx,1], node2=pairs[idx,2], score=scores[idx], stringsAsFactors=FALSE)
    }
    
    top10_commute <- get_top10(non_edges, commute_times, decreasing=FALSE) # Lower is better
    
    # Other predictors for comparison
    deg <- degree(g)
    pa_scores <- apply(non_edges, 1, function(pair) deg[pair[1]] * deg[pair[2]])
    top10_pa <- get_top10(non_edges, pa_scores, decreasing=TRUE)
    
    jaccard_scores <- apply(non_edges, 1, function(pair) jaccard_similarity(g, pair[1], pair[2]))
    top10_jaccard <- get_top10(non_edges, jaccard_scores, decreasing=TRUE)
    
    adamic_adar_scores <- apply(non_edges, 1, function(pair) adamic_adar_similarity(g, pair[1], pair[2]))
    top10_adamic_adar <- get_top10(non_edges, adamic_adar_scores, decreasing=TRUE)
    
    ra_scores <- apply(non_edges, 1, function(pair) resource_allocation_index(g, pair[1], pair[2]))
    top10_ra <- get_top10(non_edges, ra_scores, decreasing=TRUE)
    
    # Mutual Information
    mi_scores <- apply(non_edges, 1, function(pair) {
      v1 <- pair[1]
      v2 <- pair[2]
      idx1 <- which(all_nodes == v1)
      idx2 <- which(all_nodes == v2)
      # Removing self and each other from vectors
      vec1 <- A[idx1, -c(idx1, idx2)]
      vec2 <- A[idx2, -c(idx1, idx2)]
      mutinformation(factor(vec1), factor(vec2))
    })
    top10_mi <- get_top10(non_edges, mi_scores, decreasing=TRUE)
    
    # Printing Top 10 for all predictors
    cat("Top 10 Commute Time (lowest values):\n"); print(top10_commute)
    cat("\nTop 10 Preferential Attachment:\n"); print(top10_pa)
    cat("\nTop 10 Jaccard:\n"); print(top10_jaccard)
    cat("\nTop 10 Adamic-Adar:\n"); print(top10_adamic_adar)
    cat("\nTop 10 Resource Allocation:\n"); print(top10_ra)
    cat("\nTop 10 Mutual Information:\n"); print(top10_mi)
    
    # Overlap comparison
    compare_top10 <- function(df1, df2, name1, name2) {
      m <- merge(df1, df2, by=c("node1","node2"))
      cat(sprintf("\nOverlap between %s and %s: %d edges\n", name1, name2, nrow(m)))
      if (nrow(m) > 0) print(m[,c("node1","node2")])
    }
    
    cat("\n--- Overlaps with Commute Time (Hitting Time) ---\n")
    compare_top10(top10_commute, top10_pa, "Commute Time", "Preferential Attachment")
    compare_top10(top10_commute, top10_jaccard, "Commute Time", "Jaccard")
    compare_top10(top10_commute, top10_adamic_adar, "Commute Time", "Adamic-Adar")
    compare_top10(top10_commute, top10_ra, "Commute Time", "Resource Allocation")
    compare_top10(top10_commute, top10_mi, "Commute Time", "Mutual Information")

24.4.1

Problem

    # You’re given the undirected signed network at http://www.
    # networkatlas.eu/exercises/24/1/data.txt. Count the number of
    # triangles of the four possible types.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to", "sign")
    edges[] <- lapply(edges, as.character)
    edges$sign <- as.numeric(edges$sign)
    
    # Building an undirected network, keeping edge signs as attribute
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Write here the solution

Solution

    # You’re given the undirected signed network at http://www.
    # networkatlas.eu/exercises/24/1/data.txt. Count the number of
    # triangles of the four possible types.
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to", "sign")
    edges[] <- lapply(edges, as.character)
    edges$sign <- as.numeric(edges$sign)
    
    # Building an undirected network, keeping edge signs as attribute
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Solution 
    
    # Enumerating all triangles
    triangles_raw <- combn(V(g)$name, 3)
    triangle_types <- c('+++', '++-', '+--', '---')
    triangle_counts <- setNames(rep(0, 4), triangle_types)
    
    # For each triangle, checking the signs
    for(i in 1:ncol(triangles_raw)) {
      v <- triangles_raw[,i]
      # Get all three edge signs using .from() and .to()
      s1 <- E(g)[.from(v[1]) & .to(v[2])]$sign
      s2 <- E(g)[.from(v[1]) & .to(v[3])]$sign
      s3 <- E(g)[.from(v[2]) & .to(v[3])]$sign
      # Only count if all three edges exist
      if(length(s1) == 1 && length(s2) == 1 && length(s3) == 1) {
        signs <- c(s1, s2, s3)
        npos <- sum(signs == 1)
        nneg <- sum(signs == -1)
        if(npos == 3) triangle_counts['+++'] <- triangle_counts['+++'] + 1
        if(npos == 2 && nneg == 1) triangle_counts['++-'] <- triangle_counts['++-'] + 1
        if(npos == 1 && nneg == 2) triangle_counts['+--'] <- triangle_counts['+--'] + 1
        if(nneg == 3) triangle_counts['---'] <- triangle_counts['---'] + 1
      }
    }
    
    # Printing the results 
    cat("Triangle type counts:\n")
    for(type in triangle_types) {
      cat(type, ":", triangle_counts[type], "\n")
    }

24.4.2

Problem

    # You’re given the directed signed network at http://www.networkatlas.
    # eu/exercises/24/2/data.txt. Does this network follow social bal-
    # ance or social status? (Consider only reciprocal edges. For social
    # balance, the reciprocal edges should have the same sign. For social
    # status they should have opposite signs)
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, col.names=c("from", "to", "sign"))
    edges[] <- lapply(edges, as.character)
    edges$sign <- as.numeric(edges$sign)
    
    # Write here the solution

Solution

    # You’re given the directed signed network at http://www.networkatlas.
    # eu/exercises/24/2/data.txt. Does this network follow social bal-
    # ance or social status? (Consider only reciprocal edges. For social
    # balance, the reciprocal edges should have the same sign. For social
    # status they should have opposite signs)
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, col.names=c("from", "to", "sign"))
    edges[] <- lapply(edges, as.character)
    edges$sign <- as.numeric(edges$sign)
    
    # Solution 
    
    # Finding reciprocal edges
    reciprocals <- merge(edges, edges, by.x=c("from","to"), by.y=c("to","from"),
                         suffixes=c("_fwd","_rev"))
    # Removing self-loops if any
    reciprocals <- reciprocals[reciprocals$from != reciprocals$to, ]
    # To avoid double-counting, keep only pairs where from_fwd < to_fwd lexicographically
    reciprocals <- reciprocals[as.character(reciprocals$from) < as.character(reciprocals$to), ]
    
    # Counting types
    n_same_sign <- sum(reciprocals$sign_fwd == reciprocals$sign_rev)
    n_opp_sign <- sum(reciprocals$sign_fwd == -reciprocals$sign_rev)
    n_total <- nrow(reciprocals)
    n_neither <- n_total - n_same_sign - n_opp_sign
    
    # Printig the results
    
    cat(sprintf("Total reciprocal pairs: %d\n", n_total))
    cat(sprintf("Same sign (social balance): %d (%.1f%%)\n", n_same_sign, 100*n_same_sign/n_total))
    cat(sprintf("Opposite sign (social status): %d (%.1f%%)\n", n_opp_sign, 100*n_opp_sign/n_total))
    cat(sprintf("Neither: %d (%.1f%%)\n", n_neither, 100*n_neither/n_total))
    
    # Simple conclusion
    if (n_same_sign > n_opp_sign) {
      cat("Conclusion: The network is more consistent with **social balance**.\n")
    } else if (n_opp_sign > n_same_sign) {
      cat("Conclusion: The network is more consistent with **social status**.\n")
    } else {
      cat("Conclusion: The network is equally consistent with both or neither.\n")
    }

24.4.3

Problem

    # Consider the multilayer network at at http://www.networkatlas.
    # eu/exercises/24/3/data.txt. Calculate the Pearson correlation
    # between layers (each layer is a vector with an entry per edge. The
    # entry is 1 if the edge is present in the layer, 0 otherwise). What
    # does this tell you about multilayer link prediction? Should you
    # assume layers are independent and therefore apply a single layer
    # link prediction to each layer?
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "layer")
    
    # Write here the solution

Solution

    # Consider the multilayer network at at http://www.networkatlas.
    # eu/exercises/24/3/data.txt. Calculate the Pearson correlation
    # between layers (each layer is a vector with an entry per edge. The
    # entry is 1 if the edge is present in the layer, 0 otherwise). What
    # does this tell you about multilayer link prediction? Should you
    # assume layers are independent and therefore apply a single layer
    # link prediction to each layer?
    
    library(here)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "layer")
    
    # Solution 
    
    # Getting unique layers and all unique node pairs
    layers <- unique(edges$layer)
    all_edges <- unique(rbind(
      edges[c("from", "to")],
      edges[c("to", "from")]
    ))
    
    # Creating a sorted list of all unique undirected edges for vectorization
    all_edges_sorted <- t(apply(all_edges, 1, function(row) sort(as.character(row))))
    all_edges_df <- unique(data.frame(from=all_edges_sorted[,1], to=all_edges_sorted[,2], stringsAsFactors=FALSE))
    
    # Building a binary presence matrix: rows = all edges, columns = layers
    edge_layer_mat <- matrix(0, nrow=nrow(all_edges_df), ncol=length(layers))
    colnames(edge_layer_mat) <- as.character(layers)
    
    for (i in seq_along(layers)) {
      layer_edges <- edges[edges$layer == layers[i], c("from", "to")]
      # Make sure to treat undirected edges as equivalent
      layer_edges_sorted <- t(apply(layer_edges, 1, function(row) sort(as.character(row))))
      layer_edges_df <- data.frame(from=layer_edges_sorted[,1], to=layer_edges_sorted[,2], stringsAsFactors=FALSE)
      matches <- apply(all_edges_df, 1, function(edge) {
        any(apply(layer_edges_df, 1, function(le) all(le == edge)))
      })
      edge_layer_mat[,i] <- as.integer(matches)
    }
    
    # Computing Pearson correlation for each pair of layers
    layer_corr <- cor(edge_layer_mat, method="pearson")
    
    # Printing results
    cat("Pearson correlation matrix between layers:\n")
    print(round(layer_corr, 3))
    
    # Interpreting
    mean_corr <- mean(layer_corr[lower.tri(layer_corr)])
    cat(sprintf("\nMean off-diagonal correlation: %.3f\n", mean_corr))
    if (mean_corr > 0.7) {
      cat("Conclusion: Layers are highly correlated, so they are not independent. Multilayer link prediction should consider dependencies.\n")
    } else if (mean_corr < 0.3) {
      cat("Conclusion: Layers are weakly correlated and can be considered nearly independent. You may use single-layer predictors for each layer.\n")
    } else {
      cat("Conclusion: Layers have moderate correlation; use caution and consider dependencies in prediction.\n")
    }

25.4.1

Problem

    # Divide the network at http://www.networkatlas.eu/exercises/
    # 25/1/data.txt into train and test sets using a ten-fold cross vali-
    # dation scheme. Draw its confusion matrix after applying a jaccard
    # link prediction to it. Use 0.5 as you cutoff score: scores equal to or
    # higher than 0.5 are predicted to be an edge, anything lower is pre-
    # dicted to be a non-edge. (Hint: make heavy use of scikit-learn
    # capabilities of performing KFold divisions and building confusion
    # matrices)
    
    library(here)
    library(igraph)
    library(caret)
    library(yardstick)
    
    ########################### Helper functions ###################################
    
    # Function to compute Jaccard index for a pair in a given graph
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    ####################### End Helper functions ###################################
    
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Write here the solution

Solution

    # Divide the network at http://www.networkatlas.eu/exercises/
    # 25/1/data.txt into train and test sets using a ten-fold cross vali-
    # dation scheme. Draw its confusion matrix after applying a jaccard
    # link prediction to it. Use 0.5 as you cutoff score: scores equal to or
    # higher than 0.5 are predicted to be an edge, anything lower is pre-
    # dicted to be a non-edge. (Hint: make heavy use of scikit-learn
    # capabilities of performing KFold divisions and building confusion
    # matrices)
    
    library(here)
    library(igraph)
    library(caret)
    library(yardstick)
    
    ########################### Helper functions ###################################
    
    # Function to compute Jaccard index for a pair in a given graph
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    ####################### End Helper functions ###################################
    
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Solution 
    
    # Generating all possible node pairs
    all_pairs <- t(combn(all_nodes, 2))
    all_edges_df <- data.frame(from=all_pairs[,1], to=all_pairs[,2], stringsAsFactors=FALSE)
    
    # Marking which pairs are actual edges
    all_edges_df$edge <- mapply(function(f, t) {
      are.connected(g_full, f, t)
    }, all_edges_df$from, all_edges_df$to)
    
    # Getting positive (edges) and negative (non-edges) samples
    pos_edges <- all_edges_df[all_edges_df$edge, c("from", "to")]
    neg_edges <- all_edges_df[!all_edges_df$edge, c("from", "to")]
    
    # For cross-validation, combine positives and sample negatives to match number 
    # of positives (for balanced evaluation)
    set.seed(42)
    neg_edges <- neg_edges[sample(nrow(neg_edges), nrow(pos_edges)), ]
    data_cv <- rbind(
      data.frame(pos_edges, label=1),
      data.frame(neg_edges, label=0)
    )
    data_cv <- data_cv[sample(nrow(data_cv)), ] # Shuffle
    
    # 10-fold cross-validation
    folds <- createFolds(data_cv$label, k=10, list=TRUE, returnTrain=FALSE)
    
    # Running cross-validation and collect predictions
    true_labels <- c()
    pred_labels <- c()
    
    for(i in seq_along(folds)) {
      test_idx <- folds[[i]]
      train_edges <- data_cv[-test_idx, ]
      test_edges <- data_cv[test_idx, ]
      
      # Building training graph
      train_g <- graph_from_data_frame(train_edges[train_edges$label==1, c("from","to")], directed=FALSE, vertices=all_nodes)
      
      # Predicting for test set
      for(j in 1:nrow(test_edges)) {
        v1 <- test_edges$from[j]
        v2 <- test_edges$to[j]
        score <- jaccard_score(train_g, v1, v2)
        pred <- as.integer(score >= 0.5)
        true_labels <- c(true_labels, test_edges$label[j])
        pred_labels <- c(pred_labels, pred)
      }
    }
    
    # Confusion matrix
    results <- data.frame(
      truth = factor(true_labels, levels=c(1,0)),
      prediction = factor(pred_labels, levels=c(1,0))
    )
    cm <- conf_mat(results, truth="truth", estimate="prediction")
    print(cm)
    
    ########################## Optional plot confusion matrix ######################
    autoplot(cm, type = "heatmap") + ggplot2::scale_fill_gradient(low="white", high="red")
    ################################################################################

25.4.2

Problem

    # Draw the ROC curves on the cross validation of the network used
    # at the previous question, comparing the following link predictors:
    # preferential attachment, jaccard, Adamic-Adar, and resource alloca-
    # tion. Which of those has the highest AUC? (Again, scikit-learn
    # has helper functions for you)
    
    library(here)
    library(igraph)
    library(caret)
    library(pROC)
    
    ########################### Helper functions ###################################
    
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Write here the solution

Solution

    # Draw the ROC curves on the cross validation of the network used
    # at the previous question, comparing the following link predictors:
    # preferential attachment, jaccard, Adamic-Adar, and resource alloca-
    # tion. Which of those has the highest AUC? (Again, scikit-learn
    # has helper functions for you)
    
    library(here)
    library(igraph)
    library(caret)
    library(pROC)
    
    ########################### Helper functions ###################################
    
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Solution
    
    # Generating all possible node pairs
    all_pairs <- t(combn(all_nodes, 2))
    all_edges_df <- data.frame(from=all_pairs[,1], to=all_pairs[,2], stringsAsFactors=FALSE)
    
    # Mark which pairs are actual edges
    all_edges_df$edge <- mapply(function(f, t) {
      are.connected(g_full, f, t)
    }, all_edges_df$from, all_edges_df$to)
    
    # Getting positive (edges) and negative (non-edges) samples
    pos_edges <- all_edges_df[all_edges_df$edge, c("from", "to")]
    neg_edges <- all_edges_df[!all_edges_df$edge, c("from", "to")]
    
    # For cross-validation, combine positives and sample negatives to match number 
    # of positives (for balanced evaluation)
    set.seed(42)
    neg_edges <- neg_edges[sample(nrow(neg_edges), nrow(pos_edges)), ]
    data_cv <- rbind(
      data.frame(pos_edges, label=1),
      data.frame(neg_edges, label=0)
    )
    data_cv <- data_cv[sample(nrow(data_cv)), ] # Shuffle
    
    # 10-fold cross-validation
    folds <- createFolds(data_cv$label, k=10, list=TRUE, returnTrain=FALSE)
    
    # Run cross-validation & collect scores/labels
    label_all = c()
    score_pa = c()
    score_jaccard = c()
    score_adamic = c()
    score_ra = c()
    
    for(i in seq_along(folds)) {
      test_idx <- folds[[i]]
      train_edges <- data_cv[-test_idx, ]
      test_edges <- data_cv[test_idx, ]
      
      # Building training graph
      train_g <- graph_from_data_frame(train_edges[train_edges$label==1, c("from","to")], directed=FALSE, vertices=all_nodes)
      
      for(j in 1:nrow(test_edges)) {
        v1 <- test_edges$from[j]
        v2 <- test_edges$to[j]
        label_all <- c(label_all, test_edges$label[j])
        score_pa <- c(score_pa, preferential_attachment(train_g, v1, v2))
        score_jaccard <- c(score_jaccard, jaccard_score(train_g, v1, v2))
        score_adamic <- c(score_adamic, adamic_adar_score(train_g, v1, v2))
        score_ra <- c(score_ra, resource_allocation_score(train_g, v1, v2))
      }
    }
    
    # Computing and plotting ROC curves & AUC
    roc_pa <- roc(label_all, score_pa, quiet=TRUE)
    roc_jaccard <- roc(label_all, score_jaccard, quiet=TRUE)
    roc_adamic <- roc(label_all, score_adamic, quiet=TRUE)
    roc_ra <- roc(label_all, score_ra, quiet=TRUE)
    
    plot(roc_pa, col="red", lwd=2, main="ROC Curves: Link Predictors")
    plot(roc_jaccard, col="blue", lwd=2, add=TRUE)
    plot(roc_adamic, col="green", lwd=2, add=TRUE)
    plot(roc_ra, col="purple", lwd=2, add=TRUE)
    legend("bottomright", legend=c(
      sprintf("Pref. Attach. (AUC = %.3f)", auc(roc_pa)),
      sprintf("Jaccard (AUC = %.3f)", auc(roc_jaccard)),
      sprintf("Adamic-Adar (AUC = %.3f)", auc(roc_adamic)),
      sprintf("Resource Alloc. (AUC = %.3f)", auc(roc_ra))
    ), col=c("red", "blue", "green", "purple"), lwd=2)
    
    # 10. Printing AUCs and the best predictor
    auc_vals <- c(
      Preferential_Attachment=auc(roc_pa),
      Jaccard=auc(roc_jaccard),
      Adamic_Adar=auc(roc_adamic),
      Resource_Allocation=auc(roc_ra)
    )
    
    # Printing the rest of the results 
    print(auc_vals)
    cat(sprintf("\nHighest AUC: %s (%.3f)\n", names(which.max(auc_vals)), max(auc_vals)))

25.4.3

Problem

    # Calculate precision, recall, and F1-score for the four link predictors
    # as used in the previous question. Set up as cutoff point the nineti-
    # eth percentile, meaning that you predict a link only for the highest
    # ten percent of the scores in each classifier. Which method performs
    # best according to these measures? (Note: when scoring with the
    # scikit-learn function, remember that this is a binary prediction
    # task)
    
    library(igraph)
    library(caret)
    
    ########################### Helper functions ###################################
    
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Write here the solution

Solution

    # Calculate precision, recall, and F1-score for the four link predictors
    # as used in the previous question. Set up as cutoff point the nineti-
    # eth percentile, meaning that you predict a link only for the highest
    # ten percent of the scores in each classifier. Which method performs
    # best according to these measures? (Note: when scoring with the
    # scikit-learn function, remember that this is a binary prediction
    # task)
    
    library(igraph)
    library(caret)
    
    ########################### Helper functions ###################################
    
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Solution
    
    # Generating all possible node pairs
    all_pairs <- t(combn(all_nodes, 2))
    all_edges_df <- data.frame(from=all_pairs[,1], to=all_pairs[,2], stringsAsFactors=FALSE)
    
    # Marking which pairs are actual edges
    all_edges_df$edge <- mapply(function(f, t) {
      are.connected(g_full, f, t)
    }, all_edges_df$from, all_edges_df$to)
    
    # Getting positive (edges) and negative (non-edges) samples
    pos_edges <- all_edges_df[all_edges_df$edge, c("from", "to")]
    neg_edges <- all_edges_df[!all_edges_df$edge, c("from", "to")]
    
    # For cross-validation, combine positives and sample negatives to match 
    # number of positives (for balanced evaluation)
    set.seed(42)
    neg_edges <- neg_edges[sample(nrow(neg_edges), nrow(pos_edges)), ]
    data_cv <- rbind(
      data.frame(pos_edges, label=1),
      data.frame(neg_edges, label=0)
    )
    data_cv <- data_cv[sample(nrow(data_cv)), ] # Shuffle
    
    # 10-fold cross-validation
    folds <- createFolds(data_cv$label, k=10, list=TRUE, returnTrain=FALSE)
    
    # Running cross-validation & collect scores/labels
    label_all = c()
    score_pa = c()
    score_jaccard = c()
    score_adamic = c()
    score_ra = c()
    
    for(i in seq_along(folds)) {
      test_idx <- folds[[i]]
      train_edges <- data_cv[-test_idx, ]
      test_edges <- data_cv[test_idx, ]
      
      # Building training graph
      train_g <- graph_from_data_frame(train_edges[train_edges$label==1, c("from","to")], directed=FALSE, vertices=all_nodes)
      
      for(j in 1:nrow(test_edges)) {
        v1 <- test_edges$from[j]
        v2 <- test_edges$to[j]
        label_all <- c(label_all, test_edges$label[j])
        score_pa <- c(score_pa, preferential_attachment(train_g, v1, v2))
        score_jaccard <- c(score_jaccard, jaccard_score(train_g, v1, v2))
        score_adamic <- c(score_adamic, adamic_adar_score(train_g, v1, v2))
        score_ra <- c(score_ra, resource_allocation_score(train_g, v1, v2))
      }
    }
    
    # Appling 90th percentile cutoff for each predictor
    predict_by_percentile <- function(scores, percentile=0.9) {
      cutoff <- quantile(scores, probs=percentile, na.rm=TRUE)
      as.integer(scores >= cutoff)
    }
    
    pred_pa <- predict_by_percentile(score_pa)
    pred_jaccard <- predict_by_percentile(score_jaccard)
    pred_adamic <- predict_by_percentile(score_adamic)
    pred_ra <- predict_by_percentile(score_ra)
    
    # Computing precision, recall, F1 for each
    get_metrics <- function(truth, pred) {
      cm <- table(Prediction=pred, Truth=truth)
      TP <- sum(pred==1 & truth==1)
      FP <- sum(pred==1 & truth==0)
      FN <- sum(pred==0 & truth==1)
      precision <- ifelse(TP+FP==0, 0, TP/(TP+FP))
      recall <- ifelse(TP+FN==0, 0, TP/(TP+FN))
      f1 <- ifelse(precision+recall==0, 0, 2*precision*recall/(precision+recall))
      list(precision=precision, recall=recall, f1=f1)
    }
    
    metrics_pa <- get_metrics(label_all, pred_pa)
    metrics_jaccard <- get_metrics(label_all, pred_jaccard)
    metrics_adamic <- get_metrics(label_all, pred_adamic)
    metrics_ra <- get_metrics(label_all, pred_ra)
    
    # Printing results in a table
    results <- data.frame(
      Predictor = c("Preferential Attachment", "Jaccard", "Adamic-Adar", "Resource Allocation"),
      Precision = c(metrics_pa$precision, metrics_jaccard$precision, metrics_adamic$precision, metrics_ra$precision),
      Recall    = c(metrics_pa$recall, metrics_jaccard$recall, metrics_adamic$recall, metrics_ra$recall),
      F1        = c(metrics_pa$f1, metrics_jaccard$f1, metrics_adamic$f1, metrics_ra$f1)
    )
    print(results, digits=3, row.names=FALSE)
    
    # Which performs best?
    best_idx <- which.max(results$F1)
    cat(sprintf("\nBest method by F1-score: %s (F1=%.3f)\n", results$Predictor[best_idx], results$F1[best_idx]))

25.4.4

Problem

    # Draw the precision-recall curves of the four link predictors as used
    # in the previous questions. Which of those has the highest AUC?
    
    library(here)
    library(igraph)
    library(caret)
    library(PRROC)
    
    ########################### Helper functions ###################################
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Write here the solution

Solution

    # Draw the precision-recall curves of the four link predictors as used
    # in the previous questions. Which of those has the highest AUC?
    
    library(here)
    library(igraph)
    library(caret)
    library(PRROC)
    
    ########################### Helper functions ###################################
    # Predictor functions
    preferential_attachment <- function(g, v1, v2) {
      deg <- degree(g)
      deg[v1] * deg[v2]
    }
    jaccard_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      intersect_len <- length(intersect(n1, n2))
      union_len <- length(union(n1, n2))
      if (union_len == 0) return(0) else return(intersect_len / union_len)
    }
    adamic_adar_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / log(degree(g, comm)))
    }
    resource_allocation_score <- function(g, v1, v2) {
      n1 <- neighbors(g, v1)
      n2 <- neighbors(g, v2)
      comm <- intersect(n1, n2)
      if (length(comm) == 0) return(0)
      sum(1 / degree(g, comm))
    }
    ####################### End Helper functions ###################################
    
    # Reading the data and building the graph
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("from", "to")
    edges[] <- lapply(edges, as.character)
    g_full <- graph_from_edgelist(as.matrix(edges), directed=FALSE)
    
    all_nodes <- V(g_full)$name
    
    # Solution 
    
    # Generating all possible node pairs
    all_pairs <- t(combn(all_nodes, 2))
    all_edges_df <- data.frame(from=all_pairs[,1], to=all_pairs[,2], stringsAsFactors=FALSE)
    
    # Marking which pairs are actual edges
    all_edges_df$edge <- mapply(function(f, t) {
      are.connected(g_full, f, t)
    }, all_edges_df$from, all_edges_df$to)
    
    # Getting positive (edges) and negative (non-edges) samples
    pos_edges <- all_edges_df[all_edges_df$edge, c("from", "to")]
    neg_edges <- all_edges_df[!all_edges_df$edge, c("from", "to")]
    
    # For cross-validation, combine positives and sample negatives to match number of positives (for balanced evaluation)
    set.seed(42)
    neg_edges <- neg_edges[sample(nrow(neg_edges), nrow(pos_edges)), ]
    data_cv <- rbind(
      data.frame(pos_edges, label=1),
      data.frame(neg_edges, label=0)
    )
    data_cv <- data_cv[sample(nrow(data_cv)), ] # Shuffle
    
    # 10-fold cross-validation
    folds <- createFolds(data_cv$label, k=10, list=TRUE, returnTrain=FALSE)
    
    # Run cross-validation & collect scores/labels
    label_all = c()
    score_pa = c()
    score_jaccard = c()
    score_adamic = c()
    score_ra = c()
    
    for(i in seq_along(folds)) {
      test_idx <- folds[[i]]
      train_edges <- data_cv[-test_idx, ]
      test_edges <- data_cv[test_idx, ]
      
      # Building training graph
      train_g <- graph_from_data_frame(train_edges[train_edges$label==1, c("from","to")], directed=FALSE, vertices=all_nodes)
      
      for(j in 1:nrow(test_edges)) {
        v1 <- test_edges$from[j]
        v2 <- test_edges$to[j]
        label_all <- c(label_all, test_edges$label[j])
        score_pa <- c(score_pa, preferential_attachment(train_g, v1, v2))
        score_jaccard <- c(score_jaccard, jaccard_score(train_g, v1, v2))
        score_adamic <- c(score_adamic, adamic_adar_score(train_g, v1, v2))
        score_ra <- c(score_ra, resource_allocation_score(train_g, v1, v2))
      }
    }
    
    # Calculating PR curves and AUCs
    pr_pa <- pr.curve(scores.class0=score_pa[label_all==1], scores.class1=score_pa[label_all==0], curve=TRUE)
    pr_jaccard <- pr.curve(scores.class0=score_jaccard[label_all==1], scores.class1=score_jaccard[label_all==0], curve=TRUE)
    pr_adamic <- pr.curve(scores.class0=score_adamic[label_all==1], scores.class1=score_adamic[label_all==0], curve=TRUE)
    pr_ra <- pr.curve(scores.class0=score_ra[label_all==1], scores.class1=score_ra[label_all==0], curve=TRUE)
    
    # Plotting PR curves
    plot(pr_pa$curve[,1], pr_pa$curve[,2], type="l", col="red", lwd=2, xlab="Recall", ylab="Precision",
         main="Precision-Recall Curves: Link Predictors", xlim=c(0,1), ylim=c(0,1))
    lines(pr_jaccard$curve[,1], pr_jaccard$curve[,2], col="blue", lwd=2)
    lines(pr_adamic$curve[,1], pr_adamic$curve[,2], col="green", lwd=2)
    lines(pr_ra$curve[,1], pr_ra$curve[,2], col="purple", lwd=2)
    legend("topright", legend=c(
      sprintf("Pref. Attach. (AUC = %.3f)", pr_pa$auc.integral),
      sprintf("Jaccard (AUC = %.3f)", pr_jaccard$auc.integral),
      sprintf("Adamic-Adar (AUC = %.3f)", pr_adamic$auc.integral),
      sprintf("Resource Alloc. (AUC = %.3f)", pr_ra$auc.integral)
    ), col=c("red", "blue", "green", "purple"), lwd=2)
    
    # Printing AUCs and best curve
    auc_vals <- c(
      Preferential_Attachment=pr_pa$auc.integral,
      Jaccard=pr_jaccard$auc.integral,
      Adamic_Adar=pr_adamic$auc.integral,
      Resource_Allocation=pr_ra$auc.integral
    )
    print(round(auc_vals, 3))
    cat(sprintf("\nHighest PR AUC: %s (%.3f)\n", names(which.max(auc_vals)), max(auc_vals)))

26.8.1

Problem

    # Perform a network projection of the bipartite network at http:
    # //www.networkatlas.eu/exercises/26/1/data.txt using simple
    # weights. The unipartite projection should only contain nodes of
    # type 1 (|V1 | = 248). How dense is the projection?
    
    library(here)
    library(igraph)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Write here the solution

Solution

    # Perform a network projection of the bipartite network at http:
    # //www.networkatlas.eu/exercises/26/1/data.txt using simple
    # weights. The unipartite projection should only contain nodes of
    # type 1 (|V1 | = 248). How dense is the projection?
    
    library(here)
    library(igraph)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Solution 
    
    # Identifying node types
    V1 <- unique(c(edges$V1[grep("^a", edges$V1)], edges$V2[grep("^a", edges$V2)]))
    V2 <- unique(c(edges$V1[grep("^b", edges$V1)], edges$V2[grep("^b", edges$V2)]))
    
    # Preparing vertex dataframe with a type attribute (TRUE for V1, FALSE for V2)
    vertex_df <- data.frame(
      name=c(V1, V2),
      type=c(rep(TRUE, length(V1)), rep(FALSE, length(V2)))
    )
    
    # Preparing edge list so all edges are from V1 to V2 (order doesn't matter for undirected)
    edges_long <- data.frame(
      V1 = ifelse(grepl("^a", edges$V1), edges$V1, edges$V2),
      V2 = ifelse(grepl("^b", edges$V1), edges$V1, edges$V2),
      stringsAsFactors=FALSE
    )
    
    # Creating a bipartite graph
    g_bipartite <- graph_from_data_frame(edges_long, directed=FALSE, vertices=vertex_df)
    
    # Projecting onto type 1 nodes (V1, type==TRUE)
    proj <- bipartite_projection(g_bipartite)
    g_proj <- proj$proj1  # This will be the V1 projection, since we ordered the vertex_df
    
    # Calculating the density
    n <- length(V1)
    num_edges <- gsize(g_proj)
    possible_edges <- n * (n - 1) / 2
    density <- num_edges / possible_edges
    
    # Printing the results 
    cat(sprintf("Number of nodes in projection: %d\n", n))
    cat(sprintf("Number of edges in projection: %d\n", num_edges))
    cat(sprintf("Possible number of edges: %d\n", possible_edges))
    cat(sprintf("Density of the unipartite projection: %.5f\n", density))
    
    ################################################################################
    # Optional
    
    # Plotting the original bipartite network
    V(g_bipartite)$color <- ifelse(V(g_bipartite)$type, "skyblue", "salmon")
    V(g_bipartite)$shape <- ifelse(V(g_bipartite)$type, "circle", "square")
    V(g_bipartite)$size <- 3
    V(g_bipartite)$label <- NA  # hide labels for clarity
    
    # Use a bipartite layout (type1 nodes on one axis, type2 on the other)
    layout_bip <- layout_as_bipartite(g_bipartite)
    plot(
      g_bipartite,
      layout=layout_bip,
      main="Original Bipartite Network"
    )
    
    # Plotting the projected network
    set.seed(42) # For reproducible layout
    plot(
      g_proj,
      vertex.size=3,
      vertex.label=NA,
      edge.width=1,
      edge.color="gray80",
      vertex.color="skyblue",
      main="Unipartite Projection of Type 1 Nodes"
    )
    ################################################################################

26.8.2

Problem

    # Perform a network projection of the previously used bipartite
    # network using cosine and Pearson weights. What is the Pearson
    # correlation of these weights compared with the ones from the
    # previous question?
    
    library(here)
    library(igraph)
    library(Matrix)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Write here the solution

Solution

    # Perform a network projection of the previously used bipartite
    # network using cosine and Pearson weights. What is the Pearson
    # correlation of these weights compared with the ones from the
    # previous question?
    
    library(here)
    library(igraph)
    library(Matrix)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Solution 
    
    # Identifying node types (V1: starts with "a", V2: starts with "b")
    V1 <- unique(c(edges$V1[grep("^a", edges$V1)], edges$V2[grep("^a", edges$V2)]))
    V2 <- unique(c(edges$V1[grep("^b", edges$V1)], edges$V2[grep("^b", edges$V2)]))
    
    # Preparing vertex dataframe with a type attribute (TRUE for V1, FALSE for V2)
    vertex_df <- data.frame(
      name=c(V1, V2),
      type=c(rep(TRUE, length(V1)), rep(FALSE, length(V2)))
    )
    
    # Preparing edge list so all edges are from V1 to V2
    edges_long <- data.frame(
      V1 = ifelse(grepl("^a", edges$V1), edges$V1, edges$V2),
      V2 = ifelse(grepl("^b", edges$V1), edges$V1, edges$V2),
      stringsAsFactors=FALSE
    )
    
    # Creating a bipartite graph
    g_bipartite <- graph_from_data_frame(edges_long, directed=FALSE, vertices=vertex_df)
    
    # Projecting onto type 1 nodes (V1, type==TRUE, simple weights)
    proj <- bipartite_projection(g_bipartite)
    g_proj <- proj$proj1
    
    # Calculating density
    n <- length(V1)
    num_edges <- gsize(g_proj)
    possible_edges <- n * (n - 1) / 2
    density <- num_edges / possible_edges
    
    # From the previous exercise printing the results 
    cat(sprintf("Number of nodes in projection: %d\n", n))
    cat(sprintf("Number of edges in projection: %d\n", num_edges))
    cat(sprintf("Possible number of edges: %d\n", possible_edges))
    cat(sprintf("Density of the unipartite projection: %.5f\n", density))
    
    ################################################################################
    # Optional
    
    # Plotting the projected network (simple weights)
    set.seed(42)
    plot(
      g_proj,
      vertex.size=3,
      vertex.label=NA,
      edge.width=1,
      edge.color="gray80",
      vertex.color="skyblue",
      main="Unipartite Projection (Simple Weights)"
    )
    
    # Plotting the original bipartite network
    V(g_bipartite)$color <- ifelse(V(g_bipartite)$type, "skyblue", "salmon")
    V(g_bipartite)$shape <- ifelse(V(g_bipartite)$type, "circle", "square")
    V(g_bipartite)$size <- 3
    V(g_bipartite)$label <- NA  # hide labels for clarity
    
    layout_bip <- layout_as_bipartite(g_bipartite)
    plot(
      g_bipartite,
      layout=layout_bip,
      main="Original Bipartite Network"
    )
    ################################################################################
    
    ################ Cosine and Pearson Weighted Projections #######################
    
    # Bipartite incidence matrix (rows: V1, cols: V2)
    A <- as_incidence_matrix(g_bipartite, types=vertex_df$type, sparse=TRUE)
    A <- as(A, "dgCMatrix") # Ensure sparse matrix
    
    #  Cosine similarity matrix
    norms <- sqrt(rowSums(A^2))
    cosine_sim <- as.matrix(A %*% t(A))
    norms_mat <- outer(norms, norms)
    cosine_sim <- cosine_sim / norms_mat
    diag(cosine_sim) <- 0 # Remove self-loops
    cosine_sim[is.na(cosine_sim)] <- 0
    
    #  Pearson similarity matrix
    A_centered <- A - rowMeans(A)
    pearson_num <- as.matrix(A_centered %*% t(A_centered))
    pearson_denom <- outer(
      sqrt(rowSums((A - rowMeans(A))^2)),
      sqrt(rowSums((A - rowMeans(A))^2))
    )
    pearson_sim <- pearson_num / pearson_denom
    diag(pearson_sim) <- 0
    pearson_sim[is.na(pearson_sim)] <- 0
    
    # Building edges for upper triangle only (i < j), using V1 names
    get_upper_edges <- function(sim_matrix, node_names, min_weight = 0) {
      idx <- which(upper.tri(sim_matrix) & sim_matrix > min_weight, arr.ind=TRUE)
      if(nrow(idx) == 0) return(data.frame(from=character(), to=character(), weight=numeric()))
      data.frame(
        from = node_names[idx[,1]],
        to   = node_names[idx[,2]],
        weight = sim_matrix[idx],
        stringsAsFactors = FALSE
      )
    }
    
    edges_cosine <- get_upper_edges(cosine_sim, V1)
    edges_pearson <- get_upper_edges(pearson_sim, V1)
    
    # Cleaning up: removing NAs, NaNs, empties, self-loops, and non-existent nodes (shouldn't happen, but robust)
    edges_cosine <- subset(edges_cosine, 
                           !is.na(from) & !is.na(to) & from != "" & to != "" & !is.nan(weight) & from %in% V1 & to %in% V1 & from != to
    )
    edges_pearson <- subset(edges_pearson, 
                            !is.na(from) & !is.na(to) & from != "" & to != "" & !is.nan(weight) & from %in% V1 & to %in% V1 & from != to
    )
    
    # Removing duplicate edges (if any)
    edges_cosine <- unique(edges_cosine)
    edges_pearson <- unique(edges_pearson)
    
    # Only building the graph if there are edges
    if (nrow(edges_cosine) > 0) {
      g_cosine <- graph_from_data_frame(edges_cosine, directed=FALSE, vertices=data.frame(name=V1))
      E(g_cosine)$weight <- edges_cosine$weight
    } else {
      warning("No edges in cosine projection.")
      g_cosine <- make_empty_graph(n = length(V1))
    }
    
    if (nrow(edges_pearson) > 0) {
      g_pearson <- graph_from_data_frame(edges_pearson, directed=FALSE, vertices=data.frame(name=V1))
      E(g_pearson)$weight <- edges_pearson$weight
    } else {
      warning("No edges in Pearson projection.")
      g_pearson <- make_empty_graph(n = length(V1))
    }
    
    ################################# Optional #####################################
    # Plotting Cosine Weights
    set.seed(42)
    plot(
      g_cosine,
      vertex.size=3,
      vertex.label=NA,
      edge.width=E(g_cosine)$weight * 5, # scale for visibility
      edge.color=rgb(0,0,0,alpha=0.3),
      vertex.color="skyblue",
      main="Projection (Cosine Similarity Weights)"
    )
    
    # Plotting Pearson Weights
    set.seed(42)
    plot(
      g_pearson,
      vertex.size=3,
      vertex.label=NA,
      edge.width=pmax(E(g_pearson)$weight,0) * 5,
      edge.color=rgb(0,0,1,alpha=0.3),
      vertex.color="skyblue",
      main="Projection (Pearson Similarity Weights)"
    )
    ################################################################################
    
    # Pearson correlation of weights (simple vs cosine, simple vs pearson, cosine vs pearson)
    simple_weights <- E(g_proj)$weight
    names(simple_weights) <- apply(as.data.frame(ends(g_proj, E(g_proj))), 1, function(x) paste(sort(x), collapse = "_"))
    cosine_weights <- edges_cosine$weight
    names(cosine_weights) <- apply(edges_cosine[,1:2], 1, function(x) paste(sort(x), collapse = "_"))
    pearson_weights <- edges_pearson$weight
    names(pearson_weights) <- apply(edges_pearson[,1:2], 1, function(x) paste(sort(x), collapse = "_"))
    
    # Only comparing weights where an edge is present in all projections
    common_keys <- Reduce(intersect, list(names(simple_weights), names(cosine_weights), names(pearson_weights)))
    cat(sprintf("Number of common edges between all projections: %d\n", length(common_keys)))
    
    if(length(common_keys) > 1) {
      cat(sprintf("Pearson correlation (simple vs cosine): %.4f\n",
                  cor(simple_weights[common_keys], cosine_weights[common_keys])))
      cat(sprintf("Pearson correlation (simple vs pearson): %.4f\n",
                  cor(simple_weights[common_keys], pearson_weights[common_keys])))
      cat(sprintf("Pearson correlation (cosine vs pearson): %.4f\n",
                  cor(cosine_weights[common_keys], pearson_weights[common_keys])))
    } else {
      cat("Not enough common edges to compute Pearson correlations.\n")
    }

26.8.3

Problem

    # Perform a network projection of the previously used bipartite
    # network using hyperbolic weights. Draw a scatter plot comparing
    # hyperbolic and simple weights.
    
    library(here)
    library(igraph)
    library(Matrix)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Write here the solution

Solution

    # Perform a network projection of the previously used bipartite
    # network using hyperbolic weights. Draw a scatter plot comparing
    # hyperbolic and simple weights.
    
    library(here)
    library(igraph)
    library(Matrix)
    
    # Reading the bipartite edge list
    edges <- read.table("data.txt", header=FALSE, stringsAsFactors=FALSE)
    colnames(edges) <- c("V1", "V2")
    
    # Solution
    
    # Identifying node types (V1: starts with "a", V2: starts with "b")
    V1 <- unique(c(edges$V1[grep("^a", edges$V1)], edges$V2[grep("^a", edges$V2)]))
    V2 <- unique(c(edges$V1[grep("^b", edges$V1)], edges$V2[grep("^b", edges$V2)]))
    
    # Preparing vertex dataframe with a type attribute (TRUE for V1, FALSE for V2)
    vertex_df <- data.frame(
      name = c(V1, V2),
      type = c(rep(TRUE, length(V1)), rep(FALSE, length(V2)))
    )
    
    # Preparing edge list so all edges are from V1 to V2
    edges_long <- data.frame(
      V1 = ifelse(grepl("^a", edges$V1), edges$V1, edges$V2),
      V2 = ifelse(grepl("^b", edges$V1), edges$V1, edges$V2),
      stringsAsFactors = FALSE
    )
    
    # Creating bipartite graph
    g_bipartite <- graph_from_data_frame(edges_long, directed=FALSE, vertices=vertex_df)
    
    # Projecting onto type 1 nodes (V1) using simple weights (number of shared neighbors in V2)
    proj <- bipartite_projection(g_bipartite)
    g_proj <- proj$proj1
    
    # Incidence matrix (rows: V1 nodes, cols: V2 nodes)
    A <- as_incidence_matrix(g_bipartite, types=vertex_df$type, sparse=TRUE)
    A <- as(A, "dgCMatrix") # Ensure sparse matrix
    V1_names <- rownames(A)
    V2_names <- colnames(A)
    
    # Hyperbolic weights (using rownames(A) for matrix names and all node accesses)
    hyperbolic_weights <- matrix(0, nrow=length(V1_names), ncol=length(V1_names), dimnames=list(V1_names, V1_names))
    deg_V2 <- Matrix::colSums(A) # degree for each V2 node
    
    for (k in which(deg_V2 > 1)) {
      v2 <- V2_names[k]
      nodes <- V1_names[which(A[, v2] == 1)]
      if(length(nodes) < 2) next
      w <- 1 / (deg_V2[k] - 1)
      for(i in 1:(length(nodes)-1)) {
        for(j in (i+1):length(nodes)) {
          hyperbolic_weights[nodes[i], nodes[j]] <- hyperbolic_weights[nodes[i], nodes[j]] + w
          hyperbolic_weights[nodes[j], nodes[i]] <- hyperbolic_weights[nodes[j], nodes[i]] + w
        }
      }
    }
    
    # Extracting simple weights for V1 pairs
    simple_weights <- as.matrix(A %*% t(A))
    diag(simple_weights) <- 0 # remove self-loops
    
    # Preparing data for scatter plot (upper triangle, i < j)
    scatter_data <- data.frame(
      from = character(), to = character(),
      simple = numeric(), hyperbolic = numeric(),
      stringsAsFactors = FALSE
    )
    for(i in 1:(length(V1_names)-1)) {
      for(j in (i+1):length(V1_names)) {
        s <- simple_weights[V1_names[i], V1_names[j]]
        h <- hyperbolic_weights[V1_names[i], V1_names[j]]
        if(s > 0 || h > 0) {
          scatter_data <- rbind(scatter_data, data.frame(
            from=V1_names[i], to=V1_names[j], simple=s, hyperbolic=h
          ))
        }
      }
    }
    
    # Scatter plot: hyperbolic vs simple weights
    plot(
      scatter_data$simple, scatter_data$hyperbolic,
      pch=20, col=rgb(0,0,1,0.5),
      xlab="Simple Weight (shared neighbors)", ylab="Hyperbolic Weight",
      main="Scatter Plot: Hyperbolic vs Simple Weights"
    )
    abline(0, 1, col="red", lty=2)
    
    ################################################################################
    # Optional
    
    # Printing correlation
    cor_val <- cor(scatter_data$simple, scatter_data$hyperbolic)
    cat(sprintf("Pearson correlation between simple and hyperbolic weights: %.4f\n", cor_val))
    ################################################################################

27.8.1

Problem

    # Plot the CCDF edge weight distribution of the network at http:
    # //www.networkatlas.eu/exercises/27/1/data.txt. Calculate its
    # average and standard deviation. NOTE: this is a directed graph!
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Extract edge weights
    w <- E(g)$weight
    
    # Write ehre the solution

Solution

    # Plot the CCDF edge weight distribution of the network at http:
    # //www.networkatlas.eu/exercises/27/1/data.txt. Calculate its
    # average and standard deviation. NOTE: this is a directed graph!
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Extract edge weights
    w <- E(g)$weight
    
    # Solution 
    
    # Computing average and standard deviation of edge weights
    w_mean <- mean(w)
    w_sd <- sd(w)
    cat(sprintf("Average edge weight: %.2f\n", w_mean))
    cat(sprintf("Standard deviation of edge weights: %.2f\n", w_sd))
    
    # Computing CCDF
    w_sorted <- sort(w)
    ccdf <- 1 - ecdf(w_sorted)(w_sorted) + 1/length(w_sorted)
    
    # Plotting CCDF (log-log scale, typical for weight distributions)
    plot(
      w_sorted, ccdf,
      log="xy",
      type="s",
      xlab="Edge weight",
      ylab="CCDF",
      main="CCDF of Edge Weights"
    )
    grid()
    
    legend(
      "bottomleft",
      legend=c(
        sprintf("Mean = %.2f", w_mean),
        sprintf("SD = %.2f", w_sd)
      ),
      bty="n"
    )

27.8.2

Problem

    # What is the minimum statistically significant edge weight – the
    # one two standard deviations away from the average – of the previ-
    # ous network? How many edges would you keep if you were to set
    # that as the threshold?
    
    library(here)
    library(igraph)
    
    # Reading the edge list from file
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Extracting edge weights
    w <- E(g)$weight
    
    # Write here the solution

Solution

    # What is the minimum statistically significant edge weight – the
    # one two standard deviations away from the average – of the previ-
    # ous network? How many edges would you keep if you were to set
    # that as the threshold?
    
    library(here)
    library(igraph)
    
    # Reading the edge list from file
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Extracting edge weights
    w <- E(g)$weight
    
    # Solution 
    
    # Computing mean and standard deviation
    w_mean <- mean(w)
    w_sd <- sd(w)
    # Minimum statistically significant edge weight (mean + 2*sd)
    threshold <- w_mean + 2*w_sd
    
    
    # Printing solutions 
    cat(sprintf("Average edge weight: %.2f\n", w_mean))
    cat(sprintf("Standard deviation: %.2f\n", w_sd))
    cat(sprintf("Minimum statistically significant edge weight (mean + 2*sd): %.2f\n", threshold))
    
    # How many edges meet or exceed this threshold?
    n_above <- sum(w >= threshold)
    cat(sprintf("Number of edges retained with threshold %.2f: %d (out of %d)\n", threshold, n_above, length(w)))

27.8.3

Problem

    # Can you calculate the doubly stochastic adjacency matrix of
    # the network used in the previous exercise? Does the calculation
    # eventually converge? (Limit the normalization attempts to 1,000. If
    # by 1,000 normalizations you don’t have a doubly stochastic matrix,
    # the calculation didn’t converge)
    
    library(here)
    library(igraph)
    
    # Reading the edge list from file
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Write here the solution

Solution

    # Can you calculate the doubly stochastic adjacency matrix of
    # the network used in the previous exercise? Does the calculation
    # eventually converge? (Limit the normalization attempts to 1,000. If
    # by 1,000 normalizations you don’t have a doubly stochastic matrix,
    # the calculation didn’t converge)
    
    library(here)
    library(igraph)
    
    # Reading the edge list from file
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Solution 
    
    # Getting the adjacency matrix (rows/cols: all nodes, values: weights)
    A <- as.matrix(as_adjacency_matrix(g, attr="weight", sparse=FALSE))
    
    # Preparing the matrix for normalization (only positive values, fill zeros for missing edges)
    A[is.na(A)] <- 0
    
    # Function to normalize rows or columns to sum to 1
    normalize_rows <- function(mat) {
      rs <- rowSums(mat)
      rs[rs == 0] <- 1 # avoid division by zero
      mat/rs
    }
    normalize_cols <- function(mat) {
      cs <- colSums(mat)
      cs[cs == 0] <- 1 # avoid division by zero
      t(t(mat)/cs)
    }
    
    # Iterative normalization: alternate row and column normalization
    max_iter <- 1000
    tol <- 1e-8
    converged <- FALSE
    for(i in 1:max_iter) {
      old_A <- A
      A <- normalize_rows(A)
      A <- normalize_cols(A)
      # Check convergence: all row and col sums close to 1
      row_diff <- max(abs(rowSums(A) - 1))
      col_diff <- max(abs(colSums(A) - 1))
      if(row_diff < tol && col_diff < tol) {
        converged <- TRUE
        cat(sprintf("Converged after %d iterations.\n", i))
        break
      }
    }
    if(!converged) {
      cat("Did NOT converge after 1000 iterations.\n")
    }
    
    ################################################################################
    
    # Optional
    # Showing summary of the final matrix
    cat("summary of the final matrix \n")
    cat("\n Max row sum deviation from 1:", max(abs(rowSums(A) - 1)), "\n")
    cat("Max col sum deviation from 1:", max(abs(colSums(A) - 1)), "\n")
    
    # Printing the entire matrix (rounded for readability)
    cat("Entire doubly stochastic matrix (rounded to 4 decimals):\n")
    print(round(A, 4))
    
    # Plotting the entire matrix
    par(bg="white")
    image(
      t(A[nrow(A):1, ]),                        # flip vertically for intuitive axes
      main = "Doubly Stochastic Matrix",
      xlab = "Columns",
      ylab = "Rows",
      col = gray.colors(100, start=1, end=0),   # white to black
      axes = FALSE
    )
    box()
    axis(1, at=seq(0,1,length.out=ncol(A)), labels=colnames(A), las=2, cex.axis=0.5)
    axis(2, at=seq(0,1,length.out=nrow(A)), labels=rev(rownames(A)), las=2, cex.axis=0.5)
    ################################################################################

27.8.4

Problem

    # How many edges would you keep if you were to return the dou-
    # bly stochastic backbone including all nodes in the network in a
    # single (weakly) connected component with the minimum number
    # of edges?
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Write here the solution

Solution

    # How many edges would you keep if you were to return the dou-
    # bly stochastic backbone including all nodes in the network in a
    # single (weakly) connected component with the minimum number
    # of edges?
    
    library(here)
    library(igraph)
    
    # Reading the edge list
    edges <- read.table("data.txt", header=FALSE, sep="\t", stringsAsFactors=FALSE)
    colnames(edges) <- c("from", "to", "weight")
    
    # Creating a directed, weighted graph
    g <- graph_from_data_frame(edges, directed=TRUE)
    
    # Solution 
    
    # Getting the adjacency matrix (rows/cols: all nodes, values: weights)
    A <- as.matrix(as_adjacency_matrix(g, attr="weight", sparse=FALSE))
    A[is.na(A)] <- 0
    
    # Doubling stochastic normalization (Sinkhorn-Knopp algorithm)
    normalize_rows <- function(mat) {
      rs <- rowSums(mat)
      rs[rs == 0] <- 1
      mat/rs
    }
    normalize_cols <- function(mat) {
      cs <- colSums(mat)
      cs[cs == 0] <- 1
      t(t(mat)/cs)
    }
    max_iter <- 1000
    tol <- 1e-8
    for(i in 1:max_iter) {
      A <- normalize_rows(A)
      A <- normalize_cols(A)
      if(max(abs(rowSums(A) - 1)) < tol && max(abs(colSums(A) - 1)) < tol) {
        cat(sprintf("Doubly stochastic normalization converged after %d iterations.\n", i))
        break
      }
      if(i == max_iter) cat("Doubly stochastic normalization did NOT fully converge in 1000 iterations.\n")
    }
    
    # Building undirected weighted graph from the final matrix (ignore direction, sum weights)
    A_sym <- (A + t(A)) / 2
    diag(A_sym) <- 0
    
    g_und <- graph_from_adjacency_matrix(A_sym, mode="undirected", weighted=TRUE, diag=FALSE)
    
    # Computing minimum spanning tree (MST) to get the backbone with minimal edges
    E(g_und)$neg_weight <- -E(g_und)$weight
    mst <- mst(g_und, weights=E(g_und)$neg_weight)
    
    # Number of nodes and edges in the backbone
    n_nodes <- vcount(mst)
    n_edges <- ecount(mst)
    cat(sprintf("Number of nodes: %d\n", n_nodes))
    cat(sprintf("Number of edges in backbone: %d\n", n_edges))
    
    # Checking connectivity
    if(is.connected(mst, mode="weak")) {
      cat("The backbone is (weakly) connected and includes all nodes.\n")
    } else {
      cat("The backbone is NOT connected!\n")
    }
    
    # Printing the edge list of the backbone
    cat("Edge list of the backbone (minimum, undirected):\n")
    print(get.data.frame(mst))
    
    ################################################################################
    # Optional 
    # Plotting the backbone
    plot(mst, main="Doubly Stochastic Backbone (Minimum Edges)", edge.width=2)
    ################################################################################

28.6.1

Problem

    # Consider the network at http://www.networkatlas.eu/exercises/
    # 28/1/data.txt. This is an undirected probabilistic network with
    # four columns: the two connected nodes, the probability of the edge
    # existing and the probability of the edge non existing. Generate all
    # of its possible worlds, together with their probability of existing.
    # (Note, you can ignore the fourth column for this exercise)
    
    #library(here)
    library(igraph)
    
    #Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    
    # Write here the solution

Solution

    # Consider the network at http://www.networkatlas.eu/exercises/
    # 28/1/data.txt. This is an undirected probabilistic network with
    # four columns: the two connected nodes, the probability of the edge
    # existing and the probability of the edge non existing. Generate all
    # of its possible worlds, together with their probability of existing.
    # (Note, you can ignore the fourth column for this exercise)
    
    library(here)
    library(igraph)
    
    #Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    
    # Solution 
    
    # Generating all possible worlds
    worlds <- expand.grid(replicate(n_edges, c(0,1), simplify=FALSE))
    colnames(worlds) <- paste0("edge", 1:n_edges)
    
    # Computing probabilities and pretty print
    cat("Possible worlds (edges present = 1, absent = 0) and their probabilities:\n\n")
    
    for(i in 1:nrow(worlds)) {
      world <- as.numeric(worlds[i,])
      # For each edge, use p if present, (1-p) if absent
      probs <- ifelse(world == 1, edges$p_exist, 1 - edges$p_exist)
      prob_world <- prod(probs)
      present_edges <- paste0("[", edges$node1[world==1], "-", edges$node2[world==1], "]", collapse=" ")
      absent_edges <- paste0("[", edges$node1[world==0], "-", edges$node2[world==0], "]", collapse=" ")
      cat(sprintf(
        "World %2d: Present: %-20s  Absent: %-20s  P=%.4f\n",
        i, ifelse(present_edges=="", "(none)", present_edges),
        ifelse(absent_edges=="", "(none)", absent_edges),
        prob_world
      ))
    }
    
    ################################################################################
    # Optional
    
    # Plotting the probabilistic network with edge widths proportional to probability
    g <- graph_from_data_frame(edges[,1:2], directed=FALSE)
    E(g)$weight <- edges$p_exist
    E(g)$label <- round(edges$p_exist, 2)
    
    set.seed(1)
    plot(
      g,
      edge.width = 3 + 7*E(g)$weight,
      edge.label = E(g)$label,
      edge.color = "darkgray",
      vertex.size = 30,
      vertex.label.color = "black",
      vertex.color = "skyblue",
      main = "Probabilistic Network (edge label = probability, width ∝ probability)"
    )
    ################################################################################

28.6.2

Problem

    # Calculate the probabilistic degree distribution of the network used
    # in exercise 1. (Note, you can ignore the fourth column for this
    # exercise)
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    n_nodes <- length(nodes)
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    
    # Write here the solution

Solution

    # Calculate the probabilistic degree distribution of the network used
    # in exercise 1. (Note, you can ignore the fourth column for this
    # exercise)
    
    library(here)
    
    # Reading the data 
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    n_nodes <- length(nodes)
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    
    # Solution 
    
    # Generating all possible worlds (edge presence/absence)
    worlds <- expand.grid(replicate(n_edges, c(0,1), simplify=FALSE))
    colnames(worlds) <- paste0("edge", 1:n_edges)
    
    # Tracking degree distribution for each node
    max_degree <- n_edges  # upper bound for degree in this small network
    deg_probs <- matrix(0, nrow=n_nodes, ncol=max_degree+1, dimnames=list(nodes, 0:max_degree))
    
    for(i in 1:nrow(worlds)) {
      world <- as.numeric(worlds[i,])
      # For each edge, use p if present, (1-p) if absent
      probs <- ifelse(world == 1, edges$p_exist, 1 - edges$p_exist)
      prob_world <- prod(probs)
      
      # Building adjacency for this world
      adj <- matrix(0, nrow=n_nodes, ncol=n_nodes, dimnames=list(nodes, nodes))
      for(j in seq_len(n_edges)) {
        if (world[j] == 1) {
          a <- as.character(edges$node1[j])
          b <- as.character(edges$node2[j])
          adj[a, b] <- 1
          adj[b, a] <- 1
        }
      }
      # Calculating degree for each node in this world
      degs <- rowSums(adj)
      for (k in seq_along(nodes)) {
        deg_val <- degs[k]
        deg_probs[k, deg_val+1] <- deg_probs[k, deg_val+1] + prob_world
      }
    }
    
    # Printing the results
    cat("Probabilistic degree distribution for each node:\n")
    for (i in seq_along(nodes)) {
      node <- nodes[i]
      dist <- deg_probs[i,]
      nonzero <- which(dist > 0)
      cat(sprintf("Node %s:\n", node))
      for (d in nonzero-1) {
        cat(sprintf("  Degree %d: P = %.4f\n", d, dist[d+1]))
      }
    }

28.6.3

Problem

    # Estimate the reliabilities of node 4 from the previous network with
    # each of the other nodes in the network. (Note, you can ignore the
    # fourth column for this exercise)
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    target_node <- "4"
    other_nodes <- setdiff(nodes, target_node)
    
    # Write here the solution

Solution

    # Estimate the reliabilities of node 4 from the previous network with
    # each of the other nodes in the network. (Note, you can ignore the
    # fourth column for this exercise)
    
    library(here)
    library(igraph)
    
    # Reading the data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_exist", "p_not_exist")
    edges$p_exist <- as.numeric(edges$p_exist)
    
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    n_edges <- nrow(edges)
    n_worlds <- 2^n_edges
    target_node <- "4"
    other_nodes <- setdiff(nodes, target_node)
    
    # Solution 
    
    # Generating all possible worlds
    worlds <- expand.grid(replicate(n_edges, c(0,1), simplify=FALSE))
    colnames(worlds) <- paste0("edge", 1:n_edges)
    
    # Initializing reliabilities
    reliabilities <- setNames(rep(0, length(other_nodes)), other_nodes)
    
    for(i in 1:nrow(worlds)) {
      world <- as.numeric(worlds[i,])
      probs <- ifelse(world == 1, edges$p_exist, 1 - edges$p_exist)
      prob_world <- prod(probs)
      
      # Building igraph for this world
      present <- which(world == 1)
      if (length(present) == 0) next
      g_world <- graph_from_data_frame(
        edges[present, 1:2, drop=FALSE], directed=FALSE, vertices=nodes
      )
      
      # For each other node, check if connected to node 4
      for (node in other_nodes) {
        if (are.connected(g_world, as.character(target_node), as.character(node)) ||
            (target_node %in% V(g_world)$name && node %in% V(g_world)$name &&
             (length(shortest_paths(g_world, from=as.character(target_node), to=as.character(node))$vpath[[1]]) > 0
             ))) {
          reliabilities[node] <- reliabilities[node] + prob_world
        }
      }
    }
    
    # Printing results
    cat(sprintf("Reliabilities of node %s with other nodes:\n", target_node))
    for (node in other_nodes) {
      cat(sprintf("  Node %s: %.4f\n", node, reliabilities[node]))
    }

28.6.4

Problem

    # Calculate the length of the shortest path between node 2 and node
    # 4 in the previous network using fuzzy logic, assuming that the
    # third column reports the probability of the edge to have weight 1
    # and the fourth column reports the probability of the edge to have
    # weight 2.
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_1", "p_2")
    edges$p_1 <- as.numeric(edges$p_1)
    edges$p_2 <- as.numeric(edges$p_2)
    
    n_edges <- nrow(edges)
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    
    # Write here the solution

Solution

    # Calculate the length of the shortest path between node 2 and node
    # 4 in the previous network using fuzzy logic, assuming that the
    # third column reports the probability of the edge to have weight 1
    # and the fourth column reports the probability of the edge to have
    # weight 2.
    
    library(here)
    library(igraph)
    
    # Loading data
    edges <- read.table("data.txt", header=FALSE)
    colnames(edges) <- c("node1", "node2", "p_1", "p_2")
    edges$p_1 <- as.numeric(edges$p_1)
    edges$p_2 <- as.numeric(edges$p_2)
    
    n_edges <- nrow(edges)
    nodes <- sort(unique(c(edges$node1, edges$node2)))
    
    # Solution 
    
    # Generating all possible edge weight combinations (worlds)
    worlds <- expand.grid(replicate(n_edges, c(1,2), simplify=FALSE))
    colnames(worlds) <- paste0("edge", 1:n_edges)
    
    # Function to get probability of a world
    world_prob <- function(weights, p1s, p2s) {
      prod(ifelse(weights == 1, p1s, p2s))
    }
    
    # For each world, calculate shortest path from 2 to 4
    dist_probs <- list()
    for (i in 1:nrow(worlds)) {
      weights <- as.numeric(worlds[i,])
      # World probability
      prob <- world_prob(weights, edges$p_1, edges$p_2)
      # Constructing weighted graph for this world
      g_world <- graph_from_data_frame(
        edges[, 1:2], directed=FALSE, vertices=nodes
      )
      E(g_world)$weight <- weights
      # Computing shortest path length from 2 to 4
      path_len <- suppressWarnings(shortest.paths(g_world, v="2", to="4", mode="all", weights=E(g_world)$weight))
      # If no path, path_len will be Inf
      if (is.infinite(path_len)) {
        path_len <- NA
      }
      # Adding probability to this path length
      key <- as.character(path_len)
      if (is.null(dist_probs[[key]])) dist_probs[[key]] <- 0
      dist_probs[[key]] <- dist_probs[[key]] + prob
    }
    
    # Printing the fuzzy shortest path distribution
    cat("Fuzzy shortest path length distribution (from node 2 to 4):\n")
    for (k in sort(names(dist_probs))) {
      if (is.na(as.numeric(k))) {
        cat(sprintf("  No path: P = %.4f\n", dist_probs[[k]]))
      } else {
        cat(sprintf("  Length = %s: P = %.4f\n", k, dist_probs[[k]]))
      }
    }

29.7.1

Problem

    # Perform a random walk sampling of the network at http://www.
    # networkatlas.eu/exercises/29/1/data.txt. Sample 2,000 nodes
    # (1% of the network) and all their connections (note: the sample
    # will end up having more than 2,000 nodes).
    
    library(here)
    library(igraph)
    
    # Loading the network from file
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    
    # Creating the graph (assuming undirected network)
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    # Write here the solution

Solution

    # Perform a random walk sampling of the network at http://www.
    # networkatlas.eu/exercises/29/1/data.txt. Sample 2,000 nodes
    # (1% of the network) and all their connections (note: the sample
    # will end up having more than 2,000 nodes).
    
    library(here)
    library(igraph)
    
    # Loading the network from file
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    
    # Creating the graph (assuming undirected network)
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    # This should be the Solution 
    
    # Random Walk Sampling
    target_sample_size <- 2000
    
    all_nodes <- V(g)$name
    start_node <- sample(all_nodes, 1)
    sampled_nodes <- c(start_node)
    visited <- setNames(rep(FALSE, vcount(g)), all_nodes)
    visited[start_node] <- TRUE
    
    current_node <- start_node
    
    while (length(sampled_nodes) < target_sample_size) {
      neighbors_vec <- neighbors(g, current_node)
      if (length(neighbors_vec) == 0) {
        # pick a new random node if stuck (isolated)
        current_node <- sample(all_nodes, 1)
      } else {
        # choose a random neighbor and extract its name
        next_vertex <- sample(neighbors_vec, 1)
        next_node <- V(g)[next_vertex]$name
        if (!visited[next_node]) {
          sampled_nodes <- c(sampled_nodes, next_node)
          visited[next_node] <- TRUE
        }
        current_node <- next_node
      }
    }
    
    # Getting all edges with at least one endpoint in sampled_nodes
    sub_edges <- edges[edges$from %in% sampled_nodes | edges$to %in% sampled_nodes, ]
    
    # Creating the sampled subgraph
    g_sampled <- graph_from_data_frame(sub_edges, directed = FALSE)
    
    # Plotting the graph 
    
    set.seed(42)
    plot(
      g_sampled,
      vertex.size = 3,
      vertex.label = NA,
      edge.arrow.size = 0.2,
      main = sprintf("Random Walk Sampled Subgraph (%d+ nodes)", length(V(g_sampled)))
    )

29.7.2

Problem

    # Compare the CCDF of your sample with the one of the original
    # network by fitting a log-log regression and comparing the ex-
    # ponents. You can take multiple samples from different seeds to
    # ensure the robustness of your result.
    
    library(here)
    library(igraph)
    
    # Loading the network from file
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    ################################################################################
    # Helper functions 
    
    # Helper function to compute CCDF of a degree vector
    compute_ccdf <- function(degrees) {
      tab <- table(degrees)
      degs <- as.numeric(names(tab))
      freq <- as.numeric(tab)
      prob <- freq / sum(freq)
      ccdf <- rev(cumsum(rev(prob)))
      data.frame(degree = degs, ccdf = ccdf)
    }
    
    # Helper function to fit log-log regression and return the exponent/slope
    fit_log_log <- function(ccdf_df) {
      valid <- ccdf_df$degree > 0 & ccdf_df$ccdf > 0
      fit <- lm(log10(ccdf) ~ log10(degree), data = ccdf_df[valid, ])
      coef(fit)[2] # Slope
    }
    
    ################################################################################a
    
    # Parameters
    n_samples <- 5                   # Number of samples for robustness
    target_sample_size <- 2000       # As before
    seeds <- 100 * (1:n_samples)     # Example: 100, 200, 300,...
    
    # Write here the solution

Solution

    # Compare the CCDF of your sample with the one of the original
    # network by fitting a log-log regression and comparing the ex-
    # ponents. You can take multiple samples from different seeds to
    # ensure the robustness of your result.
    
    library(here)
    library(igraph)
    
    # Loading the network from file
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    ################################################################################
    # Helper functions 
    
    # Helper function to compute CCDF of a degree vector
    compute_ccdf <- function(degrees) {
      tab <- table(degrees)
      degs <- as.numeric(names(tab))
      freq <- as.numeric(tab)
      prob <- freq / sum(freq)
      ccdf <- rev(cumsum(rev(prob)))
      data.frame(degree = degs, ccdf = ccdf)
    }
    
    # Helper function to fit log-log regression and return the exponent/slope
    fit_log_log <- function(ccdf_df) {
      valid <- ccdf_df$degree > 0 & ccdf_df$ccdf > 0
      fit <- lm(log10(ccdf) ~ log10(degree), data = ccdf_df[valid, ])
      coef(fit)[2] # Slope
    }
    
    ################################################################################a
    
    # Parameters
    n_samples <- 5                   # Number of samples for robustness
    target_sample_size <- 2000       # As before
    seeds <- 100 * (1:n_samples)     # Example: 100, 200, 300,...
    
    # This should be the solution 
    
    # Computing degree distribution and CCDF of the original graph
    orig_degrees <- degree(g)
    orig_ccdf <- compute_ccdf(orig_degrees)
    orig_exponent <- fit_log_log(orig_ccdf)
    
    cat(sprintf("Original network log-log CCDF exponent: %.3f\n", orig_exponent))
    
    # For storing sampled exponents and last sampled graph
    sampled_exponents <- numeric(n_samples)
    last_g_sampled <- NULL
    
    # Sampling and analysis
    for (i in seq_along(seeds)) {
      set.seed(seeds[i])
      
      # Random Walk Sampling
      all_nodes <- V(g)$name
      start_node <- sample(all_nodes, 1)
      sampled_nodes <- c(start_node)
      visited <- setNames(rep(FALSE, vcount(g)), all_nodes)
      visited[start_node] <- TRUE
      current_node <- start_node
      while (length(sampled_nodes) < target_sample_size) {
        neighbors_vec <- neighbors(g, current_node)
        if (length(neighbors_vec) == 0) {
          current_node <- sample(all_nodes, 1)
        } else {
          next_vertex <- sample(neighbors_vec, 1)
          next_node <- V(g)[next_vertex]$name
          if (!visited[next_node]) {
            sampled_nodes <- c(sampled_nodes, next_node)
            visited[next_node] <- TRUE
          }
          current_node <- next_node
        }
      }
      sub_edges <- edges[edges$from %in% sampled_nodes | edges$to %in% sampled_nodes, ]
      g_sampled <- graph_from_data_frame(sub_edges, directed = FALSE)
      last_g_sampled <- g_sampled
      
      # Computing sampled degree distribution and CCDF
      sample_degrees <- degree(g_sampled)
      sample_ccdf <- compute_ccdf(sample_degrees)
      sampled_exponents[i] <- fit_log_log(sample_ccdf)
      
      # Plotting for the first sample
      if (i == 1) {
        plot(orig_ccdf$degree, orig_ccdf$ccdf, log = "xy", type = "l", col = "red", lwd = 2,
             xlab = "Degree (k)", ylab = "CCDF (P(K>=k))",
             main = "CCDF (log-log) of Original vs Sampled Network")
        lines(sample_ccdf$degree, sample_ccdf$ccdf, col = "blue", lwd = 2)
        legend("bottomleft", legend = c("Original", "Sampled"), col = c("red", "blue"), lwd = 2)
      }
    }
    
    cat(sprintf("Sampled network log-log CCDF exponents: %s\n", paste(round(sampled_exponents, 3), collapse = ", ")))
    cat(sprintf("Mean sampled exponent: %.3f, SD: %.3f\n", mean(sampled_exponents), sd(sampled_exponents)))
    
    ################################################################################
    # Optional 
    # Plotting the last sampled network
    
    set.seed(42)
    plot(
      last_g_sampled,
      vertex.size = 3,
      vertex.label = NA,
      edge.arrow.size = 0.2,
      main = sprintf(
        "Random Walk Sampled Subgraph (last sample, %d nodes)",
        length(V(last_g_sampled))
      )
    )
    ################################################################################

29.7.3

Problem

    # Modify the degree distribution of your sample using the Re-
    # Weighted Random Walk technique. Is the estimation of the expo-
    # nent of the CCDF more precise?
    
    library(here)
    library(igraph)
    
    # Loading the network
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    ################################################################################
    # Helper Functions
    
    # Compute CCDF: for unweighted histogram
    compute_ccdf <- function(degrees) {
      tab <- table(degrees)
      degs <- as.numeric(names(tab))
      freq <- as.numeric(tab)
      prob <- freq / sum(freq)
      ccdf <- rev(cumsum(rev(prob)))
      data.frame(degree = degs, ccdf = ccdf)
    }
    ################################################################################
    
    # Write here the solution

Solution

    # Modify the degree distribution of your sample using the Re-
    # Weighted Random Walk technique. Is the estimation of the expo-
    # nent of the CCDF more precise?
    
    library(here)
    library(igraph)
    
    # Loading the network
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    ################################################################################
    # Helper Functions
    
    # Compute CCDF: for unweighted histogram
    compute_ccdf <- function(degrees) {
      tab <- table(degrees)
      degs <- as.numeric(names(tab))
      freq <- as.numeric(tab)
      prob <- freq / sum(freq)
      ccdf <- rev(cumsum(rev(prob)))
      data.frame(degree = degs, ccdf = ccdf)
    }
    ################################################################################
    
    # This should be the solution
    
    # Computing weighted CCDF: for RWRW
    compute_weighted_ccdf <- function(degrees, weights) {
      # degrees: vector of degrees (possibly with duplicates)
      # weights: vector of weights for each node
      df <- data.frame(degree = degrees, weight = weights)
      degs <- sort(unique(degrees))
      weighted_prob <- sapply(degs, function(k) sum(df$weight[df$degree == k]))
      weighted_prob <- weighted_prob / sum(weighted_prob)
      weighted_ccdf <- rev(cumsum(rev(weighted_prob)))
      data.frame(degree = degs, ccdf = weighted_ccdf)
    }
    
    # Fit log-log regression
    fit_log_log <- function(ccdf_df) {
      valid <- ccdf_df$degree > 0 & ccdf_df$ccdf > 0
      fit <- lm(log10(ccdf) ~ log10(degree), data = ccdf_df[valid, ])
      coef(fit)[2]
    }
    
    set.seed(42)
    target_sample_size <- 2000
    
    # Standard Random Walk
    all_nodes <- V(g)$name
    start_node <- sample(all_nodes, 1)
    rw_walk <- start_node
    
    current_node <- start_node
    while (length(rw_walk) < target_sample_size) {
      neighbors_vec <- neighbors(g, current_node)
      if (length(neighbors_vec) == 0) {
        current_node <- sample(all_nodes, 1)
      } else {
        next_vertex <- sample(neighbors_vec, 1)
        next_node <- V(g)[next_vertex]$name
        rw_walk <- c(rw_walk, next_node)
        current_node <- next_node
      }
    }
    
    # CCDF for original network
    orig_degrees <- degree(g)
    orig_ccdf <- compute_ccdf(orig_degrees)
    orig_exponent <- fit_log_log(orig_ccdf)
    
    # Standard Random Walk: degree distribution and CCDF
    rw_degrees <- degree(g, rw_walk)
    rw_ccdf <- compute_ccdf(rw_degrees)
    rw_exponent <- fit_log_log(rw_ccdf)
    
    # RWRW: Re-weighted degree distribution and CCDF
    rw_weights <- 1 / rw_degrees
    rwrw_ccdf <- compute_weighted_ccdf(rw_degrees, rw_weights)
    rwrw_exponent <- fit_log_log(rwrw_ccdf)
    
    # Plot comparison
    plot(orig_ccdf$degree, orig_ccdf$ccdf, log = "xy", type = "l", col = "red", lwd = 2,
         xlab = "Degree (k)", ylab = "CCDF (P(K>=k))",
         main = "CCDF (log-log): Original, RW, RWRW")
    lines(rw_ccdf$degree, rw_ccdf$ccdf, col = "blue", lwd = 2)
    lines(rwrw_ccdf$degree, rwrw_ccdf$ccdf, col = "darkgreen", lwd = 2)
    legend("bottomleft", legend = c(
      sprintf("Original (%.3f)", orig_exponent),
      sprintf("RW (%.3f)", rw_exponent),
      sprintf("RWRW (%.3f)", rwrw_exponent)),
      col = c("red", "blue", "darkgreen"), lwd = 2)
    
    cat(sprintf("Exponent - Original: %.3f\n", orig_exponent))
    cat(sprintf("Exponent - RW: %.3f\n", rw_exponent))
    cat(sprintf("Exponent - RWRW: %.3f\n", rwrw_exponent))
    
    # Visualizing the last sampled subgraph for context
    # Subgraph induced by unique nodes in the random walk
    sampled_nodes <- unique(rw_walk)
    sub_edges <- edges[edges$from %in% sampled_nodes | edges$to %in% sampled_nodes, ]
    g_sampled <- graph_from_data_frame(sub_edges, directed = FALSE)
    plot(
      g_sampled,
      vertex.size = 3,
      vertex.label = NA,
      edge.arrow.size = 0.2,
      main = sprintf(
        "Random Walk Sampled Subgraph (%d nodes)", length(V(g_sampled))
      )
    )

29.7.4

Problem

    # Modify your random walk sampler so that it applied the Metropolis-
    # Hastings correction. Is the estimation of the exponent of the CCDF
    # more precise? Is MHRW more or less precise than RWRW?
    
    library(here)
    library(igraph)
    
    # Load the network
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    # Write here the solution

Solution

    # Modify your random walk sampler so that it applied the Metropolis-
    # Hastings correction. Is the estimation of the exponent of the CCDF
    # more precise? Is MHRW more or less precise than RWRW?
    
    library(here)
    library(igraph)
    
    # Load the network
    edges <- read.table(here("data.txt"), header = FALSE)
    colnames(edges) <- c("from", "to")
    g <- graph_from_data_frame(edges, directed = FALSE)
    
    # This should be the solution 
    
    # Computing CCDF
    compute_ccdf <- function(degrees) {
      tab <- table(degrees)
      degs <- as.numeric(names(tab))
      freq <- as.numeric(tab)
      prob <- freq / sum(freq)
      ccdf <- rev(cumsum(rev(prob)))
      data.frame(degree = degs, ccdf = ccdf)
    }
    
    # Weighted CCDF: for RWRW
    compute_weighted_ccdf <- function(degrees, weights) {
      df <- data.frame(degree = degrees, weight = weights)
      degs <- sort(unique(degrees))
      weighted_prob <- sapply(degs, function(k) sum(df$weight[df$degree == k]))
      weighted_prob <- weighted_prob / sum(weighted_prob)
      weighted_ccdf <- rev(cumsum(rev(weighted_prob)))
      data.frame(degree = degs, ccdf = weighted_ccdf)
    }
    
    # Fitting log-log regression
    fit_log_log <- function(ccdf_df) {
      valid <- ccdf_df$degree > 0 & ccdf_df$ccdf > 0
      fit <- lm(log10(ccdf) ~ log10(degree), data = ccdf_df[valid, ])
      coef(fit)[2]
    }
    
    set.seed(42)
    target_sample_size <- 2000
    
    # Standard Random Walk (for comparison)
    all_nodes <- V(g)$name
    start_node <- sample(all_nodes, 1)
    rw_walk <- start_node
    current_node <- start_node
    while (length(rw_walk) < target_sample_size) {
      neighbors_vec <- neighbors(g, current_node)
      if (length(neighbors_vec) == 0) {
        current_node <- sample(all_nodes, 1)
      } else {
        next_vertex <- sample(neighbors_vec, 1)
        next_node <- V(g)[next_vertex]$name
        rw_walk <- c(rw_walk, next_node)
        current_node <- next_node
      }
    }
    rw_degrees <- degree(g, rw_walk)
    rw_ccdf <- compute_ccdf(rw_degrees)
    rw_exponent <- fit_log_log(rw_ccdf)
    
    # RWRW (for comparison)
    rw_weights <- 1 / rw_degrees
    rwrw_ccdf <- compute_weighted_ccdf(rw_degrees, rw_weights)
    rwrw_exponent <- fit_log_log(rwrw_ccdf)
    
    # MHRW Sampling
    set.seed(42) # For reproducibility
    mhrw_walk <- start_node
    current_node <- start_node
    deg_current <- degree(g, current_node)
    
    while (length(mhrw_walk) < target_sample_size) {
      neighbors_vec <- neighbors(g, current_node)
      if (length(neighbors_vec) == 0) {
        current_node <- sample(all_nodes, 1)
        deg_current <- degree(g, current_node)
      } else {
        next_vertex <- sample(neighbors_vec, 1)
        next_node <- V(g)[next_vertex]$name
        deg_next <- degree(g, next_node)
        accept_prob <- min(1, deg_current / deg_next)
        if (runif(1) < accept_prob) {
          current_node <- next_node
          deg_current <- deg_next
        }
        mhrw_walk <- c(mhrw_walk, current_node)
      }
    }
    
    mhrw_degrees <- degree(g, mhrw_walk)
    mhrw_ccdf <- compute_ccdf(mhrw_degrees)
    mhrw_exponent <- fit_log_log(mhrw_ccdf)
    
    # Original network
    orig_degrees <- degree(g)
    orig_ccdf <- compute_ccdf(orig_degrees)
    orig_exponent <- fit_log_log(orig_ccdf)
    
    # Plot comparison
    plot(orig_ccdf$degree, orig_ccdf$ccdf, log = "xy", type = "l", col = "red", lwd = 2,
         xlab = "Degree (k)", ylab = "CCDF (P(K>=k))",
         main = "CCDF (log-log): Original, RW, RWRW, MHRW")
    lines(rw_ccdf$degree, rw_ccdf$ccdf, col = "blue", lwd = 2)
    lines(rwrw_ccdf$degree, rwrw_ccdf$ccdf, col = "darkgreen", lwd = 2)
    lines(mhrw_ccdf$degree, mhrw_ccdf$ccdf, col = "purple", lwd = 2)
    legend("bottomleft", legend = c(
      sprintf("Original (%.3f)", orig_exponent),
      sprintf("RW (%.3f)", rw_exponent),
      sprintf("RWRW (%.3f)", rwrw_exponent),
      sprintf("MHRW (%.3f)", mhrw_exponent)
    ), col = c("red", "blue", "darkgreen", "purple"), lwd = 2)
    
    cat(sprintf("Exponent - Original: %.3f\n", orig_exponent))
    cat(sprintf("Exponent - RW: %.3f\n", rw_exponent))
    cat(sprintf("Exponent - RWRW: %.3f\n", rwrw_exponent))
    cat(sprintf("Exponent - MHRW: %.3f\n", mhrw_exponent))
    
    # Visualizing MHRW sampled subgraph
    sampled_nodes_mhrw <- unique(mhrw_walk)
    sub_edges_mhrw <- edges[edges$from %in% sampled_nodes_mhrw | edges$to %in% sampled_nodes_mhrw, ]
    g_sampled_mhrw <- graph_from_data_frame(sub_edges_mhrw, directed = FALSE)
    plot(
      g_sampled_mhrw,
      vertex.size = 3,
      vertex.label = NA,
      edge.arrow.size = 0.2,
      main = sprintf(
        "Metropolis-Hastings RW Sampled Subgraph (%d nodes)", length(V(g_sampled_mhrw))
      )
    )

30.6.1

Problem

    # Load the network at http://www.networkatlas.eu/exercises/
    # 30/1/data.txt and its corresponding node attributes at http:
    # //www.networkatlas.eu/exercises/30/1/nodes.txt. Iterate over
    # all ego networks for all nodes in the network, removing the ego
    # node. For each ego network, calculate the share of right-leaning
    # nodes. Then, calculate the average of such shares per node.
    
    library(here)
    library(igraph)
    
    # Loading edge list 
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes 
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Write here the solution

Solution

    # Load the network at http://www.networkatlas.eu/exercises/
    # 30/1/data.txt and its corresponding node attributes at http:
    # //www.networkatlas.eu/exercises/30/1/nodes.txt. Iterate over
    # all ego networks for all nodes in the network, removing the ego
    # node. For each ego network, calculate the share of right-leaning
    # nodes. Then, calculate the average of such shares per node.
    
    library(here)
    library(igraph)
    
    # Loading edge list 
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes 
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Solution 
    
    # Making sure node ids are characters for matching
    nodes_df$id <- as.character(nodes_df$id)
    edges$from <- as.character(edges$from)
    edges$to <- as.character(edges$to)
    
    # Creating igraph object
    g <- graph_from_data_frame(edges, directed=FALSE, vertices=nodes_df)
    
    # For each node, computing the share of right-leaning nodes in its ego network (excluding the ego node itself)
    right_shares <- numeric(vcount(g))
    names(right_shares) <- V(g)$name
    
    for (v in V(g)) {
      # Getting ego node name (as string)
      ego_name <- as.character(v)
      # Ego network of order 1 (neighborhood of v, including v)
      ego_g <- make_ego_graph(g, order=1, nodes=ego_name, mode="all")[[1]]
      # Removing the ego node itself
      others <- setdiff(V(ego_g)$name, ego_name)
      if (length(others) == 0) {
        right_shares[ego_name] <- NA  # No neighbors
      } else {
        # Getting the leaning attribute for neighbors
        leanings <- V(g)[others]$leaning
        right_share <- sum(leanings == "right-leaning") / length(leanings)
        right_shares[ego_name] <- right_share
      }
    }
    
    # Removing NAs (nodes with no neighbors)
    right_shares_no_na <- right_shares[!is.na(right_shares)]
    
    # Calculating the average share
    average_share <- mean(right_shares_no_na)
    
    # Printing solution 
    cat(sprintf("Average share of right-leaning nodes in ego networks: %.4f\n", average_share))
    
    ################################################################################
    # Optional
    # Plotting the network, coloring nodes by political leaning
    leaning_colors <- ifelse(V(g)$leaning == "right-leaning", "red", "blue")
    set.seed(42)
    plot(
      g,
      vertex.color = leaning_colors,
      vertex.size = 5,
      vertex.label = NA,
      edge.arrow.size = 0.2,
      main = "Network (blue: left-leaning, red: right-leaning)"
    )
    ################################################################################

30.6.2

Problem

    # What is the assortativity of the leaning attribute?
    
    library(here)
    library(igraph)
    
    # Loading edge list 
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes 
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Write here the solution

Solution

    # What is the assortativity of the leaning attribute?
    
    library(here)
    library(igraph)
    
    # Loading edge list 
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes 
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Solution 
    
    # Ensuring node ids are characters for matching
    nodes_df$id <- as.character(nodes_df$id)
    edges$from <- as.character(edges$from)
    edges$to <- as.character(edges$to)
    
    # Creating igraph object
    g <- graph_from_data_frame(edges, directed=FALSE, vertices=nodes_df)
    
    # Converting leaning to a numeric factor for assortativity calculation
    leaning_fac <- as.numeric(as.factor(V(g)$leaning))
    
    # Calculating assortativity for the leaning attribute
    assort <- assortativity_nominal(g, leaning_fac, directed=FALSE)
    
    # Printing the result
    cat(sprintf("Assortativity of the leaning attribute: %.4f\n", assort))

30.6.3

Problem

    # What is the relative popularity of attribute values “right-leaning”
    # and “left-leaning”? Based on what you discovered in the first
    # exercise, would you say that there is a majority illusion in the
    # network?
    
    library(here)
    library(igraph)
    
    # Loading edge list
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Write here the solution

Solution

    # What is the relative popularity of attribute values “right-leaning”
    # and “left-leaning”? Based on what you discovered in the first
    # exercise, would you say that there is a majority illusion in the
    # network?
    
    library(here)
    library(igraph)
    
    # Loading edge list
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Loading node attributes
    nodes_df <- read.table("nodes.txt", stringsAsFactors=FALSE)
    colnames(nodes_df) <- c("id", "leaning")
    
    # Solution 
    
    # Ensuring node ids are characters for matching
    nodes_df$id <- as.character(nodes_df$id)
    edges$from <- as.character(edges$from)
    edges$to <- as.character(edges$to)
    
    # Creating igraph object
    g <- graph_from_data_frame(edges, directed=FALSE, vertices=nodes_df)
    
    # Relative popularity: proportion of each leaning in the whole network
    table_leaning <- table(V(g)$leaning)
    total_nodes <- sum(table_leaning)
    rel_popularity <- table_leaning / total_nodes
    
    # Printing the result 
    cat("Relative popularity in the whole network:\n")
    print(rel_popularity)
    
    # Now, majority illusion: For each node, what is the majority attribute among its neighbors?
    neighbor_majority <- character(vcount(g))
    names(neighbor_majority) <- V(g)$name
    
    for (v in V(g)) {
      ego_name <- as.character(v)
      neighbors <- neighbors(g, ego_name)
      if (length(neighbors) == 0) {
        neighbor_majority[ego_name] <- NA
      } else {
        neighbor_leanings <- V(g)[neighbors]$leaning
        tab <- table(neighbor_leanings)
        # If tie, pick one arbitrarily
        majority_attr <- names(tab)[which.max(tab)]
        neighbor_majority[ego_name] <- majority_attr
      }
    }
    
    # Proportion of nodes whose majority neighbor attribute is "right-leaning" or "left-leaning"
    majority_table <- table(neighbor_majority, useNA="no")
    majority_prop <- majority_table / sum(majority_table)
    
    # Printing the result 
    cat("\nRelative popularity among neighbors (majority illusion measure):\n")
    print(majority_prop)
    
    # Comparing network-level proportion vs. neighbor-majority proportion
    cat("\nIf the proportion of 'right-leaning' as majority among neighbors is much higher than global, there is a majority illusion.\n")

31.5.1

Problem

    # Draw the degree assortativity plots of the network at http://
    # www.networkatlas.eu/exercises/31/1/data.txt using the first
    # (edge-centric) and the second (node-centric) strategies explained
    # in Section 31.1. For best results, use logarithmic axes and color the
    # points proportionally to the logarithmic count of the observations
    # with the same values.
    
    library(here)
    library(igraph)
    library(ggplot2)
    library(viridis)
    
    # Loading edge list
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Building graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Computing node degrees
    deg <- degree(g)
    
    # Write here the solution

Solution

    # Draw the degree assortativity plots of the network at http://
    # www.networkatlas.eu/exercises/31/1/data.txt using the first
    # (edge-centric) and the second (node-centric) strategies explained
    # in Section 31.1. For best results, use logarithmic axes and color the
    # points proportionally to the logarithmic count of the observations
    # with the same values.
    
    library(here)
    library(igraph)
    library(ggplot2)
    library(viridis)
    
    # Loading edge list
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Building graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    # Computing node degrees
    deg <- degree(g)
    
    # This should be the solution 
    
    # ---------- Edge-centric strategy ----------
    # For each edge, get the degrees of the two endpoints
    edge_deg_df <- data.frame(
      k1 = deg[as.character(edges$from)],
      k2 = deg[as.character(edges$to)]
    )
    # Combining both (k1, k2) and (k2, k1) for symmetry
    edge_deg_all <- rbind(edge_deg_df, data.frame(k1 = edge_deg_df$k2, k2 = edge_deg_df$k1))
    
    # Counting occurrences for coloring
    edge_deg_all$pair <- paste(edge_deg_all$k1, edge_deg_all$k2, sep="-")
    edge_deg_all$count <- ave(edge_deg_all$pair, edge_deg_all$pair, FUN=length)
    
    # Plotting the graph
    ggplot(edge_deg_all, aes(x=k1, y=k2)) +
      geom_point(aes(color=log10(count)), alpha=0.7, size=2) +
      scale_color_viridis(option="plasma", name="log10(count)") +
      scale_x_log10() +
      scale_y_log10() +
      labs(
        title="Degree Assortativity Plot (Edge-centric)",
        x="Degree of endpoint 1",
        y="Degree of endpoint 2"
      ) +
      theme_minimal()
    
    # ---------- Node-centric strategy ----------
    # For each node, compute k (degree) and k_nn (average neighbor degree)
    node_ids <- V(g)$name
    k <- deg[node_ids]
    k_nn <- sapply(node_ids, function(v) {
      nbs <- neighbors(g, v)
      if (length(nbs) == 0) return(NA)
      mean(deg[nbs$name])
    })
    
    node_deg_df <- data.frame(k = k, k_nn = k_nn)
    # Removing NA (isolated nodes if any)
    node_deg_df <- node_deg_df[!is.na(node_deg_df$k_nn),]
    
    # Counting occurrences for coloring
    node_deg_df$pair <- paste(node_deg_df$k, round(node_deg_df$k_nn, 2), sep="-")
    node_deg_df$count <- ave(node_deg_df$pair, node_deg_df$pair, FUN=length)
    
    # Ploting the graph 
    ggplot(node_deg_df, aes(x=k, y=k_nn)) +
      geom_point(aes(color=log10(count)), alpha=0.7, size=2) +
      scale_color_viridis(option="plasma", name="log10(count)") +
      scale_x_log10() +
      scale_y_log10() +
      labs(
        title="Degree Assortativity Plot (Node-centric)",
        x="Node degree (k)",
        y="Avg. neighbor degree (k_nn)"
      ) +
      theme_minimal()

31.5.2

Problem

    # Calculate the degree assortativity of the network from the previ-
    # ous question using the first (edge-centric Pearson correlation) and
    # the second (node-centric power fit) strategies explained in Section
    # 31.1.
    
    library(here)
    library(igraph)
    
    # Load edge list from local file
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Build graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    deg <- degree(g)
    V(g)$deg <- deg
    
    # Write here the solution

Solution

    # Calculate the degree assortativity of the network from the previ-
    # ous question using the first (edge-centric Pearson correlation) and
    # the second (node-centric power fit) strategies explained in Section
    # 31.1.
    
    library(here)
    library(igraph)
    
    # Load edge list from local file
    edges <- read.table("data.txt")
    colnames(edges) <- c("from", "to")
    
    # Build graph
    g <- graph_from_data_frame(edges, directed=FALSE)
    
    deg <- degree(g)
    V(g)$deg <- deg
    
    # Solution 
    
    # --- Edge-centric Pearson correlation (strategy 1) ---
    edge_deg_df <- data.frame(
      k1 = deg[as.character(edges$from)],
      k2 = deg[as.character(edges$to)]
    )
    # Pearson correlation of degrees at both ends of edges
    edge_centric_pearson <- cor(edge_deg_df$k1, edge_deg_df$k2)
    
    cat(sprintf("Edge-centric Pearson correlation (degree assortativity): %.4f\n", edge_centric_pearson))
    
    # Comparing with igraph's built-in degree assortativity
    igraph_assort <- assortativity_degree(g, directed=FALSE)
    cat(sprintf("igraph::assortativity_degree: %.4f\n", igraph_assort))
    
    # --- Node-centric power fit (strategy 2) ---
    # For each node: degree and average neighbor degree
    node_ids <- V(g)$name
    k <- deg[node_ids]
    k_nn <- sapply(node_ids, function(v) {
      nbs <- neighbors(g, v)
      if (length(nbs) == 0) return(NA)
      mean(deg[nbs$name])
    })
    # Removing nodes with degree 0 (isolated)
    valid <- !is.na(k_nn) & k > 0
    log_k <- log10(k[valid])
    log_k_nn <- log10(k_nn[valid])
    
    # Linear regression in log-log space: log(k_nn) ~ log(k)
    fit <- lm(log_k_nn ~ log_k)
    node_centric_power_slope <- coef(fit)[2]
    
    cat(sprintf("Node-centric power fit exponent (slope in log-log): %.4f\n", node_centric_power_slope))

31.5.3

Problem

Solution

Uh oh!

License

R0mb0/The_Atlas_for_the_Aspiring_Network_Scientist_exercises_in_R

About

Topics

Resources

License

Code of conduct

Security policy

Uh oh!

Stars

Watchers

Forks

Releases

Sponsor this project

Uh oh!

Uh oh!

Languages