Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Degree list #244

Merged
merged 11 commits into from
Feb 22, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ Description: plot.data is an R package for creating client-ready data for variou
License: Apache License (= 2.0)
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.2.3
RoxygenNote: 7.3.1
Suggests:
covr,
testthat (>= 2.1.0)
Expand Down
12 changes: 9 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -16,11 +16,9 @@ export(KPartiteNetwork)
export(Link)
export(LinkList)
export(Network)
export(Node)
export(NodeId)
export(NodeIdList)
export(NodeList)
export(Partition)
export(Partitions)
export(TwoByTwoTable)
export(adjustToViewport)
Expand All @@ -45,6 +43,7 @@ export(findViewport)
export(fishersTest)
export(getDuplicateLinks)
export(getIsolatedNodes)
export(getPartitionIndex)
export(getQuadrantValues)
export(heatmap)
export(heatmap.dt)
Expand Down Expand Up @@ -76,8 +75,8 @@ export(sensitivity)
export(smoothedMean)
export(specificity)
export(writeJSON)
export(writeNetworkJSON)
exportClasses(ContingencyTable)
exportClasses(KPartiteNetwork)
exportClasses(Link)
exportClasses(LinkList)
exportClasses(Network)
Expand All @@ -87,6 +86,12 @@ exportClasses(NodeIdList)
exportClasses(NodeList)
exportClasses(Partitions)
exportClasses(TwoByTwoTable)
exportMethods(KPartiteNetwork)
exportMethods(Link)
exportMethods(LinkList)
exportMethods(Network)
exportMethods(NodeIdList)
exportMethods(NodeList)
exportMethods(allStats)
exportMethods(chiSqResults)
exportMethods(fishersTest)
Expand All @@ -106,6 +111,7 @@ exportMethods(relativeRisk)
exportMethods(sensitivity)
exportMethods(specificity)
exportMethods(toJSON)
exportMethods(writeNetworkJSON)
import(data.table)
import(veupathUtils)
importFrom(S4Vectors,SimpleList)
Expand Down
21 changes: 10 additions & 11 deletions R/class-Link.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@ check_link <- function(object) {
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.
Expand All @@ -30,16 +29,16 @@ check_link <- function(object) {
#' @export
setClass("Link",
representation(
source = "Node",
target = "Node",
source = "NodeId",
target = "NodeId",
weight = "numeric",
color = 'ANY',
isDirected = "logical"
# label = "character" # coming soon
),
prototype = prototype(
source = Node(),
target = Node(),
source = NodeId(),
target = NodeId(),
weight = 1,
color = NULL,
isDirected = FALSE
Expand All @@ -49,8 +48,8 @@ setClass("Link",

#' Link constructor
#'
#' @param source The source node
#' @param target The target node
#' @param source The source node identifier
#' @param target The target node identifier
#' @param weight The weight of the link
#' @param color The color of the link
#' @param isDirected Whether the link is directed
Expand All @@ -59,22 +58,22 @@ setGeneric("Link", function(source, target, weight = 1, color = NULL, isDirected

#' @export
setMethod("Link", c("Node", "Node"), function(source, target, weight = 1, color = NULL, isDirected = FALSE) {
new("Link", source = source, target = target, weight = weight, color = color, isDirected = isDirected)
new("Link", source = NodeId(id(source)), target = NodeId(id(target)), weight = weight, color = color, isDirected = isDirected)
})

#' @export
setMethod("Link", c("character", "character"), function(source, target, weight = 1, color = NULL, isDirected = FALSE) {
Link(source = Node(source), target = Node(target), weight = weight, color = color, isDirected = isDirected)
Link(source = NodeId(source), target = NodeId(target), weight = weight, color = color, isDirected = isDirected)
})

#' @export
setMethod("Link", c("numeric", "numeric"), function(source, target, weight = 1, color = NULL, isDirected = FALSE) {
Link(source = Node(source), target = Node(target), weight = weight, color = color, isDirected = isDirected)
Link(source = NodeId(source), target = NodeId(target), weight = weight, color = color, isDirected = isDirected)
})

#' @export
setMethod("Link", c("NodeId", "NodeId"), function(source, target, weight = 1, color = NULL, isDirected = FALSE) {
Link(source = Node(source), target = Node(target), weight = weight, color = color, isDirected = isDirected)
new("Link", source = source, target = target, weight = weight, color = color, isDirected = isDirected)
})

#' @export
Expand Down
2 changes: 1 addition & 1 deletion R/class-Network.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ 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
nodesInLinks <- NodeIdList(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.')
}
Expand Down
4 changes: 3 additions & 1 deletion R/class-Node.R
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,7 @@ generate_node_id <- function(n = 5000) {
#' @slot y numeric value indicating the y coordinate of the node. Optional.
#' @slot color string or numeric that determines the color of the node. Optional.
#' @slot weight numeric value associated with the node, such as timestamp or other node-associated data. Optional.
#' @slot degree numeric value indicating the degree of the node
#'
#' @name Node-class
#' @rdname Node-class
Expand All @@ -113,7 +114,8 @@ setClass("Node",
x = "numeric",
y = "numeric",
color = "ANY",
weight = "ANY"
weight = "ANY",
degree = "numeric"
),
validity = check_node
)
Expand Down
45 changes: 27 additions & 18 deletions R/constructors-Node.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,11 @@
#'
#' @param value string a unique identifier for the node
#' @export
NodeId <- function(value) {
new("NodeId", value = value)
NodeId <- function(value = character()) {
if (length(value) == 0) {
value <- generate_node_id(1)
}
new("NodeId", value = as.character(value))
}


Expand Down Expand Up @@ -97,27 +100,28 @@ setMethod("NodeIdList", "Node", function(object, uniquifyIds = c(TRUE, FALSE)) {
#' @param y numeric value indicating the y coordinate of the node. Optional.
#' @param color string or numeric that determines the color of the node. Optional.
#' @param weight numeric value associated with the node, such as timestamp or other node-associated data. Optional.
#' @export
setGeneric("Node", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL) standardGeneric("Node"), signature = c("id"))
#' @param degree numeric value indicating the degree of the node. This only makes sense in the context of a network,
#' and should not be provided in other contexts like when working w an individual node.
setGeneric("Node", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL, degree = NULL) standardGeneric("Node"), signature = c("id"))

#' @export
setMethod("Node", "numeric", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL) {
new("Node", id = NodeId(as.character(id)), x = x, y = y, color = color, weight = weight)
setMethod("Node", "numeric", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL, degree = NULL) {
degree <- ifelse(is.null(degree), NA_real_, degree)
new("Node", id = NodeId(as.character(id)), x = x, y = y, color = color, weight = weight, degree = degree)
})

#' @export
setMethod("Node", "character", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL) {
new("Node", id = NodeId(id), x = x, y = y, color = color, weight = weight)
setMethod("Node", "character", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL, degree = NULL) {
degree <- ifelse(is.null(degree), NA_real_, degree)
new("Node", id = NodeId(id), x = x, y = y, color = color, weight = weight, degree = degree)
})

#' @export
setMethod("Node", "NodeId", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL) {
new("Node", id = id, x = x, y = y, color = color, weight = weight)
setMethod("Node", "NodeId", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL, degree = NULL) {
degree <- ifelse(is.null(degree), NA_real_, degree)
new("Node", id = id, x = x, y = y, color = color, weight = weight, degree = degree)
})

#' @export
setMethod("Node", "missing", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL) {
new("Node", id = NodeId(generate_node_id(1)), x = x, y = y, color = color, weight = weight)
setMethod("Node", "missing", function(id, x = numeric(), y = numeric(), color = NULL, weight = NULL, degree = NULL) {
degree <- ifelse(is.null(degree), NA_real_, degree)
new("Node", id = NodeId(generate_node_id(1)), x = x, y = y, color = color, weight = weight, degree = degree)
})


Expand All @@ -138,8 +142,13 @@ setMethod("NodeList", "data.frame", function(object = data.frame(source=characte
stop(paste("Invalid edgeList:", isValidEdgeList(object), collapse = '\n'))
}

allNodeIds <- unique(c(object$source, object$target))
nodesList <- lapply(allNodeIds, Node)
allNodeIds <- c(object$source, object$target)

makeNodeWithDegree <- function(nodeId, allNodeIds) {
new("Node", id = NodeId(nodeId), degree = length(which(allNodeIds == nodeId)))
}

nodesList <- lapply(unique(allNodeIds), makeNodeWithDegree, allNodeIds)
new("NodeList", nodesList)
})

Expand Down
2 changes: 0 additions & 2 deletions R/methods-KPartiteNetwork.R
Original file line number Diff line number Diff line change
Expand Up @@ -41,8 +41,6 @@ setMethod(toJSONGeneric, "KPartiteNetwork", function(object, named = c(TRUE, FAL
links_json <- veupathUtils::toJSON(object@links, named = FALSE)
partitions_json <- veupathUtils::toJSON(object@partitions, named = FALSE)

# TODO this doesnt conform to the api in the data service, bc there we explicitly have a bipartite network and not a kpartite
# we have `columns1NodeIds` and `columns2NodeIds` instead of `partitions`. i think this is better though.
tmp <- paste0('"nodes":', nodes_json, ',"links":', links_json, ',"partitions":', partitions_json)
tmp <- paste0('"data":{', tmp, '}')
tmp <- paste0('{', tmp, ',"config":{"variables":{', veupathUtils::toJSON(object@variableMapping, named = FALSE), '}}}')
Expand Down
13 changes: 7 additions & 6 deletions R/methods-Network.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ setGeneric("getLinkColorScheme", function(object) standardGeneric("getLinkColorS
setMethod("getLinkColorScheme", "Network", function(object) object@linkColorScheme)
# No setters! Once created, a network should only be updated via network methods

setMethod("getDegrees", "Network", function(object) getDegrees(getNodes(object)))

## General network methods

Expand All @@ -26,8 +27,8 @@ setMethod("getIsolatedNodes", "Network", function(net) {
nodes <- getNodes(net)
links <- getLinks(net)

nodesWithLinks <- NodeList(union(getSourceNodes(links), getTargetNodes(links)))
isolatedNodeIds <- setdiff(getNodeIds(nodes), getNodeIds(nodesWithLinks))
nodeIdsWithLinks <- NodeIdList(union(getSourceNodes(links), getTargetNodes(links)))
isolatedNodeIds <- setdiff(getNodeIds(nodes), getNodeIds(nodeIdsWithLinks))
isolatedNodes <- NodeList(nodes[which(getNodeIds(nodes) %in% isolatedNodeIds)])

return(isolatedNodes)
Expand Down Expand Up @@ -192,17 +193,17 @@ setMethod(toJSONGeneric, "Network", function(object, named = c(TRUE, FALSE)) {
return(tmp)
})

#' Write json to tmp file
#' Write network json to tmp file
#'
#' This function returns the name of a json file which it has
#' written an object out to.
#' @param x an object to convert to json and write to a tmp file
#' @param verbose boolean that declares if logging is desired
#' @return character name of a tmp file w ext *.json
#' @export
setGeneric("writeJSON", function(x, pattern = NULL, verbose = c(TRUE, FALSE)) standardGeneric("writeJSON"))
setGeneric("writeNetworkJSON", function(x, pattern = NULL, verbose = c(TRUE, FALSE)) standardGeneric("writeNetworkJSON"))

#' Write json to local tmp file
#' Write network json to local tmp file
#'
#' This function returns the name of a json file which it has
#' written a Network object out to.
Expand All @@ -212,7 +213,7 @@ setGeneric("writeJSON", function(x, pattern = NULL, verbose = c(TRUE, FALSE)) st
#' @return character name of a tmp file w ext *.json
#' @importFrom jsonlite toJSON
#' @export
setMethod("writeJSON", "Network", function(x, pattern=NULL, verbose = c(TRUE, FALSE)) {
setMethod("writeNetworkJSON", "Network", function(x, pattern=NULL, verbose = c(TRUE, FALSE)) {
net <- x
verbose <- veupathUtils::matchArg(verbose)

Expand Down
7 changes: 7 additions & 0 deletions R/methods-Nodes.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@ setGeneric("x", function(object) standardGeneric("x"))
setGeneric("x<-", function(object, value) standardGeneric("x<-"))
setGeneric("y", function(object) standardGeneric("y"))
setGeneric("y<-", function(object, value) standardGeneric("y<-"))
setGeneric("degree", function(object) standardGeneric("degree"))
setGeneric("degree<-", function(object, value) standardGeneric("degree<-"))

#' @include methods-Links.R
## Methods for Nodes
Expand All @@ -21,6 +23,8 @@ setMethod("x<-", "Node", function(object, value) {object@x <- value; validObject
setMethod("y<-", "Node", function(object, value) {object@y <- value; validObject(object); object})
setMethod("color<-", "Node", function(object, value) {object@color <- value; validObject(object); object})
setMethod("weight<-", "Node", function(object, value) {object@weight <- value; validObject(object); object})
setMethod("degree", "Node", function(object) object@degree)
setMethod("degree<-", "Node", function(object, value) {object@degree <- value; validObject(object); object})

## Methods for NodeId
setMethod("id", "NodeId", function(object) object@value)
Expand All @@ -36,6 +40,8 @@ setGeneric("getNodeIds", function(object) standardGeneric("getNodeIds"))
setMethod("getNodeIds", "NodeList", function(object) unlist(lapply(as.list(object), id)))
setMethod("getWeights", "NodeList", function(object) unlist(lapply(as.list(object), weight)))
setMethod("getColors", "NodeList", function(object) unlist(lapply(as.list(object), color)))
setGeneric("getDegrees", function(object) standardGeneric("getDegrees"))
setMethod("getDegrees", "NodeList", function(object) unlist(lapply(as.list(object), degree)))

## Methods for NodeIdList
setMethod("getNodeIds", "NodeIdList", function(object) unlist(lapply(as.list(object), id)))
Expand All @@ -58,6 +64,7 @@ setMethod(toJSONGeneric, "Node", function(object, named = c(FALSE, TRUE)) {
if (!!length(y(object))) tmp <- paste0(tmp, ',"y":', jsonlite::toJSON(jsonlite::unbox(y(object))))
if (!!length(color(object))) tmp <- paste0(tmp, ',"color":', jsonlite::toJSON(jsonlite::unbox(color(object))))
if (!!length(weight(object))) tmp <- paste0(tmp, ',"weight":', jsonlite::toJSON(jsonlite::unbox(weight(object))))
if (!!length(degree(object)) && !is.na(degree(object))) tmp <- paste0(tmp, ',"degree":', jsonlite::toJSON(jsonlite::unbox(degree(object))))

tmp <- paste0('{', tmp, '}')
if (named) {
Expand Down
12 changes: 11 additions & 1 deletion man/KPartiteNetwork-class.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/Link-class.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

22 changes: 22 additions & 0 deletions man/Link.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/LinkList-class.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading