Add network methods

DESCRIPTION

@@ -43,12 +43,14 @@ Depends:
 Collate: 
     'bin.R'
     'class-ContingencyTable.R'
+    'utils.R'
     'class-Node.R'
+    'constructors-Node.R'
     'class-Link.R'
     'class-Network.R'
     'methods-Links.R'
     'methods-Nodes.R'
-    'methods-KPartiteNetwork.R'
+    'class-Partitions.R'
     'class-KPartiteNetwork.R'
     'class-plotdata-bar.R'
     'class-plotdata-beeswarm.R'
@@ -62,11 +64,11 @@ Collate:
     'class-plotdata.R'
     'group.R'
     'methods-ContingencyTable.R'
-    'methods-network.R'
+    'methods-KPartiteNetwork.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

@@ -43,6 +43,8 @@ export(findBinSliderValues)
 export(findBinWidth)
 export(findViewport)
 export(fishersTest)
+export(getDuplicateLinks)
+export(getIsolatedNodes)
 export(getQuadrantValues)
 export(heatmap)
 export(heatmap.dt)
@@ -62,6 +64,11 @@ export(orderByReferenceValues)
 export(outliers)
 export(posPredictiveValue)
 export(prevalence)
+export(pruneDuplicateLinks)
+export(pruneIsolatedNodes)
+export(pruneLinksAboveWeight)
+export(pruneLinksBelowWeight)
+export(pruneLinksByPredicate)
 export(relativeRisk)
 export(scattergl)
 export(scattergl.dt)
@@ -83,16 +90,22 @@ exportClasses(TwoByTwoTable)
 exportMethods(allStats)
 exportMethods(chiSqResults)
 exportMethods(fishersTest)
+exportMethods(getDuplicateLinks)
+exportMethods(getIsolatedNodes)
 exportMethods(getQuadrantValues)
 exportMethods(makeVariableDetails)
 exportMethods(negPredictiveValue)
 exportMethods(oddsRatio)
 exportMethods(orderByReferenceValues)
 exportMethods(posPredictiveValue)
 exportMethods(prevalence)
+exportMethods(pruneDuplicateLinks)
+exportMethods(pruneIsolatedNodes)
+exportMethods(pruneLinksByPredicate)
 exportMethods(relativeRisk)
 exportMethods(sensitivity)
 exportMethods(specificity)
+exportMethods(toJSON)
 import(data.table)
 import(veupathUtils)
 importFrom(S4Vectors,SimpleList)

R/class-KPartiteNetwork.R

@@ -1,82 +1,51 @@
-#' @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.')
+  isLinkWithinPartition <- function(link, partitions) {
+    if (!inherits(link, "Link")) {
+      stop('link must be a Link object')
     }
-  }
-
-  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 (!inherits(partitions, "Partitions")) {
+      stop('partitions must be a Partitions object')
+    }
+
+    source <- source(link)
+    target <- target(link)
 
-  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.null(source) || is.null(target)) {
+      return(FALSE)
+    }
 
-  if (!is.list(partitions)) {
-    stop('Partitions must be a list')
-  }
+    internalLink <- FALSE
+    if (getPartitionIndex(partitions, source) == getPartitionIndex(partitions, target)) {
+      internalLink <- TRUE
+    }
 
-  if (!all(unlist(lapply(partitions, inherits, "NodeIdList")))) {
-    stop('Partitions must be a list of NodeIdList objects')
+    return(internalLink)
   }
 
-  return(new("Partitions", S4Vectors:::SimpleList(partitions)))
-}
-
+#' @include class-Partitions.R
 check_kpartite_network <- function(object) {
 
   errors <- character()
 
+  # Check we have at least two partitions
+  if (length(object@partitions) < 2) {
+    errors <- c(errors, 'k-partite networks must have at least two partitions.')
+  }
+
   # 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.')
+  } else if (any(sapply(getLinks(object), isLinkWithinPartition, object@partitions))) {
+    # Check that there are no links connecting nodes within a partition, only across the different partitions
+    # this check wont work if a node is missing from a partition
+    errors <- c(errors, 'Found a link between nodes in the same partition. Links between nodes in the same partition are not allowed.')
   }
   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.')
+    errors <- c(errors, 'Found an node id in a partition that is not in the nodes list. Node IDs must be consistent between partitions and nodes slots.')
   }
 
+
+
+
   # 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"')
@@ -116,4 +85,86 @@ KPartiteNetwork <- setClass("KPartiteNetwork",
     partitions = Partitions()
   ),
   validity = check_kpartite_network
-)
+)
+
+#' @include utils.R
+#' Generate a K-Partite Network 
+#' 
+#' Generate a K-Partite Network from a LinkList and NodeList, or from a data.frame
+#' @param object Object containing data to be converted to a Network
+#' @param links LinkList
+#' @param nodes NodeList
+#' @param partitions Partitions
+#' @param linkColorScheme string defining the type of coloring scheme the links follow. Options are 'none' (default) and 'posneg'.
+#' @param variables VariableMetadataList
+#' @return KPartiteNetwork
+#' @export
+#' @examples
+#' KPartiteNetwork(data.frame(source='a',target='b'))
+setGeneric("KPartiteNetwork", 
+  function(
+    object,
+    links,
+    nodes,
+    partitions = Partitions(),
+    linkColorScheme = 'none', 
+    variables = VariableMetadataList(), 
+    ...
+  ) standardGeneric("KPartiteNetwork"),
+  signature = c("object", "links", "nodes")
+)
+
+#' @export
+setMethod("KPartiteNetwork", signature("missing", "LinkList", "NodeList"), function(
+  object,
+  links, 
+  nodes,
+  partitions = Partitions(),
+  linkColorScheme = 'none', 
+  variables = VariableMetadataList(), 
+  ...
+) {
+  new("KPartiteNetwork", links=links, nodes=nodes, partitions=partitions, linkColorScheme=linkColorScheme, variableMapping=variables)
+})
+
+#' @export  
+setMethod("KPartiteNetwork", signature("data.frame", "missing", "missing"), function(
+  object = data.frame(source=character(),target=character()),
+  links, 
+  nodes,
+  partitions = Partitions(),
+  linkColorScheme = 'none', 
+  variables = VariableMetadataList(), 
+  ...
+) {
+  new("KPartiteNetwork", links=LinkList(object), nodes=NodeList(object), partitions=partitions, linkColorScheme=linkColorScheme, variableMapping=variables)
+})
+
+#' @export
+setMethod("KPartiteNetwork", signature("Network", "missing", "missing"), function(
+  object,
+  links, 
+  nodes,
+  partitions = Partitions(),
+  linkColorScheme = 'none', 
+  variables = VariableMetadataList(), 
+  ...
+) {
+  nodes <- object@nodes
+  links <- object@links
+
+  new("KPartiteNetwork", links=links, nodes=nodes, partitions=partitions, linkColorScheme=linkColorScheme, variableMapping=variables)
+})
+
+#' @export 
+setMethod("KPartiteNetwork", signature("missing", "missing", "missing"), function(
+  object,
+  links, 
+  nodes,
+  partitions = Partitions(),
+  linkColorScheme = 'none', 
+  variables = VariableMetadataList(), 
+  ...
+) {
+  new("KPartiteNetwork")
+})