-
Notifications
You must be signed in to change notification settings - Fork 4
/
mully_layer.R
157 lines (142 loc) · 3.69 KB
/
mully_layer.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
########### Layer Functions ##################
#' Add a layer or a set of layers to a graph
#'
#' @param g The input graph.
#' @param nameLayer The name or the list of the names of the layers to be added. The layer names must be unique.
#'
#' @return The graph, with the layers added.
#'
#' @export
#' @import igraph
#' @examples
#' g = mully("MyFirstMully",direct = FALSE)
#' g = addLayer(g, c("Gene", "Drug", "Disease"))
addLayer <- function(g, nameLayer) {
if (missing(g) || !is.mully(g) || missing(nameLayer)) {
stop("Invalid Argument")
}
for (layer in nameLayer) {
if (isLayer(g, layer)) {
warning(paste(c(
"Layer ", layer, " Already Exists and will be skipped"
)))
next
}
if (layer == "") {
warning("Empty string and will be skipped")
next
}
g$iLayer = g$iLayer + 1
nameLayerLowerCase = casefold(layer, upper = FALSE)
g$layers[getLayersCount(g) + 1,] <-
c(g$iLayer, layer, nameLayerLowerCase)
}
return(g)
}
#' Verify if the layer exists in a graph
#'
#' @param g The input graph.
#' @param name The name of the layer.
#'
#' @return A boolean value.
#'
#' @export
#' @import igraph
#' @examples
#' g = mully("MyFirstMully",direct = FALSE)
#' g = addLayer(g, c("Gene", "Drug", "Disease"))
#' isLayer(g,"Drug")
isLayer <- function(g, name) {
nameLayerLowerCase = casefold(name, upper = FALSE)
if (nameLayerLowerCase %in% g$layers$NameLower) {
return(TRUE)
}
return(FALSE)
}
#' Get the number of layers in a graph
#'
#' @param g The input graph.
#'
#' @return The count of the layers.
#'
#' @export
#' @import igraph
#' @examples
#' g = mully("MyFirstMully",direct = FALSE)
#' g = addLayer(g, c("Gene", "Drug", "Disease"))
#' getLayersCount(g)
getLayersCount <- function(g) {
return(dim(g$layers)[1])
}
getIDLayer <- function(g, nameLayer) {
if (missing(g) || !is.mully(g) ||
missing(nameLayer) || nameLayer == "" ||
!is.character(nameLayer)) {
stop("Invalid Argument")
}
nameLayerLowerCase = casefold(nameLayer, upper = FALSE)
if (!isLayer(g,nameLayer)) {
return(-1)
}
return(as.numeric(g$layers$ID[which(g$layers$NameLower == nameLayerLowerCase)]))
}
#' Get the nodes on a layer in a graph
#'
#' @param g The input graph.
#' @param nameLayer The name of the layer.
#'
#' @return A List of the nodes on the given layer.
#'
#' @import igraph
#' @export
#' @examples
#' g = mully::demo()
#' getLayer(g,"gene")
getLayer <- function(g, nameLayer) {
if (missing(g) || !is.mully(g) || missing(nameLayer)) {
stop("Invalid Argument")
}
id = getIDLayer(g, nameLayer)
l=which(V(g)$n == id)
return(V(g)[l])
}
getLayerByID <- function(g, id) {
if (missing(g) || !is.mully(g) || missing(id)) {
stop("Invalid Argument")
}
l=which(V(g)$n == id)
return(V(g)[l])
}
#' Delete a layer or a set of layers from a graph
#'
#' @param g The input graph.
#' @param name The name or the list of the names of the layers to be deleted.
#' @param trans A boolean whether to insert transitive edges or not
#'
#' @return The mully graph, with the given layer and its corresponding nodes and edges removed.
#'
#' @export
#' @import igraph
#' @examples
#' g = mully::demo()
#' removeLayer(g,"gene",trans=TRUE)
removeLayer <- function(g, name,trans=FALSE) {
if (missing(g) ||
missing(name) || name == "" || !is.mully(g)) {
stop("Invalid Arguments")
}
for (layer in name) {
layer=tolower(layer)
if (!isLayer(g, layer)) {
message(paste(c(
"Layer ", layer, " Does Not Exist and will be skipped"
)))
next
}
nodes = getLayer(g, layer)$name
for(j in 1:length(nodes))
g <- removeNode(g, nodes[j],trans)
g$layers=g$layers[-which(g$layers$NameLower==layer),]
}
return(g)
}