R/sirir.R

In influential: Identification and Classification of the Most Influential Nodes

#=============================================================================
#
#    SIRIR
#
#=============================================================================

#' SIR-based Influence Ranking
#'
#' This function is achieved by the integration susceptible-infected-recovered (SIR) model
#' with the leave-one-out cross validation technique and ranks network nodes based on their
#' true universal influence. One of the applications of this function is the assessment of
#' performance of a novel algorithm in identification of network influential nodes by considering
#' the SIRIR ranks as the ground truth (gold standard).
#' @param graph A graph (network) of the igraph class.
#' @param vertices A vector of desired vertices, which could be obtained by the V function.
#' @param beta Non-negative scalar. The rate of infection of an individual that is susceptible
#' and has a single infected neighbor. The infection rate of a susceptible individual with n
#' infected neighbors is n times beta. Formally this is the rate parameter of an exponential
#' distribution.
#' @param gamma Positive scalar. The rate of recovery of an infected individual.
#' Formally, this is the rate parameter of an exponential distribution.
#' @param no.sim Integer scalar, the number of simulation runs to perform SIR model on the
#' original network as well as perturbed networks generated by leave-one-out technique.
#' You may choose a different no.sim based on the available memory on your system.
#' @param ncores Integer; the number of cores to be used for parallel processing. If ncores == "default" (default), the number of 
#' cores to be used will be the max(number of available cores) - 1. We recommend leaving ncores argument as is (ncores = "default").
#' @param seed A single value, interpreted as an integer to be used for random number generation.
#' @param node_verbose Logical; whether the process of Parallel Socket Cluster creation should be printed (default is FALSE).
#' @param loop_verbose Logical; whether the accomplishment of the evaluation of network nodes in each loop should be printed (default is TRUE).
#' @return A two-column dataframe; a column containing the difference values of the original and
#' perturbed networks and a column containing node influence rankings
#' @aliases SIRIR
#' @keywords sirir
#' @family centrality functions
#' @seealso \code{\link[influential]{cent_network.vis}},
#' and \code{\link[igraph]{sir}} for a complete description on SIR model
#' @export sirir
#' @examples
#' \dontrun{
#' set.seed(1234)
#' My_graph <- igraph::sample_gnp(n=50, p=0.05)
#' GraphVertices <- V(My_graph)
#' Influence.Ranks <- sirir(graph = My_graph, vertices = GraphVertices, 
#'                          beta = 0.5, gamma = 1, ncores = "default", no.sim = 10, seed = 1234)
#' }
#' @importFrom igraph vcount as_ids sir
#' @importFrom foreach %dopar%
sirir <- function(graph, vertices = V(graph),
                  beta = 0.5, gamma = 1, no.sim = 100,  
                  ncores = "default", seed = 1234, loop_verbose = TRUE, node_verbose = FALSE) {
  
  suppressWarnings({
    
    # Make clusters for parallel processing
    cl <- parallel::makeCluster(ifelse(ncores == "default", parallel::detectCores() - 1, ncores), 
                                outfile=ifelse(node_verbose, "", "NULL"))
    doParallel::registerDoParallel(cl)
    
    #Define a data frame
    temp.loocr.table <- data.frame(difference.value = vector("numeric", length = length(vertices)),
                                   rank = vector("integer", length = length(vertices)))
    
    if(inherits(vertices, "character")) {
      rownames(temp.loocr.table) <- vertices
    } else if(inherits(vertices, "igraph.vs")) {
      rownames(temp.loocr.table) <- igraph::as_ids(vertices)
    }
    
    #Model the spreading based on all nodes
    set.seed(seed)
    all.included.spread <- igraph::sir(graph = graph, beta = beta,
                                       gamma = gamma, no.sim = no.sim)
    
    #Getting the mean of spread in each independent experiment
    all.mean.spread <- sapply(1:length(all.included.spread), function(i) {
      max(all.included.spread[[i]]$NR)
    })
    
    all.mean.spread <- mean(all.mean.spread)
    
    #Model the spread based on leave one out cross ranking (LOOCR)
    loocr.mean.spread_vec <- 
      foreach::foreach(s = vertices,
                       .combine = "c", 
                       .verbose = loop_verbose,
                       .multicombine = TRUE,
                       .packages = c("igraph", "influential"),
                       .export = c("graph", "beta", "gamma", "no.sim", "all.mean.spread")
      ) %dopar% {
        
        temp.graph <- igraph::delete_vertices(graph, s)
        set.seed(seed)
        loocr.spread <- igraph::sir(graph = temp.graph, beta = beta,
                                    gamma = gamma, no.sim = no.sim)
        
        loocr.mean.spread <- sapply(1:length(loocr.spread), function(h) {
          max(loocr.spread[[h]]$NR)
        })
        
        cat(paste("\nProcessing vertex ", as_ids(s), " is done!", "\n", sep = ""))  # Print message for each iteration
        
        # return mean of loocr spreads
        mean(loocr.mean.spread)
      }
    
    # Stop the parallel backend
    parallel::stopCluster(cl)
    
    temp.loocr.table$difference.value <- all.mean.spread - loocr.mean.spread_vec
    temp.loocr.table$rank <- rank(-temp.loocr.table$difference.value, ties.method = "min")
    
  })
  
  return(temp.loocr.table)
}