Merge pull request #231 from VEuPathDB/feature-229-add-network

add network and bipartite network classes

DESCRIPTION

@@ -40,3 +40,33 @@ Suggests:
     testthat (>= 2.1.0)
 Depends: 
     R (>= 2.10)
+Collate: 
+    'bin.R'
+    'class-ContingencyTable.R'
+    'class-Node.R'
+    'class-Link.R'
+    'class-Network.R'
+    'methods-Links.R'
+    'methods-Nodes.R'
+    'methods-KPartiteNetwork.R'
+    'class-KPartiteNetwork.R'
+    'class-plotdata-bar.R'
+    'class-plotdata-beeswarm.R'
+    'class-plotdata-box.R'
+    'class-plotdata-heatmap.R'
+    'class-plotdata-histogram.R'
+    'class-plotdata-line.R'
+    'class-plotdata-map-markers.R'
+    'class-plotdata-mosaic.R'
+    'class-plotdata-scatter.R'
+    'class-plotdata.R'
+    'group.R'
+    'methods-ContingencyTable.R'
+    'methods-network.R'
+    'panel.R'
+    'plot.data-package.R'
+    'utils-bin.R'
+    'utils-json.R'
+    'utils-pipe.R'
+    'utils-stats.R'
+    'utils.R'

NAMESPACE

@@ -12,6 +12,16 @@ S3method(numBinsToBinWidth,Date)
 S3method(numBinsToBinWidth,default)
 export("%>%")
 export(ContingencyTable)
+export(KPartiteNetwork)
+export(Link)
+export(LinkList)
+export(Network)
+export(Node)
+export(NodeId)
+export(NodeIdList)
+export(NodeList)
+export(Partition)
+export(Partitions)
 export(TwoByTwoTable)
 export(adjustToViewport)
 export(allStats)
@@ -60,6 +70,15 @@ export(smoothedMean)
 export(specificity)
 export(writeJSON)
 exportClasses(ContingencyTable)
+exportClasses(KPartiteNetwork)
+exportClasses(Link)
+exportClasses(LinkList)
+exportClasses(Network)
+exportClasses(Node)
+exportClasses(NodeId)
+exportClasses(NodeIdList)
+exportClasses(NodeList)
+exportClasses(Partitions)
 exportClasses(TwoByTwoTable)
 exportMethods(allStats)
 exportMethods(chiSqResults)

R/class-KPartiteNetwork.R

@@ -0,0 +1,119 @@
+#' @include methods-KPartiteNetwork.R
+check_partitions <- function(object) {
+  errors <- character()
+
+  if (!!length(getAllNodeIds(object))) {
+    # Ensure that no node is in multiple partitions
+    if (length(getAllNodeIds(object)) > data.table::uniqueN(getAllNodeIds(object))) {
+      errors <- c(errors, 'Found a node in multiple partitions. Nodes can only exist in one partition.')
+    }
+  }
+
+  return(if (length(errors) == 0) TRUE else errors)
+}
+
+#' Partitions
+#' 
+#' A class for representing partitions in a k-partite network
+#' 
+#' @name Partitions-class
+#' @rdname Partitions-class
+#' @export
+setClass("Partitions", 
+  contains = "SimpleList",
+  prototype = prototype(
+    elementType = "NodeIdList"
+  ),
+  validity = check_partitions
+)
+
+#' Create a Partition
+#' 
+#' An alias to NodeIdList
+#' 
+#' @name Partition-class
+#' @rdname Partition-class
+#' @export
+Partition <- NodeIdList
+
+#' Create Partitions
+#' 
+#' A list of Partition objects, each containing a list of node 
+#' ids that belong to a single partition
+#' 
+#' @param partitions list of Partition (or NodeIdList) objects
+#' @export 
+#' @rdname Partitions
+Partitions <- function(partitions = list()) {
+  if (length(partitions) == 0) {
+    return(new("Partitions", S4Vectors:::SimpleList(list())))
+  }
+
+  if (length(partitions) == 1 && !is.list(partitions)) {
+    ## an edge case i suppose where we had a single partition w  a single node
+    partitions <- list(Partition(partitions))
+  }
+
+  if (!is.list(partitions)) {
+    stop('Partitions must be a list')
+  }
+
+  if (!all(unlist(lapply(partitions, inherits, "NodeIdList")))) {
+    stop('Partitions must be a list of NodeIdList objects')
+  }
+
+  return(new("Partitions", S4Vectors:::SimpleList(partitions)))
+}
+
+check_kpartite_network <- function(object) {
+
+  errors <- character()
+
+  # Check that all nodes are in at least one of the partitions
+  if (!all(getNodeIds(object@nodes) %in% getAllNodeIds(object@partitions))) {
+    errors <- c(errors, 'Found a node that is not in any partition. All nodes must be assigned to a partition.')
+  }
+  if (!all(getAllNodeIds(object@partitions) %in% getNodeIds(object@nodes))) {
+    errors <- c(errors, 'Found an id in a partition that is not in the nodes list. All partitions must must include ids in the nodes list.')
+  }
+
+  # Check that linkColorScheme is one of the accepted values
+  if (!object@linkColorScheme %in% c('none', 'posneg')) {
+    errors <- c(errors, 'linkColorScheme must be one of "none" or "posneg"')
+  }
+
+  return(if (length(errors) == 0) TRUE else errors)
+}
+
+#' k-Partite Network 
+#' 
+#' The k-partite network class represents data in the form of a network with k distinct groups of nodes
+#' in which nodes connect only with nodes from the other groups. In other words, there are only inter-group
+#' links, no intra-group links. These k groups are commonly called partitions.
+#' k-partite networks can have any property of a regular network, but they also designate the node ids
+#' that belong to each partition (group).
+#' 
+#' @slot links LinkList object defining the links in the network.
+#' @slot nodes NodeList object defining the nodes in the network. Some nodes may not have any links.
+#' @slot linkColorScheme string defining the type of coloring scheme the links follow. Options are 'none' (default) and 'posneg'.
+#' Use a method assignLinkColors() to assign colors to links and set this slot's value.
+#' @slot partitions list of node ids that belong to each partition
+#' 
+#' @name KPartiteNetwork-class
+#' @rdname KPartiteNetwork-class
+#' @include class-Network.R
+#' @export 
+KPartiteNetwork <- setClass("KPartiteNetwork", 
+  contains = "Network",
+  slots = c(
+    partitions = "Partitions"
+  ),
+  prototype = prototype(
+    links = LinkList(),
+    nodes = NodeList(),
+    linkColorScheme = 'none',
+    variableMapping = VariableMetadataList(),
+    partitions = Partitions()
+  ),
+  validity = check_kpartite_network
+)

R/class-Link.R

@@ -0,0 +1,92 @@
+
+
+check_link <- function(object) {
+
+  errors <- character()
+
+  # Link color must be a string or number
+  if (!is.null(object@color) & !is.character(object@color) & !is.numeric(object@color)) {
+    errors <- c(errors, "Link color must be a string or number that represents a color or can be mapped to a color.")
+  }
+
+  #dont allow self-links for now
+  if (id(object@source) == id(object@target)) {
+    errors <- c(errors, "Links cannot be self-links. They must have a different source and target.")
+  }
+
+  return(if (length(errors) == 0) TRUE else errors) 
+}
+
+
+#' Link
+#' 
+#' Represent one singular link. A link has a source, and a target. It may be directed or undirected.
+#' It may have an associated weight, color, timestamp, or label (coming soon!)
+#' 
+#' @name Link-class
+#' @rdname Link-class
+#' @include class-Node.R
+#' @export
+Link <- setClass("Link", 
+  representation(
+    source = "Node",
+    target = "Node",
+    weight = "numeric",
+    color = 'ANY',
+    isDirected = "logical"
+    # label = "character" # coming soon
+  ),
+  prototype = prototype(
+    source = new("Node"),
+    target = new("Node"),
+    weight = 1,
+    isDirected = FALSE
+  ),
+  validity = check_link
+)
+
+
+check_link_list <- function(object) {
+
+  errors <- character()
+
+  if (any(unlist(lapply(object, function(x) {!is.null(color(x))})))) {
+    # If one link has a color, all must have colors
+    if (!all(unlist(lapply(object, function(x) {!is.null(color(x))})))) {
+      errors <- c(errors, "If one link has a color, all links must have a color")
+    }
+
+    # Link colors must be all the same class
+    if (length(unique(unlist(lapply(object, function(x) {class(color(x))})))) > 1) {
+      errors <- c(errors, "Link colors must be all the same class")
+    }
+  }
+
+
+  # If one link has a weight, all must have weights
+  if (any(unlist(lapply(object, function(x) {!is.null(weight(x))})))) {
+    if (!all(unlist(lapply(object, function(x) {!is.null(weight(x))})))) {
+      errors <- c(errors, "If one link has a weight, all links must have a weight")
+    }
+  }
+
+
+  return(if (length(errors) == 0) TRUE else errors) 
+
+}
+
+#' Link List
+#' 
+#' A class for representing links in a network
+#' 
+#' @name LinkList-class
+#' @rdname LinkList-class
+#' @importFrom S4Vectors SimpleList
+#' @export
+LinkList <- setClass("LinkList", 
+  contains = "SimpleList",
+  prototype = prototype(
+    elementType = "Link"
+  ),
+  validity = check_link_list
+)

R/class-Network.R

@@ -0,0 +1,51 @@
+# Network class
+check_network <- function(object) {
+
+  errors <- character()
+
+  # Check that all nodes in links are in nodes
+  nodesInLinks <- NodeList(union(getSourceNodes(object@links), getTargetNodes(object@links))) # may become a method later if i find i use it elsewhere
+  if (!all(getNodeIds(nodesInLinks) %in% getNodeIds(object@nodes))) {
+    errors <- c(errors, 'Found a node in a link that is not in the node list. All nodes in links must also be in nodes.')
+  }
+
+  # Check that linkColorScheme is one of the accepted values
+  if (!object@linkColorScheme %in% c('none', 'posneg')) {
+    errors <- c(errors, 'linkColorScheme must be one of "none" or "posneg"')
+  }
+
+
+  return(if (length(errors) == 0) TRUE else errors)
+}
+
+
+#' Network
+#' 
+#' A class for representing networks. A network is composed of nodes and links (edges, connections, etc.). A link is represented
+#' as a pair of nodes, with optional attributes such as weight (see Link). To represent a network, we need both the list of links in the network and a list of nodes
+#' in case some nodes have no links. A network can also have properties such as directedness, levels, colors, etc. (coming soon).
+#' 
+#' @slot links LinkList object defining the links in the network.
+#' @slot nodes NodeList object defining the nodes in the network. Some nodes may not have any links.
+#' @slot linkColorScheme string defining the type of coloring scheme the links follow. Options are 'none' (default) and 'posneg'.
+#' @slot variableMapping veupathUtils::VariableMetadataList object defining the variable mappings in the network.
+#' Use a method assignLinkColors() to assign colors to links and set this slot's value.
+#' 
+#' @name Network-class
+#' @rdname Network-class
+#' @include class-Link.R
+#' @export
+Network <- setClass("Network", 
+  representation(
+    links = "LinkList",
+    nodes = "NodeList",
+    linkColorScheme = "character",
+    variableMapping = "VariableMetadataList"
+  ), prototype = prototype(
+    links = LinkList(),
+    nodes = NodeList(),
+    linkColorScheme = 'none',
+    variableMapping = VariableMetadataList()
+  ),
+  validity = check_network
+)