Skip to content

Commit

Permalink
Major graph refactor
Browse files Browse the repository at this point in the history
  • Loading branch information
@jayqi
jayqi committed Feb 10, 2019
1 parent d4ca632 commit 411a03a
Show file tree
Hide file tree
Showing 11 changed files with 644 additions and 498 deletions.
266 changes: 53 additions & 213 deletions R/AbstractGraphReporter.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,37 +32,65 @@
#' @importFrom visNetwork visNetwork visHierarchicalLayout visEdges visOptions
#' @export
AbstractGraphReporter <- R6::R6Class(
"AbstractGraphReporter",
inherit = AbstractPackageReporter,
active = list(
"AbstractGraphReporter"
, inherit = AbstractPackageReporter

, public = list(
calculate_default_measures = function() {
self$pkg_graph$node_measures(self$pkg_graph$default_node_measures())
self$pkg_graph$graph_measures(self$pkg_graph$default_graph_measures())
return(invisible(self))
}

, get_summary_view = function(){

# Create DT for display of the nodes data.table
tableObj <- DT::datatable(
data = self$nodes
, rownames = FALSE
, options = list(
searching = FALSE
, pageLength = 50
, lengthChange = FALSE
)
)

# Round the double columns to three digits for formatting reasons
numCols <- names(which(unlist(lapply(tableObj$x$data, is.double))))
tableObj <- DT::formatRound(columns = numCols, table = tableObj
, digits=3)
return(tableObj)
}

) # /public

, active = list(

pkg_graph = function(){
if (is.null(private$cache$pkg_graph)){
if (is.null(private$graph_class)) {
log_fatal("Reporter must set valid graph class.")
}
log_info("Creating graph object...")
private$make_graph_object()
log_info("Done creating graph object")
pkg_graph <- private$graph_class$new(self$nodes, self$edges)
private$cache$pkg_graph <- pkg_graph
}
return(private$cache$pkg_graph)
},
network_measures = function(){
if (is.null(private$cache$network_measures)){
log_info("Calculating network measures...")
# Set from NULL to empty list
private$cache$network_measures <- list()
private$calculate_network_measures()
log_info("Done calculating network measures.")
}
return(private$cache$network_measures)

graph_measures = function(){
return(private$cache$pkg_graph$graph_measures)
},

graph_viz = function(){
if (is.null(private$cache$graph_viz)) {
log_info('Creating graph visualization plot...')
private$cache$graph_viz <- private$plot_network()
log_info('Done creating graph visualization plot.')
}
return(private$cache$graph_viz)
},

layout_type = function(layout) {
# If the person isn't using <- assignment, return the cached value
# If user using <- assignment, set layout and reset viz
if (!missing(layout)) {
# Input validation
assertthat::assert_that(
Expand All @@ -79,207 +107,23 @@ AbstractGraphReporter <- R6::R6Class(

private$private_layout_type <- layout
}
# Otherwise, return the cached value
return(private$private_layout_type)
}
),
) # /active

private = list(
, private = list(
plotNodeColorScheme = list(
field = NULL
, palette = '#97C2FC'
),

# Create a "cache" to be used when evaluating active bindings
# There is a default cache to reset to
cache = list(
nodes = NULL,
edges = NULL,
pkg_graph = NULL,
network_measures = NULL,
graph_viz = NULL
),

# Default graph viz layout
private_layout_type = "layout_nicely",

# Calculate graph-related measures for pkg_graph
calculate_network_measures = function(){

# Use igraph object
pkg_graph <- self$pkg_graph

#--------------#
# out degree
#--------------#
outDegreeResult <- igraph::centralization.degree(
graph = pkg_graph
, mode = "out"
)

outDegreeResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, outDegree = outDegreeResult[['res']]
)

# update data.tables
private$update_nodes(outDegreeResultDT)

private$cache$network_measures[['centralization.OutDegree']] <- outDegreeResult$centralization

#--------------#
# betweeness
#--------------#
outBetweenessResult <- igraph::centralization.betweenness(
graph = pkg_graph
, directed = TRUE
)

outBetweenessResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, outBetweeness = outBetweenessResult[['res']]
)

# update data.tables
private$update_nodes(outBetweenessResultDT)

private$cache$network_measures[['centralization.betweenness']] <- outBetweenessResult$centralization

#--------------#
# closeness
#--------------#
suppressWarnings({
outClosenessResult <- igraph::centralization.closeness(
graph = pkg_graph
, mode = "out"
)
})

outClosenessResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, outCloseness = outClosenessResult[['res']]
)

# update data.tables
private$update_nodes(metadataDT = outClosenessResultDT)

private$cache$network_measures[['centralization.closeness']] <- outClosenessResult$centralization

#--------------------------------------------------------------#
# NODE ONLY METRICS
#--------------------------------------------------------------#

#--------------#
# Size of Out-Subgraph - meaning the rooted graph out from a node
# computed using out-neighborhood with order of longest possible path
#--------------#
numOutNodes <- igraph::neighborhood.size(
graph = pkg_graph
, order = vcount(pkg_graph)
, mode = "out"
)

numOutNodesDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, outSubgraphSize = numOutNodes
)

# update data.tables
private$update_nodes(numOutNodesDT)


#--------------#
# Size of In-Subgraph - meaning the rooted graph into a node
# computed using in-neighborhood with order of longest possible path
#--------------#
numInNodes <- igraph::neighborhood.size(
graph = pkg_graph
, order = vcount(pkg_graph)
, mode = "in"
)

numInNodesDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, inSubgraphSize = numInNodes
)

# update data.tables
private$update_nodes(numInNodesDT)

#--------------#
# Hub Score
#--------------#
hubScoreResult <- igraph::hub_score(
graph = pkg_graph
, scale = TRUE
)

hubScoreResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, hubScore = hubScoreResult$vector
)

# update data.tables
private$update_nodes(hubScoreResultDT)

#--------------#
# PageRank
#--------------#
pageRankResult <- igraph::page_rank(graph = pkg_graph, directed = TRUE)

pageRankResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, pageRank = pageRankResult$vector
)

# update data.tables
private$update_nodes(pageRankResultDT)

#--------------#
# in degree
#--------------#
inDegreeResult <- igraph::degree(pkg_graph, mode = "in")

inDegreeResultDT <- data.table::data.table(node = igraph::vertex.attributes(pkg_graph)[['name']]
, inDegree = inDegreeResult
)

# update data.tables
private$update_nodes(inDegreeResultDT)


#--------------------------------------------------------------#
# NETWORK ONLY METRICS
#--------------------------------------------------------------#

#motifs?
#knn/assortivity?


return(invisible(NULL))
},

# Creates pkg_graph igraph object
# Requires edges and nodes
make_graph_object = function(){
edges <- self$edges
nodes <- self$nodes

if (nrow(edges) > 0) {

# A graph with edges
inGraph <- igraph::graph.edgelist(
as.matrix(edges[,list(SOURCE,TARGET)])
, directed = TRUE
)

# add isolated nodes
allNodes <- nodes$node
nonConnectedNodes <- base::setdiff(allNodes, names(igraph::V(inGraph)))

outGraph <- inGraph + igraph::vertex(nonConnectedNodes)
} else {
# An unconnected graph
allNodes <- nodes$node
outGraph <- igraph::make_empty_graph() + igraph::vertex(allNodes)
}

private$cache$pkg_graph <- outGraph

return(invisible(NULL))
},
# Class of graph to initialize
# Should be constructor
graph_class = NULL,

# Variables for the plot
set_plot_node_color_scheme = function(field
Expand Down Expand Up @@ -342,7 +186,7 @@ AbstractGraphReporter <- R6::R6Class(
# Uses pkg_graph active binding
plot_network = function(){

log_info("Creating plot...")
log_info("Plotting graph visualization...")

log_info(paste("Using igraph layout:", self$layout_type))

Expand Down Expand Up @@ -468,7 +312,6 @@ AbstractGraphReporter <- R6::R6Class(

if (colorByGroup) {
# Add group definitions
log_info(paste(colorFieldValues))
for (groupVal in colorFieldValues) {
thisGroupColor <- plotDTnodes[
get(colorFieldName) == groupVal
Expand Down Expand Up @@ -498,9 +341,6 @@ AbstractGraphReporter <- R6::R6Class(
}
}


log_info("Done creating plot.")

# Save plot in the cache
private$cache$graph_viz <- g

Expand All @@ -514,7 +354,7 @@ AbstractGraphReporter <- R6::R6Class(
return(invisible(NULL))
}

)
) # /private
)

# [title] Available Graph Layout Functions from igraph
Expand Down

0 comments on commit 411a03a

Please sign in to comment.