Linear Threshold Model in R with igraph

Question

I'm trying to implement a function in R that takes a graph object and with two "opinions" present on the same graph, starting at random points, I should study the diffusion patterns. There is a stubbornness (alpha) parameter between [0, 1], and for the already infected nodes the change in opinion is set at (sum of infected neighbor)/[sum of total weights * (1+alpha)] > threshold.

I get the idea behind, but as I'm not really an R user, I am a little lost on how to implement it. I found this on internet Cascade and Linear threshold Models, and the Linear Threshold Model (unweighted, code below) seems perfect, but I'm a little lost on how to modify the code to match the requirements.

library('igraph')

# Independent Cascade model
#   - graph: igraph object
#   - activated: list of initially activated nodes
IC <- function (g, activated) {
  # Defining the graph layout to preserve it
  # the same throughout the visualization
  l <- layout.fruchterman.reingold(g)
  # Setting the activated nodes
  V(g)$activated <- F
  for (v in activated) {
    V(g)[v]$activated <- T
  }
  # Marking all activations (edges) as "not yet tried"
  E(g)$tried <- F
  possible.activations = ecount(g)
  # The process goes on until there are possible activations
  while(possible.activations > 0) {
    # Network visualization (at each simulation step)
    V(g)$color <- ifelse(V(g)$activated, "red", "lightblue")
    plot(g, layout=l, edge.width=E(g)$weight*5)
    # Iterating through activated nodes
    for(v in V(g)) {
      if(V(g)[v]$activated) {
        # Finding activations for each note that have not been tried yet
        for(w in neighbors(g, V(g)[v]$name, mode="out")) {
          e <- E(g)[from(V(g)[v]$name) & to(V(g)[w]$name)]
          if (! e$tried) {
            # Activation attempt
            if (runif(1, 0, 1) <= e$weight) {
              V(g)[w]$activated <- T
            }
            e$tried <- T
            possible.activations <- possible.activations - 1
          }
        }
      }
    }
  }
  # Network visualization after the process has terminated
  V(g)$color <- ifelse(V(g)$activated, "red", "lightblue")
  plot(g, layout=l, edge.width=E(g)$weight*5)
}

Answer 1

In a pretty brutal way, but as I said, I'm not an R user nor a fan, the code is the following:

# Linear Threshold model (unweighted version)
#   - graph: igraph object
#   - activated_1: list of initially activated nodes opinion 1
#   - activated_2: list of initially activated nodes opinion 2
#   - activated_2: alpha value, between 0 and 1
LT <- function (g, activated_1, activated_2, stubborness) {
  # Defining the graph layout to preserve it
  # the same throughout the visualization
  l <- layout.fruchterman.reingold(g)
  # calculating the threshold randomly setting it between 0 and 1
  g <- set.vertex.attribute(g, "threshold", value = stubborness)
  # Setting the activated nodes for each opinion
  g <- set.vertex.attribute(g, "activated", value = 0)
  for (v in activated_1) {
    V(g)[v]$activated <- 1
  }
  for (v in activated_2) {
    V(g)[v]$activated <- 2
  }
  # Indicator of whether simulation should stop
  any.changes <- TRUE
  while(any.changes) {
    # Network visualization (at each simulation step)
    for(v in V(g)) {
      if (V(g)[v]$activated == 0) {
        V(g)[v]$color <- "lightblue"
      }
      if (V(g)[v]$activated == 1) {
        V(g)[v]$color <- "red"
      }
      if (V(g)[v]$activated == 2) {
        V(g)[v]$color <- "green"
      }
    }
    plot(g, layout=l)
    any.changes <- FALSE
    # Iterating through non-activated nodes
    for(v in V(g)) {
        # Calculating the fraction of activated neighbors
        neighborhood <- neighbors(g, V(g)[v]$name)
        activated.neighbors_1 <- 0
        activated.neighbors_2 <- 0
        total.neighbors <- length(neighborhood)
        for(w in neighborhood) {
          if(V(g)[w]$activated == 1) {
            activated.neighbors_1 <- activated.neighbors_1 + 1
          }
          if(V(g)[w]$activated == 2) {
            activated.neighbors_2 <- activated.neighbors_2 + 1
          }
        }
        if (V(g)[v]$activated == 0){
          activation.power_1 <- activated.neighbors_1 / total.neighbors
          activation.power_2 <- activated.neighbors_2 / total.neighbors
        }
        else {
          activation.power_1 <- activated.neighbors_1 / (total.neighbors * (1+V(g)[v]$threshold))
          activation.power_2 <- activated.neighbors_2 / (total.neighbors * (1+V(g)[v]$threshold))
        }
        # Checking if the opinions spread in neutral nodes or opinionated nodes
        if(V(g)[v]$activated == 0){
          if ((activated.neighbors_1 + activated.neighbors_2) != 0){
          if (activation.power_1 > activation.power_2){
            if (activation.power_1 > V(g)[v]$threshold){
              V(g)[v]$activated <- 1
              any.changes <- TRUE
          }}
          else {
            if (activation.power_2 > V(g)[v]$threshold){
              V(g)[v]$activated <- 2
              any.changes <- TRUE
            }
          }
        }
        }
        if(V(g)[v]$activated == 1){
          if ((activated.neighbors_1 + activated.neighbors_2) != 0 &&
              activated.neighbors_1 != total.neighbors){
          if (activation.power_2 > activation.power_1){
            if (activation.power_2 > V(g)[v]$threshold){
              V(g)[v]$activated <- 2
              any.changes <- TRUE
          }
        }
        }}
        if(V(g)[v]$activated == 2){
          if ((activated.neighbors_1 + activated.neighbors_2) != 0 &&
              activated.neighbors_2 != total.neighbors){
          if (activation.power_1 > activation.power_2){
            if (activation.power_1 > V(g)[v]$threshold){
              V(g)[v]$activated <- 1
              any.changes <- TRUE
          }
        }
        }
      }
  # Network visualization after the process has terminated
    }
  }
  for(v in V(g)) {
    if (V(g)[v]$activated == 0) {
      V(g)[v]$color <- "lightblue"
    }
    if (V(g)[v]$activated == 1) {
      V(g)[v]$color <- "red"
    }
    if (V(g)[v]$activated == 2) {
      V(g)[v]$color <- "green"
    }
  }
  plot(g, layout=l)
  # Recap of initial and final number for each opinion
  count_1 <- 0
  count_2 <- 0
  for(v in V(g)) {

    if (V(g)[v]$activated == 1) {
      count_1 <- count_1 + 1
    }
    if (V(g)[v]$activated == 2) {
      count_2 <- count_2 + 1
    }
  }
  cat("Initial number of red was ", length(activated_1), "final number is ", count_1, "\n")
  cat("Initial number of green was ", length(activated_2), "final number is ", count_2, "\n")
}