R/metrics.R

In robitalec/scale-in-multilayer-networks: Package Accompanying: The Problem And Promise Of Scale In Multilayer Animal Social Networks.

#' Neighbourhood
#' 
#' Number of neighbors adjacent to each actor. Calculated excluding self from set of neighbors.
#'
#' @param DT a data.table with column "group" generated by spatsoc::group_pts
#' @param splitBy the column which defines the layers of the network
#' @param id 
#'
#' @return
#' The input DT with additional column "neigh" and optionally "splitNeigh" if a column was provided for the `splitBy` argument. 
#' @export
#' 
#' @import data.table
#'
#' @examples
#' # Load data.table and spatsoc
#' library(data.table)
#' library(spatsoc)
#' 
#' # Read example data
#' DT <- fread(system.file("extdata", "DT.csv", package = "spatsoc"))
#' 
#' # Cast the character column to POSIXct
#' DT[, datetime := as.POSIXct(datetime, tz = 'UTC')]
#' 
#' # Temporal grouping
#' group_times(DT, datetime = 'datetime', threshold = '20 minutes')
#' 
#' # Spatial grouping with timegroup
#' group_pts(DT, threshold = 5, id = 'ID',
#'           coords = c('X', 'Y'), timegroup = 'timegroup')
#'           
#' # Pseudo-season
#' DT[, season := sample(c(1, 2), .N, replace = TRUE)]
#' 
#' layer_neighbors(DT, 'ID', splitBy = 'season')
layer_neighbors <- function(DT, id, splitBy = NULL) {
  cols <- c(id, 'group', splitBy)
  
  if (any(!(cols %in% colnames(DT)))) {
    stop(paste0(
      as.character(paste(setdiff(
        cols, colnames(DT)
      ), collapse = ", ")),
      " field(s) provided are not present in input DT"
    ))
  }
  
  # flex splitBy
  if (is.null(splitBy)) {
    DT[, neigh := {
        g <- group
        DT[group %in% g, data.table::uniqueN(get(id)) - 1]
      },
      by = id][]
  } else {
    DT[, neigh := {
      g <- group
      DT[group %in% g, data.table::uniqueN(get(id)) - 1]
    },
    by = id]
    
    
    DT[, splitNeigh := {
      g <- group
      DT[group %in% g, data.table::uniqueN(get(id)) - 1]
    },
    by = c(splitBy, id)][]
  }
}



#' Multidegree
#'
#' @param DT 
#' @param degree 
#' @param splitBy
#' @param id 
#'
#' @return
#' Column added named multideg
#' @export
#'
#' @examples
multi_degree <- function(DT, degree, id, splitBy) {
  md <- DT[, unique(.SD), .SDcols = c(degree, id, splitBy)][, 
      .(multideg = sum(.SD[[1]])), .SDcols = degree, by = id]
  
  DT[md, multideg := multideg, on = id]
}


#' Relevance
#' 
#' Proportion of neighbours present on each layer.  
#' 
#' 
#' @references Berlingerio, Michele, et al. "Foundations of multidimensional network analysis." 2011 international conference on advances in social networks analysis and mining. IEEE, 2011.
#'
#' @param DT 
#' @param id 
#' @param var 
#' @param splitBy 
#'
#' @return
#' @export
#'
#' @examples
layer_relevance <- function(DT, id, splitBy) {
  # TODO: check for splitNeigh variable and neigh
  # TODO: check overwrite
  
  DT[, relev := splitNeigh / neigh, 
     by = c(id, splitBy)][]
}



#' Calculate graph strength for each graph in a list
#'
#' @param graphLs 
#'
#' @return
#' @export
#'
#' @examples
layer_strength <- function(graphLs) {
  data.table::setnames(data.table::rbindlist(
      lapply(graphLs, function(g) stack(igraph::strength(g))),
    idcol = 'layer')[, ind := as.character(ind)],
    'values', 'graphstrength')
}



#' Property Matrix
#' 
#' @param DT 
#' @param id 
#' @param layer 
#' @param metric 
#' @param by
#'
#' @return
#' @references Bródka P, Chmiel A,Magnani M, Ragozini G. 2018 Quantifying layer
#' similarity in multiplex networks: a systematic study. R.Soc.opensci. 5:171747.
#' http://dx.doi.org/10.1098/rsos.171747
#' 
#' @export
#'
#' @examples
property_matrix <- function(DT, id, metric, by, layer = 'layer') {
  zzz <- DT[, list(list(data.table::dcast(
    .SD,
    reformulate(..id, response = ..layer),
    value.var = ..metric
  ))),
  by = by][, data.table::rbindlist(V1, idcol = 'i', fill = TRUE)]
  if(!is.null(by)) data.table::setnames(zzz, 'i', by)
  zzz
}



#' Edge overlap
#'
#' @param graphLs 
#'
#' @return
#' @export
#'
#' @examples
edge_overlap <- function(edges) {
  uniqueEdges <- edges[, uniqueN(dyadID)]
  uniqueLayers <- edges[, uniqueN(layer)]
  
  edges[, edgeoverlap := .N / uniqueLayers, by = dyadID]
  
  edgeoverlapml <- unique(edges[, .(layer, dyadID, edgeoverlap)])[, mean(edgeoverlap)]
  propedges <- edges[, uniqueN(dyadID) / uniqueEdges, by = layer]
  
  propedges[, .(layer, propedges = V1, edgeoverlap = edgeoverlapml)]
}


#' Edge overlap matrix
#' 
#' Layer A vs Layer B, count overlap
#'
#' @param edges 
#'
#' @return
#' @export
#'
#' @examples
edge_overlap_mat <- function(edges) {
  crossprod(table(edges[, .(dyadID = unique(dyadID)), layer][, .(dyadID, layer)]))
}