Skip to content

Commit

Permalink
Replaced the validLHS()-based pattern with the tryCatch()-based pattern.
Browse files Browse the repository at this point in the history 
fixes #88
  • Loading branch information
@krivit
krivit committed Nov 14, 2024
1 parent 1b63f33 commit 05f2c93
Show file tree
Hide file tree
Showing 5 changed files with 22 additions and 125 deletions.
3 changes: 1 addition & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,12 +23,11 @@ Suggests:
Description: Tools to create and modify network objects. The network class can represent a range of relational data types, and supports arbitrary vertex/edge/graph attributes.
License: GPL (>=2)
URL: https://statnet.org/
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
Roxygen: list(markdown = TRUE)
Collate:
'access.R'
'as.edgelist.R'
'assignment.R'
'coercion.R'
'constructors.R'
'dataframe.R'
Expand Down
64 changes: 16 additions & 48 deletions R/access.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -146,19 +146,15 @@
add.edge<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...){
xn<-substitute(x)
UseMethod("add.edge")
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

#' @export add.edge.network
#' @export
add.edge.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...){
xn<-substitute(x)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
x<-.Call(addEdge_R,x,tail,head,names.eval,vals.eval,edge.check)
invisible(x)
}
Expand All @@ -170,9 +166,7 @@ add.edge.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.
add.edges<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...){
xn<-substitute(x)
UseMethod("add.edges")
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -204,9 +198,7 @@ add.edges.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...)
#Pass the inputs to the C side
xn<-substitute(x)
x<-.Call(addEdges_R,x,tail,head,names.eval,vals.eval,edge.check)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -281,9 +273,7 @@ add.edges.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...)
add.vertices<-function(x, nv, vattr=NULL, last.mode=TRUE, ...){
xn<-substitute(x)
UseMethod("add.vertices")
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand All @@ -306,9 +296,7 @@ add.vertices.network<-function(x, nv, vattr=NULL, last.mode=TRUE, ...){
#Perform the addition
xn<-substitute(x)
if(nv>0){
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
if(last.mode||(!is.bipartite(x))){
x<-.Call(addVertices_R,x,nv,vattr)
}else{
Expand Down Expand Up @@ -495,9 +483,7 @@ delete.edge.attribute.network <- function(x, attrname, ...) {
#Remove the edges
xn<-substitute(x)
x<-.Call(deleteEdgeAttribute_R,x,attrname)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -578,9 +564,7 @@ delete.edges.network <- function(x, eid, ...) {
stop("Illegal edge in delete.edges.\n")
#Remove the edges
x<-.Call(deleteEdges_R,x,eid)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
}
invisible(x)
}
Expand All @@ -599,9 +583,7 @@ delete.network.attribute.network <- function(x, attrname, ...){
#Remove the edges
xn<-substitute(x)
x<-.Call(deleteNetworkAttribute_R,x,attrname)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand All @@ -621,9 +603,7 @@ delete.vertex.attribute.network <- function(x, attrname, ...) {
if(network.size(x)>0){
xn<-substitute(x)
x<-.Call(deleteVertexAttribute_R,x,attrname)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
}
invisible(x)
}
Expand All @@ -650,9 +630,7 @@ delete.vertices.network <- function(x, vid, ...) {
set.network.attribute(x,"bipartite",m1v-sum(vid<=m1v))
}
x<-.Call(deleteVertices_R,x,vid)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
}
invisible(x)
}
Expand Down Expand Up @@ -1873,9 +1851,7 @@ permute.vertexIDs<-function(x,vids){
#Return the permuted graph
xn<-substitute(x)
x<-.Call(permuteVertexIDs_R,x,vids)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -1971,9 +1947,7 @@ set.edge.attribute.network <- function(x, attrname, value, e=seq_along(x$mel), .
#Do the deed, call the set multiple version
x<-.Call(setEdgeAttributes_R,x,attrname,value,e)
}
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
}
invisible(x)
}
Expand Down Expand Up @@ -2010,9 +1984,7 @@ set.edge.value.network <- function(x, attrname, value, e = seq_along(x$mel), ...
#Do the deed
xn<-substitute(x)
x<-.Call(setEdgeValue_R,x,attrname,value,e)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -2042,9 +2014,7 @@ set.network.attribute.network <- function(x, attrname, value, ...) {
#Do the deed
xn<-substitute(x)
x<-.Call(setNetworkAttribute_R,x,attrname,value)
if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}

Expand Down Expand Up @@ -2180,8 +2150,6 @@ set.vertex.attribute.network <- function(x, attrname, value, v = seq_len(network
} # end setting multiple values
#Do the deed

if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env
on.exit(eval.parent(call('<-',xn,x)))
}
on.exit(tryCatch(eval.parent(call('<-',xn,x)),error=identity))
invisible(x)
}
63 changes: 0 additions & 63 deletions R/assignment.R
View file

This file was deleted.

16 changes: 4 additions & 12 deletions R/constructors.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -203,9 +203,7 @@ network.bipartite<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){
add.edges(g, as.list(1+e%%n), as.list(1+e%/%n),
names.eval=en, vals.eval=ev, ...)
#Patch up g on exit for in-place modification
if(.validLHS(gn,parent.frame())){
on.exit(eval.parent(call('<-',gn,g)))
}
on.exit(tryCatch(eval.parent(call('<-',gn,g)),error=identity))
invisible(g)
}

Expand Down Expand Up @@ -276,9 +274,7 @@ network.adjacency<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){
add.edges(g, as.list(1+e%%n), as.list(1+e%/%n),
names.eval=en, vals.eval=ev, ...)
#Patch up g on exit for in-place modification
if(.validLHS(gn,parent.frame())){
on.exit(eval.parent(call('<-',gn,g)))
}
on.exit(tryCatch(eval.parent(call('<-',gn,g)),error=identity))
invisible(g)
}

Expand Down Expand Up @@ -342,9 +338,7 @@ network.edgelist<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){
g<-add.edges(g,as.list(x[,1]),as.list(x[,2]),edge.check=edge.check)
}
#Patch up g on exit for in-place modification
if(.validLHS(gn,parent.frame())){
on.exit(eval.parent(call('<-',gn,g)))
}
on.exit(tryCatch(eval.parent(call('<-',gn,g)),error=identity))
invisible(g)
}

Expand Down Expand Up @@ -398,9 +392,7 @@ network.incidence<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){
g<-add.edge(g,tail,head,names.eval=en,vals.eval=ev,edge.check=edge.check)
}
#Patch up g on exit for in-place modification
if(.validLHS(gn,parent.frame())){
on.exit(eval.parent(call('<-',gn,g)))
}
on.exit(tryCatch(eval.parent(call('<-',gn,g)),error=identity))
invisible(g)
}

Expand Down
1 change: 1 addition & 0 deletions man/network-internal.Rd
View file

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

0 comments on commit 05f2c93

Please sign in to comment.