# R/extract_nodestats.R In jrhammond/phoenixNet: Gather, munge, and convert event data into daily event-networks.

#### Documented in extract_nodestats

```#'
#' Extract node-level statistics from a given event-network.
#'
#' INTERNAL FUNCTION: Intakes a given network object and returns a set
#'  of node-level statistics for output.
#'
#' @param input_date A date in integer %Y%m%d format.
#' @param event_dnet network object object containing a set of interactions.
#'
#' @return net_stats Table of node-level statistics.
#'
#' @keywords phoenix, event data
#'
#' @import data.table
#' @import countrycode
#' @import reshape2
#' @import statnet
#' @import tsna
#' @import plyr
#' @import lubridate
#' @import igraph
#' @import intergraph
#'
#' @export

extract_nodestats <- function(input_date = this_date, event_dnet = tsna_obj){

######
#
# Extract daily network and convert to igraph
#
######

## Collapse to daily network
net_obj <- network.collapse(event_dnet, at = input_date)

## Convert input date to an actual date object
input_date <- as.Date(as.character(input_date), format = '%Y%m%d')

## Write a weird little workaround for the final day of an empty tsna
##  object: by default it is a zero-node network, which is odd.
#   if(network.size(net_obj) == 0){
#     filler <- matrix(rep(0, 255), nrow = 1)
#     dimnames(filler)[[2]] <- paste0('node', 1:255)
#     return(rbind(as.data.table(cbind(date = input_date
#                                       , node_stat = 'trans', filler))
#                  , as.data.table(cbind(date = input_date
#                                       , node_stat = 'indegree', filler))
#                  , as.data.table(cbind(date = input_date
#                                       , node_stat = 'outdegree', filler))
#                  , as.data.table(cbind(date = input_date
#                                       , node_stat = 'between', filler))))
#   }

nodes <- network.vertex.names(net_obj)
## Convert to igraph object via 'intergraph' for additional metrics
daily_graph <- intergraph::asIgraph(net_obj)

######
#
# Extract a set of NODE-LEVEL statistics
#
######

## Transitivity
trans_dist <- matrix(igraph::transitivity(daily_graph, type = 'local'
, isolates = 'zero'), nrow = 1)
dimnames(trans_dist)[[2]] <- nodes
trans_dist <- as.data.table(cbind(date = input_date
, node_stat = 'trans', trans_dist))

## Degree
# Indegree
indegree_dist <- matrix(sna::degree(as.matrix.network(net_obj)
, cmode = 'indegree'
, rescale = T), nrow = 1)
indegree_dist[is.nan(indegree_dist)] <- 0
dimnames(indegree_dist)[[2]] <- nodes
indegree_dist <- as.data.table(cbind(date = input_date
, node_stat = 'indegree', indegree_dist))

# Outdegree
outdegree_dist <- matrix(sna::degree(as.matrix.network(net_obj)
, cmode = 'outdegree'
, rescale = T), nrow = 1)
outdegree_dist[is.nan(outdegree_dist)] <- 0
dimnames(outdegree_dist)[[2]] <- nodes
outdegree_dist <- as.data.table(cbind(date = input_date
, node_stat = 'outdegree', outdegree_dist))

## Betweenness
between_dist <- matrix(sna::betweenness(as.matrix.network(net_obj)
, gmode = 'digraph'
, rescale = T), nrow = 1)
between_dist[is.nan(between_dist)] <- 0
dimnames(between_dist)[[2]] <- nodes
between_dist <- as.data.table(cbind(date = input_date
, node_stat = 'between', between_dist))

## Reciprocity
recip_mat <- as.matrix.network(net_obj)
recip_fun <- function(position, x){
return(sum(x[position, ] == x[, position]))
}
recip_dist <- matrix(sapply(1:nrow(recip_mat), recip_fun, recip_mat) / nrow(recip_mat)
, nrow = 1)
dimnames(recip_dist)[[2]] <- nodes
recip_dist <- as.data.table(cbind(date = input_date
, node_stat = 'recip', recip_dist))

## Combined metric
out_data <- data.table(rbind(trans_dist, indegree_dist
, outdegree_dist, between_dist, recip_dist))

dtnew <- out_data[, lapply(.SD, as.numeric)]
# dtnew2 <- dtnew[, lapply(.SD, scale)]
dtnew2 <- copy(dtnew)
dtnew2[, date := NULL]
dtnew2[, node_stat := NULL]
dtnew2 <- data.frame(dtnew2)
dtnew2 <- abs(dtnew2)
for(i in 1:nrow(dtnew2)){
dtnew2[i, ] <- scale(as.matrix(dtnew2)[i,])
}
dtnew[, node_stat := out_data\$node_stat]
out_data <- dtnew
combined <- as.data.table(cbind(date = input_date, node_stat = 'combined1'
, matrix(colSums(dtnew2), nrow = 1)))
combined2 <- as.data.table(cbind(date = input_date, node_stat = 'combined2'
, matrix(colSums(((dtnew2)+1)^2), nrow = 1)))
setnames(combined, names(combined)[-c(1:2)], names(between_dist)[-c(1:2)])
setnames(combined2, names(combined2)[-c(1:2)], names(between_dist)[-c(1:2)])
out_data <- rbind(out_data, combined, combined2)
dtnew <- out_data[, lapply(.SD, as.numeric)]
dtnew[, node_stat := out_data\$node_stat]
out_data <- dtnew
return(out_data)
}
```
jrhammond/phoenixNet documentation built on April 3, 2018, 6:59 a.m.