-
Notifications
You must be signed in to change notification settings - Fork 1
/
Views.R
329 lines (313 loc) · 11.6 KB
/
Views.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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
#' Create an empty view
#'
#' @param g The input graph
#' @param name The name of the view
#'
#' @return An empty view
#' @export
#'
#' @examples
#' \dontrun{
#' view=pathwayView(mully("myMully",T),"View1")
#' }
#' @importFrom uuid UUIDgenerate
pathwayView<-function(g,name){
id=UUIDgenerate(TRUE)
op <- options(digits.secs = 6)
timestamp=Sys.time()
options(op)
#Original and last version Graphs
original=g
modified=g
lastStep=0
steps=data.frame(stepID=is.integer(c()),action=is.character(c()),element=is.character(c()),name=is.character(c()),V1=is.character(c()),V2=is.character(c()),attributesnames=is.list(c()),attributes=is.list(c()),stringsAsFactors=F)[-1,]
v=list("id"=id,"name"=name,"original"=original,"modified"=modified,"lastStep"=lastStep,"steps"=steps,"timestamp"=timestamp,"lastmodified"=timestamp)
class(v)=c("pathwayView",class(v))
return(v)
}
#' Print function
#'
#' @param x The input View to be printed
#' @param ... any other parameteres passed to \code{print}
#'
#' @export
#' @importFrom utils capture.output
#' @importFrom crayon blue bold green
print.pathwayView<-function(x,...){
if(missing(x))
stop("Invalid Argument")
cat("View")
if(!is.na(x$name)){
cat(paste(" -- ",green(x$name),sep=""))
}
cat(paste(" -- ",x$id,sep=""))
cat(paste(bold("\nCreated: "),blue(x$timestamp),sep=""))
cat(paste(" -- ",bold("last modified: "),blue(x$lastmodified),sep=""))
cat(paste(bold("\nOriginal Graph: "),green(x$original$name),sep=""))
if(dim(x$steps)[1]==0)
cat("\nThis View has no steps.")
else{
osteps=capture.output(print.data.frame(x$steps))
osteps <- paste(osteps, "\n", sep="")
cat(blue("\nThe View has the following ",bold(dim(x$steps)[1])," step(s):\n"))
cat(osteps)
}
}
is.pathwayView<-function(v){
if(!"pathwayView"%in%class(v))
return(FALSE)
if(is.null(v$original)
|| is.null(v$id) || is.na(v$id)
|| is.null(v$steps))
return(FALSE)
return(TRUE)
}
#' Track a modification of a graph
#'
#' @param v The input view in which the modification should be saved
#' @param action The type of action to be applied. Can either be "add" or "remove
#' @param element The type of the element to be modified. Can either be "node", "edge", or "layer"
#' @param name The name of the element to be modified. This argument is only mandatory for nodes and edges
#' @param layername The layer name. This argument is only mandatory for action "add" and element "node"
#' @param V1 The start node of an edge. This argument is only mandatory for element "edge"
#' @param V2 The end node of an edge. This argument is only mandatory for element "edge"
#' @param attributes The named list of attributes of the element. This argument is required only for action "add". It is optional for both elements "node" and "edge", but mandatory if the edge alread exists
#' @param multi A boolean whether to select multi-edges or not. This is only mandatory for action "remove" and element "edge". By default set to FALSE, in which case the attributes of the specified edge should be given
#' @param trans A boolean whether to add transitive edges upon removal of nodes or layers
#'
#' @return The View with the added step
#' @export
#'
#' @examples
#' \dontrun{
#' g=mully:::demo()
#' view=pathwayView(g,"View1")
#' view=addStep(view,"remove","layer","")
#' }
#' @import mully
#' @importFrom dplyr anti_join
addStep<-function(v,action,element,name=NA,layername=NA,V1=NA,V2=NA,attributes=NA,multi=F,trans=T){
if(missing(v) || !is.pathwayView(v) || missing(action) || missing(element)
|| !action%in%c("add","remove") || !element%in%c("node","edge","layer") ){
stop("This step cannot be applied. Please provide a correct view, action and element.")
}
if(element=="edge" && (missing(V1) || missing (V2))){
stop("This step cannot be applied. Please provide the arguments V1 and V2.")
}
if(element%in%c("node","layer") && (missing(name) || is.na(name))){
stop("This step cannot be applied. Please provide the name of the element.")
}
if(element=="node" && action=="add" && (missing(layername) || is.na(layername))){
stop("This step cannot be applied. Please provide the layer name on which the node should be added.")
}
#tmp variables
g=v$modified
oldg=v$modified
stepID=v$lastStep+1
steps=data.frame("stepID"=is.integer(c()),"action"=is.character(c()),"element"=is.character(c()),"name"=is.character(c()),"V1"=is.character(c()),"V2"=is.character(c()),"attributesnames"=is.list(c()),"attributes"=is.list(c()),stringsAsFactors = F)[-1,]
########## Action Add ############
#select case add
if(action=="add"){
#Call addLayer
if(element=="layer"){
g=mully::addLayer(g,name)
#Update steps in the view
row=list("stepID"=stepID,"action"="add","element"="layer","name"=name,"V1"=NA,"V2"=NA,"attributes"=NA)
steps=rbind(steps,row)
}
#Call addNode
if(element=="node"){
g=mully::addNode(g,name,layername,attributes)
#Update steps in the view
att=as.list(getNodeAttributes(g,name))[-1]
row=list("stepID"=stepID,"action"="add","element"="node","name"=name,"V1"=NA,"V2"=NA,"attributesnames"=paste(names(att),collapse="---"),"attributes"=paste(att,collapse="---"))
steps=rbind(steps,row)
}
#Call addEdge
if(element=="edge"){
g=mully::addEdge(g,V1,V2,attributes)
#Update steps in the view
row=list("stepID"=stepID,"action"="add","element"="edge","name"=NA,"V1"=V1,"V2"=V2,"attributesnames"=paste(names(attributes),collapse="---"),"attributes"=paste(attributes,collapse="---"))
steps=rbind(steps,row)
}
}
########## Action Remove ############
#select case remove
if(action=="remove"){
#Call removeLayer
if(element=="layer"){
g=mully::removeLayer(g,name,trans=trans)
#Update steps in the view
nodes=mully::getLayer(oldg,name)$name
##Add removed edges
edgesOld=mully::getEdgeAttributes(oldg)
deletedEdges=unique(rbind(edgesOld[which(edgesOld$V1 %in% nodes),],edgesOld[which(edgesOld$V2 %in% nodes),]))
rows=dim(deletedEdges)[1]
i=1
while(i<=rows){
att=as.list(deletedEdges[i,])[-1][-1]
row=list("stepID"=stepID,"action"="remove","element"="edge","name"=NA,"V1"=deletedEdges$V1[i],"V2"=deletedEdges$V2[i],"attributesnames"=paste(names(deletedEdges[-1][-1]),collapse="---"),attributes=paste(att,collapse="---"))
steps=rbind(steps,row)
i=i+1
}
##Add removed nodes
idLayer=oldg$layers$ID[which(oldg$layers$Name==name)]
nodes=mully::getNodeAttributes(oldg)
nodes=nodes[which(nodes$n==idLayer),]
rows=dim(nodes)[1]
i=1
while(i<=rows){
l=as.list(nodes[i,])[-1]
row=list("stepID"=stepID,"action"="remove","element"="node","name"=nodes[i,1],"V1"=NA,"V2"=NA,"attributesnames"=paste(names(l),collapse="---"),"attributes"=paste(l,collapse="---"))
steps=rbind(steps,row)
i=i+1
}
##Add removed layer
row=list("stepID"=stepID,"action"="remove","element"="layer","name"=name,"V1"=NA,"V2"=NA,"attributesnames"=c("n"),"attributes"=c(idLayer))
steps=rbind(steps,row)
}
#Call removeNode
if(element=="node"){
g=mully::removeNode(g,name,trans=trans)
#Add removed edges
oldedges=mully::getEdgeAttributes(oldg,name)
rows=dim(oldedges)[1]
i=1
while(i<=rows){
l=as.list(oldedges[i,])[-1][-1]
row=list("stepID"=stepID,"action"="remove","element"="edge","name"=NA,"V1"=oldedges$V1[i],"V2"=oldedges$V2[i],"attributesnames"=paste(names(l),collapse="---"),"attributes"=paste(l,collapse="---"))
steps=rbind(steps,row)
i=i+1
}
#Add added transitive edges
edges=mully::getEdgeAttributes(g)
if("via"%in%names(edges)){
transedges=edges[which(edges$type=="trans"),]
transedges=transedges[which(transedges$via==name),]
rows=dim(transedges)[1]
i=1
while(i<=rows){
l=as.list(transedges[i,])[-1][-1]
row=list("stepID"=stepID,"action"="add","element"="edge","name"=NA,"V1"=transedges$V1[i],"V2"=transedges$V2[i],"attributesnames"=paste(names(l),collapse="---"),"attributes"=paste(l,collapse="---"))
steps=rbind(steps,row)
i=i+1
}
}
#Update steps in the view
l=as.list(getNodeAttributes(oldg,name))[-1]
row=list("stepID"=stepID,"action"="remove","element"="node","name"=name,"V1"=NA,"V2"=NA,"attributesnames"=paste(names(l),collapse="---"),"attributes"=paste(l,collapse="---"))
steps=rbind(steps,row)
}
#Call removeEdge
if(element=="edge"){
g=mully::removeEdge(oldg,nodeStart=V1,nodeDest=V2,attributes,multi)
#Find removed edges
edgesold=mully::getEdgeAttributes(oldg,V1,V2)
edgesnew=mully::getEdgeAttributes(g,V1,V2)
edges=anti_join(edgesold,edgesnew)
rows=dim(edges)[1]
i=1
while(i<=rows)
{
l=as.list(edges[i,])[-1][-1]
row=list("stepID"=stepID,"action"="remove","element"="edge","name"=NA,"V1"=V1,"V2"=V2,"attributesnames"=paste(names(l),collapse="---"),"attributes"=paste(l,collapse="---"))
steps=rbind(steps,row)
i=i+1
}
}
}
#Update the steps
v$steps=rbind(v$steps,steps)
v$lastStep=stepID
#Update the modified version in the view
v$modified=g
#Change last modification date
op <- options(digits.secs = 6)
timestamp=Sys.time()
options(op)
v$lastmodified=timestamp
class(v)=unique(c("pathwayView",class(v)))
return(v)
}
#' Undo a modification step in a view
#'
#' @param v The input view
#' @param stps The number of steps to undo. This number referes to the number of unique steps' IDs to be removed, i.e. entries of steps in the view with similar stepID count as 1
#'
#' @return The view with the undone modifications
#' @export
#' @import mully
undo<-function(v,stps=1){
if(missing(v) || !is.pathwayView(v) || stps<0 || !is.double(stps) || stps%%1!=0)
stop("Invalid Argument")
if(v$lastStep==0){
stop("This View is empty")
}
if(stps==0){
print("No steps deleted")
return(v)
}
#tmp variables
g=v$modified
steps=v$steps
stepID=v$lastStep
countSteps=0
i=dim(steps)[1]
while (i>0){
stp=v$steps[i,]
if(stepID!=stp$stepID){
countSteps=countSteps+1
stepID=stp$stepID
}
if(countSteps==stps)
break
attributes=NA
if(!is.na(stp$attributes)){
attributesNames=unlist(strsplit(stp$attributesnames,"---"))
attributes=unlist(strsplit(stp$attributes,"---"))
names(attributes)=attributesNames
attributes=as.list(attributes)
}
if(stp$action=="add"){
if(stp$element=="layer"){
g=mully::removeLayer(g,stp$name,trans = F)
}
if(stp$element=="node"){
g=mully::removeNode(g,stp$name,trans = F)
}
if(stp$element=="edge"){
g=mully::removeEdge(g,stp$V1,stp$V2,attributes)
}
}
if(stp$action=="remove"){
if(stp$element=="layer"){
g=mully::addLayer(g,stp$name)
g$layers$ID[dim(g$layers)[1]]=as.integer(attributes$n)
g$iLayer=g$iLayer-1
g$layers=g$layers[order(g$layers$ID),]
rownames(g$layers)=c(1:dim(g$layers)[1])
}
if(stp$element=="node"){
layerID=as.integer(attributes$'n')
layerName=g$layers$Name[which(g$layers$ID==layerID)]
g=mully::addNode(g,stp$name,layerName,attributes[-1])
}
if(stp$element=="edge"){
g=mully::addEdge(g,stp$V1,stp$V2,attributes)
}
}
i=i-1
}
#Update view
#All steps removed
if(i==0)
stepID=0
v$lastStep=stepID
v$steps=v$steps[-which(v$steps$stepID>stepID),]
op <- options(digits.secs = 6)
timestamp=Sys.time()
options(op)
v$lastmodified=timestamp
v$modified=g
return(v)
}