tests/tea_tests.R

#  Part of the statnet package, http://statnetproject.org
#
#  This software is distributed under the GPL-3 license.  It is free,
#  open source, and has the attribution requirements (GPL Section 7) in
#    http://statnetproject.org/attribution
#
#  Copyright 2013 the statnet development team
######################################################################

require(networkDynamic)
require(testthat)
# -------------- activate.vertex.attribute----------------------

# gives error if argument not a network?
nd <-list()
expect_error(activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1),"requires that the first argument be a network")

nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","c",onset=2,terminus=3)
# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
    nd$val[[1]]$letters.active[[1]][[2]] == "b",
    nd$val[[1]]$letters.active[[1]][[3]] == "c",
    all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1, 1,2, 2,3),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure")
}
if(!all(nd$val[[2]]$letters.active[[1]][[1]] == "a",
        nd$val[[2]]$letters.active[[1]][[2]] == "b",
        nd$val[[2]]$letters.active[[1]][[3]] == "c",
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(0,1, 1,2, 2,3),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure")
}

# sets nD class on argument
if(!is.networkDynamic(nd)){
  stop("networkDynamic class was not set on network argument of activate.vertex.attribute")
}

# store and retreive attribute at specific times
if(!all(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1) == c("a","a","a","a","a"),
    get.vertex.attribute.active(nd,"letters",onset=2,terminus=5) == c("c","c","c","c","c"))){
  stop("unexpected values returned for time ranges by get.vertex.attribute.active")
}

# invisably returns argument
nd2 <- activate.vertex.attribute(nd,"letters","z",onset=-1,terminus=0)
if(!all(deparse(nd2)==deparse(nd))){
  stop("activate.vertex.attribute did not return modified network argument or it does not match argument modified in place")
}

# apply to subset of vertices
activate.vertex.attribute(nd,"letters","d",onset=3,terminus=4,v=1:2)
if(!all(get.vertex.attribute.active(nd,"letters",onset=3,terminus=4)[1:2] == c("d","d"),
    is.na(get.vertex.attribute.active(nd,"letters",onset=3,terminus=4)[3:5]))){
  stop("activate.vertex.attribute did not correctly activate the assigned subset of vertex attributes")
}

# maintain spell order when added out of order?
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","b",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","c",onset=2,terminus=3)
if (!all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1, 1,2, 2,3),ncol=2,byrow=TRUE))){
  stop("activate.vertex.attribute did not correctly maintain attribute spell ordering when added in non-temporal order")
}

# merge spells when same attribute added in adjoining spell
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","a",onset=1,terminus=2)
if (!all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,2),ncol=2,byrow=TRUE))){
  stop("activate.vertex.attribute did not correctly merge adjoining attribute spells")
}

# overwrite existing spell
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=3)
if (!all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,3),ncol=2,byrow=TRUE))){
  stop("activate.vertex.attribute did not correctly overwrite attribute spells")
}


# store multiple object types
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters",5,onset=1,terminus=2)
activate.vertex.attribute(nd,"letters",NULL,onset=2,terminus=3)
activate.vertex.attribute(nd,"letters",list(list(hello="world")),onset=3,terminus=4)
if (!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
         nd$val[[1]]$letters.active[[1]][[2]] == 5,
         nd$val[[1]]$letters.active[[1]][[3]] == NULL,
         nd$val[[1]]$letters.active[[1]][[4]]$hello == "world")){
  stop("activate.vertex.attribute did not correctly store attributes of different types")
}

# replace existing attribute with TEA
nd <-network.initialize(5)
set.vertex.attribute(nd,"letters","a")
activate.vertex.attribute(nd,"letters","b",onset=0,terminus=2)
if("letters"%in%list.vertex.attributes(nd) | !"letters.active"%in%list.vertex.attributes(nd)){
  stop("activate.vertex.attribute did not replace non-active attribute with same name")
}

# don't replace existing attribute with TEA if dynamic.only=TRUE
nd <-network.initialize(5)
set.vertex.attribute(nd,"letters","a")
activate.vertex.attribute(nd,"letters","b",onset=0,terminus=2,dynamic.only=TRUE)
if(!"letters"%in%list.vertex.attributes(nd) | !"letters.active"%in%list.vertex.attributes(nd)){
  stop("activate.vertex.attribute should not have removed non-active attribute with same name")
}

# test at syntax
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",at=1)
if(!all(nd$val[[2]]$letters.active[[1]][[1]] == "a",
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(1,1),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure using 'at' parameter")
}

# test onset and length syntax
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=1,length=5.5)
if(!all(nd$val[[2]]$letters.active[[1]][[1]] == "a",
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(1,6.5),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure using 'onset' nad 'length' parameters")
}

# test terminus and length syntax
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",terminus=7,length=5.5)
if(!all(nd$val[[2]]$letters.active[[1]][[1]] == "a",
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(1.5,7),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure using 'onset' nad 'length' parameters")
}


# test no time params
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a")
if(!all(nd$val[[2]]$letters.active[[1]][[1]] == "a",
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(-Inf,Inf),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected structure using no time prams")
}


# test assigning multiple values
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters",c("a","b","c","d","e"))
if(!all(get.vertex.attribute.active(nd,"letters",onset=1,terminus=1)==c("a","b","c","d","e"))){
  stop("activate.vertex.attribute did not correctly assign multiple values to multiple vertices")
}


# test assigning multiple times
nd <-network.initialize(5)
activate.vertex.attribute(nd,"letters","a",at=c(1,2,3,4,5))
if(!all(all(nd$val[[1]]$letters.active[[2]] == matrix(c(1,1),ncol=2,byrow=TRUE)),
        all(nd$val[[2]]$letters.active[[2]] == matrix(c(2,2),ncol=2,byrow=TRUE)),
        all(nd$val[[3]]$letters.active[[2]] == matrix(c(3,3),ncol=2,byrow=TRUE)),
        all(nd$val[[4]]$letters.active[[2]] == matrix(c(4,4),ncol=2,byrow=TRUE)),
        all(nd$val[[5]]$letters.active[[2]] == matrix(c(5,5),ncol=2,byrow=TRUE)))){
  stop("activate.vertex.attribute did not create activity attribute with expected values using multiple input times")
}

# test assigning complex objects (lists)
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',list(list("a","b")),onset=0,terminus=1)
if(!all(nd$val[[2]]$letters.active[[1]][[1]][[1]]=="a",nd$val[[2]]$letters.active[[1]][[1]][[2]]=="b")){
  stop("activate.vertex.attribute did not store list object in expected form")
}

activate.vertex.attribute(nd,'letters',list(list("c","d")),onset=1,terminus=2)
if(!all(nd$val[[2]]$letters.active[[1]][[2]][[1]]=="c",nd$val[[2]]$letters.active[[1]][[2]][[2]]=="d")){
  stop("activate.vertex.attribute did not store list object in expected form")
}


# test passing in zero-length list of vertices returns net unmodified
nd <-network.initialize(5)
nd2 <-activate.vertex.attribute(nd,'letters',list(list("a","b")),onset=0,terminus=1,v=numeric(0))
if (!all(deparse(nd)==deparse(nd2))){
  stop("activate.vertex.attribute did not return network argument unchanged when v is length 0")
}

activate.vertex.attribute(network.initialize(0),"foo",at=2)

# ----- get.vertex.attribute.active ----------------

# return appropriate value for structure (allready tested above)
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1)
activate.vertex.attribute(nd,'letters',"b",onset=1,terminus=2)

if (!all(get.vertex.attribute.active(nd,'letters',onset=0,terminus=1)==rep("a",5),
get.vertex.attribute.active(nd,'letters',onset=1,terminus=2)==rep("b",5))){
  stop("get.vertex.attribute.active did not return expected values for simple spell queries")
}

# test query that will return multiple values (should throw warning)
expect_that(get.vertex.attribute.active(nd,'letters',onset=0,terminus=3),gives_warning("Multiple attribute values matched query spell for attribute"
  ))


         
# test unlist and structure
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1) 
result<-get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,unlist=FALSE)         
if (class(result[[1]])=="list"){
  stop("get.vertex.attribute.active returned values with unexpected list nesting when unlist=FALSE")
}




# test at param
if (!all(get.vertex.attribute.active(nd,'letters',at=0)==rep("a",5))){
     stop("get.vertex.attribute.active did not return expected values for at query")
}
         
# test length param
if (!all(get.vertex.attribute.active(nd,'letters',onset=0,length=1)==rep("a",5))){
 stop("get.vertex.attribute.active did not return expected values for length query")
}


# test storing a list object
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',list(list("a","b")),onset=0,terminus=1) 
if (!all(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,unlist=FALSE)[[3]][[1]]=="a",
         get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,unlist=FALSE)[[3]][[2]]=="b")){
  stop("get.vertex.attribute.active did not return stored list object correctly")
}

# find non-active version if active not found
nd <-network.initialize(5)
set.vertex.attribute(nd,"letters","a")
if(!all(get.vertex.attribute.active(nd,"letters",onset=1,terminus=2) == rep("a",5))){
  stop("get.vertex.attribute did not correctly return non-TEA attribute when TEA attribute not found")
}
         
 # don't find non-active version if dynamic.only = TRUE
if (!all(is.na(get.vertex.attribute.active(nd,"letters",onset=1,terminus=2,dynamic.only=TRUE)))){
  stop("get.vertex.attribute failed to return NA instead of matching non-TEA attribute when dynamic.only=TRUE")
}

# return NAs when no attributes match
nd <-network.initialize(5)
if(!all(is.na(get.vertex.attribute.active(nd,"letters",onset=1,terminus=2)))){
  stop("get.vertex.attribute did not return NAs when no attribute found matching name")
}

# test return teas should return truncated spell lists
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1)
activate.vertex.attribute(nd,'letters',"b",onset=1,terminus=2)
activate.vertex.attribute(nd,'letters',"c",onset=2,terminus=3)
result <-get.vertex.attribute.active(nd,'letters',onset=1,terminus=2,return.tea=TRUE)
if(!all(result[[1]][[1]]=="b",result[[1]][[2]]==c(1,2),result[[5]][[1]]=="b",result[[5]][[2]]==c(1,2))){
  stop("get.vertex.attribute.active did not return expected list structures when return.tea=TRUE")
}

# test if some vertices have activity and not others
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1,v=c(1,2,4,5))
if(!all(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1)[c(1,2,4,5)]=="a",is.na(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1)[3]))){
  stop("get.vertex.attribute.active did not return NA for vertices missing the active attribute")
}

# test require.active argument
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1)
deactivate.vertices(nd,v=2:3)
result <-get.vertex.attribute.active(nd,'letters',onset=0,terminus=1,require.active=TRUE)  
if(!all(result[c(1,4,5)]=="a",is.na(result[2:3]))){
  stop("get.vertex.attribute.active did not return NA for attributes of inactive vertices when require.active=TRUE")
}

# this was crashing at one point
get.vertex.attribute.active(network.initialize(3),"test",at=1,require.active=TRUE)
         
# test active.default argument
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1)
activate.vertices(nd,v=2:3)
result <-get.vertex.attribute.active(nd,'letters',onset=0,terminus=1,require.active=TRUE,active.default=FALSE)  
if(!all(result[2:3]=="a",is.na(result[c(1,4,5)]))){
   stop("get.vertex.attribute.active did not return NA for attributes of vertices considered inactive when require.active=TRUE and active.default=FALSE")
}     

         
# test na.omit argument
nd <-network.initialize(5)
set.vertex.attribute(nd,'na',TRUE,v=3)
activate.vertex.attribute(nd,"letters",c("a","b","c","d","e"),onset=0,terminus=1)
if(!all(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,na.omit=TRUE)==c("a","b","d","e"))){
  warning("get.vertex.attribute.active did not correctly omit values for missing vertex when na.omit=TRUE")
}
#NOTE: it does the na.omit ok, but is returning attributes in wrong index positions think it is a feature issue in network ticket #174

# test when all vertices NA (was giving error)
nd <-network.initialize(5)
set.vertex.attribute(nd,'na',TRUE)
activate.vertex.attribute(nd,"letters",c("a","b","c","d","e"),onset=0,terminus=1)
expect_true(is.null(get.vertex.attribute.active(nd,"letters",at=0,na.omit=TRUE)),info="check when all vertices are NA")

# test null.na argument
nd <-network.initialize(3)
if(!all(is.na(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,null.na=TRUE)))){
  stop("get.vertex.attribute.active did not return NA instead of NULL when null.na=TRUE")
}
expect_true(all(sapply(get.vertex.attribute.active(nd,"letters",onset=0,terminus=1,null.na=FALSE,unlist=FALSE),is.null)),info="test null.na=FALSE returns null")

# test rule (any vs all) argument
nd <-network.initialize(5)
activate.vertex.attribute(nd,'letters',"a",onset=0,terminus=1)
if (!all(is.na(get.vertex.attribute.active(nd,'letters',onset=-1,terminus=2,rule="all")))){
  stop("get.vertex.attribute.active did not return expected values when rule='all'")
}
     
         
# test multiple onsets
nd<-network.initialize(3)
activate.vertex.attribute(nd,'letters',c("a","b","c"),onset=c(0,1,2),terminus=c(1,2,3))
expect_equal(get.vertex.attribute.active(nd,'letters',at=0),c("a",NA,NA),info="test multiple onsets")
expect_equal(get.vertex.attribute.active(nd,'letters',at=1),c(NA,"b",NA),info="test multiple onsets")
expect_equal(get.vertex.attribute.active(nd,'letters',at=2),c(NA,NA,"c"),info="test multiple onsets")

expect_true(is.null(get.vertex.attribute.active(network.initialize(0),'foo',at=1)))

# -------------------- activate.edge.attribute ---------------------
# gives error if argument not a network?
nd <-list()
expect_error(activate.edge.attribute(nd,"letters","a",onset=0,terminus=1),"activate.edge.attribute requires that the first argument be a network")


# activate attribute on non existant edge should throw error
nd <- network.initialize(5)
add.edge(nd,1,2)
result <-try(activate.edge.attribute(nd,"letters","a",onset=0,terminus=1,e=2),T)
if (!"try-error"%in%class(result)){
  stop("activate.edge.attribute did not throw error when bad edge specified")
}

nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=2)
activate.edge.attribute(nd,"letters","c",onset=2,terminus=3)
# was the expected structure created?
if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[1]]$atl$letters.active[[1]][[2]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[3]] == "c",
        all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1, 1,2, 2,3),ncol=2,byrow=TRUE)))){
  stop("activate.edge.attribute did not create activity attribute with expected structure")
}

# sets nD class on argument
if(!is.networkDynamic(nd)){
  stop("networkDynamic class was not set on network argument of activate.edge.attribute")
}

# store and retreive attribute at specific times
if(!all(get.edge.value.active(nd,"letters",onset=0,terminus=1) == c("a","a","a"),
        get.edge.value.active(nd,"letters",onset=2,terminus=5) == c("c","c","c"))){
  stop("unexpected values returned for time ranges by get.edge.value.active")
}

if(length(get.edge.value.active(nd,"letters",onset=0,terminus=1)) != network.edgecount(nd)){
  warning("number of values returned by get.edge.value.active does not match number of edges")
}

# invisably returns argument
nd2 <- activate.edge.attribute(nd,"letters","z",onset=-1,terminus=0)
if(!all(deparse(nd2)==deparse(nd))){
  stop("activate.edge.attribute did not return modified network argument or it does not match argument modified in place")
}

# test bug #523 where edge values getting incorrectly permuted when using e argument

test<-network.initialize(3)
add.edges.active(test,tail=1,head=2,onset=0,terminus=1)
add.edges.active(test,tail=2,head=3,onset=2,terminus=3)
activate.edge.attribute(test,'letter','a',onset=0,terminus=1,e=1)
activate.edge.attribute(test,'letter','b',onset=2,terminus=3,e=2)
expect_equal(get.edge.attribute.active(test,'letter',at=0),c("a",NA)) # this was returning c("a","a")


# test setting multiple spells on a single element with one call
test<-network.initialize(3)
test[1,2]<-1
activate.edge.attribute(test,'letter',c('a','b','c'),onset=c(0,2,4),terminus=c(1,3,5),e=c(1,1,1))
#expect_equal(test$mel[[1]]$atl$letter.active[[1]],list('a','b','c'))

# what if an edge is null because it was deleted

# apply to subset of edge
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","d",onset=3,terminus=4,e=1:2)
if(!all(get.edge.value.active(nd,"letters",onset=3,terminus=4)[1:2] == c("d","d"), is.na(get.edge.value.active(nd,"letters",onset=3,terminus=4)[3]))){
  stop("activate.edge.attribute did not correctly activate the assigned subset of vertex attributes")
}

# maintain spell order when added out of order?
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=2)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","c",onset=2,terminus=3)
if (!all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1, 1,2, 2,3),ncol=2,byrow=TRUE))){
  stop("activate.vertex.attribute did not correctly maintain attribute spell ordering when added in non-temporal order")
}


# error if onset > terminus?
result <- try(activate.vertex.attribute(nd,"letters","z",onset=6,terminus=5),T)
if (!"try-error"%in%class(result)){
  stop("activate.edge.attribute did not throw error when onset > terminus")
}

# convert existing attribute to TEA

# test at syntax

# test length syntax

expect_warning(activate.edge.attribute(network.initialize(0),"foo","bar"),'network does not contain any edges')

# test for network.edgecount vs. seq_along(x$mel)
nd<-add.edges(network.initialize(3),tail=1:3,head=c(2,3,1))
delete.edges(nd,e=2)
activate.edge.attribute(nd,'test',as.list(c("a","b","c")),onset=1,terminus=2)

expect_equal(get.edge.attribute.active(nd,'test',at=1),c("a",NA,"c"),info='check for edgecount vs seq_along mel bug')


# ------- activate.edge.value ----------------------------

# try adding with single value
nd<-add.edges(network.initialize(3),tail=1:3,head=c(2,3,1))
activate.edge.value(nd,'test',value=5,onset=1,terminus=2)
expect_equal(get.edge.attribute.active(nd,'test',onset=1,terminus=2),c(5,5,5),info='test activate.edge.value with single value')

# try with matrix
emat<-matrix(0,ncol=3,nrow=3)
emat[1,2]<-"a"
emat[2,3]<-"b"
emat[3,1]<-"c"
nd<-add.edges(network.initialize(3),tail=1:3,head=c(2,3,1))
activate.edge.value(nd,'test',value=emat,onset=1,terminus=2)
expect_equal(get.edge.attribute.active(nd,'test',onset=1,terminus=2),c("a","b","c"),info='test activate.edge.value with basic matrix')

# try with e subset
nd<-add.edges(network.initialize(3),tail=1:3,head=c(2,3,1))
activate.edge.value(nd,'test',value=emat,onset=1,terminus=2,e=2)
expect_equal(get.edge.attribute.active(nd,'test',onset=1,terminus=2),c(NA,"b",NA),info='test activate.edge.value with basic matrix and e subset')

# try with a deleted edge
emat<-matrix(0,ncol=3,nrow=3)
emat[1,2]<-"a"
emat[2,3]<-"b"
emat[3,1]<-"c"
nd<-add.edges(network.initialize(3),tail=1:3,head=c(2,3,1))
delete.edges(nd,e=2)
activate.edge.value(nd,'test',value=emat,onset=1,terminus=2)
expect_equal(get.edge.attribute.active(nd,'test',onset=1,terminus=2),c("a",NA,"c"),info='test activate.edge.value with basic matrix and missing edge')

# -------- get.edge.attribute.active-----
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","d",onset=3,terminus=4,e=1:2)
vals <-get.edge.attribute.active(nd,'letters',onset=3,terminus=4,unlist=FALSE)
expect_true(all(vals[[1]]=="d",vals[[2]]=="d",is.na(vals[[3]])),info='checking get.edge.attribute.active')

expect_error(get.edge.attribute.active(nd$mel,'letters'),'must be a network object')

# ----------------- get.edge.value.active ---------------

# return values when only subset of edges have activated attributes
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","d",onset=3,terminus=4,e=1:2)
vals <-get.edge.value.active(nd,'letters',onset=3,terminus=4,unlist=FALSE)
if (!all(vals[[1]]=="d",vals[[2]]=="d",is.na(vals[[3]]))){
  stop("get.edge.value.active returned unexpected values when some edges did not have activity attribute set")
}

# test return.tea = TRUE
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=2)
activate.edge.attribute(nd,"letters","c",onset=2,terminus=3)
if(!all(get.edge.value.active(nd,"letters",onset=1,terminus=2,return.tea=TRUE)[[3]][[1]][[1]]=="b",get.edge.value.active(nd,"letters",onset=1,terminus=2,return.tea=TRUE)[[3]][[2]]==c(1,2))){
  stop("get.edge.value.active did not return expected structure when return.tea=TRUE")
}
# test query spell includes multiple values
expect_that(
if(!all(get.edge.value.active(nd,"letters",onset=0,terminus=3)=="a")){
  stop("get.edge.value.active did not return earliest values when query spell matched multiple")
}, gives_warning("Multiple attribute values matched query spell"))

if(!all(get.edge.value.active(nd,"letters",onset=0,terminus=3,return.tea=TRUE)[[3]][[2]]== matrix(c(0,1, 1,2, 2,3), ncol=2,byrow=TRUE),
        get.edge.value.active(nd,"letters",onset=0,terminus=3,return.tea=TRUE)[[3]][[1]][[1]]=="a",
        get.edge.value.active(nd,"letters",onset=0,terminus=3,return.tea=TRUE)[[3]][[1]][[2]]=="b",
        get.edge.value.active(nd,"letters",onset=0,terminus=3,return.tea=TRUE)[[3]][[1]][[3]]=="c")){
  stop("get.edge.value.active did not return multiple values when query spell matched multiple and return.tea=TRUE")
}


# test unlist

# test not return value if edge not active and require.active = TRUE
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
activate.edges(nd,e=1,onset=0,terminus=2)
deactivate.edges(nd,e=2,onset=0,terminus=2)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
if(!all(get.edge.value.active(nd,"letters",onset=0,terminus=1,require.active=TRUE)[1]=="a",is.na(get.edge.value.active(nd,"letters",onset=0,terminus=1,require.active=TRUE)[2]))){
  stop("get.edge.value.active did not return expected values for inactive edge when require.active=TRUE")
}

# test deleted edge
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters",list("a","b","c"),onset=0,terminus=1)
delete.edges(nd,eid=2)
if (!all(get.edge.value.active(nd,"letters",onset=0,terminus=1)[c(1,3)]==c("a","c"),
         is.na(get.edge.value.active(nd,"letters",onset=0,terminus=1)[2]))){
  stop('get.edge.value.active did not return expected values when edge was deleted')
}
         
# find non-active version if active not found

nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
set.edge.attribute(nd,"letters",list("a","b","c"))
if(!all(get.edge.value.active(nd,"letters",onset=1,terminus=2) == c("a","b","c"))){
  stop("get.vertex.attribute did not correctly return non-TEA attribute")
}

# don't find non-active version if dynamic.only = TRUE
if (!all(is.na(get.edge.value.active(nd,"letters",onset=1,terminus=2,dynamic.only=TRUE)))){
  stop("get.vertex.attribute failed to return NA instead of matching non-TEA attribute when dynamic.only=TRUE")
}

# return NAs if no matching attribute
nd <-network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
get.edge.value.active(nd,"letters",onset=1,terminus=2,unlist=FALSE)

# what if network has no edges?
nd <-network.initialize(5)
expect_that(activate.edge.attribute(nd,"letters","a",onset=0,terminus=1),gives_warning("network does not contain any edges"))

expect_true(is.null(get.edge.value.active(network.initialize(0),"foo",at=0)))

# --------- activate.network.attribute ------------------------
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=2)

# expected structure?
if(!all(nd$gal$test.active[[1]][[1]]=="a",nd$gal$test.active[[2]]==c(1,2))){
  stop("activate.network.attribute did not store attribute and activity spell in expected structure")
}

activate.network.attribute(nd,"test","b",onset=2,terminus=3)
if(!all(nd$gal$test.active[[1]][[2]]=="b",nd$gal$test.active[[2]][2,]==c(2,3))){
  stop("activate.network.attribute did not store attribute and activity spell in expected structure")
}

# got nd class?
if(!is.networkDynamic(nd)){
  stop("activate.network.attribute did not set networkDynamic class")
}

#store list
activate.network.attribute(nd,"test",list("c","d"),onset=3,terminus=4)
if(!all(unlist(nd$gal$test.active[[1]][[3]])==c("c","d"),nd$gal$test.active[[2]][3,]==c(3,4))){
  stop("activate.network.attribute did not store attribute and activity spell in expected structure")
}

# test length
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,length=2)
if(!all(nd$gal$test.active[[1]][[1]]=="a",nd$gal$test.active[[2]]==c(1,3))){
  stop("activate.network.attribute did not store attribute and activity spell in expected structure when using 'length' param")
}


# test at
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",at=2)
if(!all(nd$gal$test.active[[1]][[1]]=="a",nd$gal$test.active[[2]]==c(2,2))){
  stop("activate.network.attribute did not store attribute and activity spell in expected structure when using 'at' param")
}

# test dynamic only 
nd <-network.initialize(5)
set.network.attribute(nd,"test","a")
activate.network.attribute(nd,"test","b",onset=1,terminus=2)
if ("test"%in%list.network.attributes(nd)){
  stop("same-named non-active attribute was not replaced by activate.network.attribute ")
}

# test dynamic.only = TRUE
nd <-network.initialize(5)
set.network.attribute(nd,"test","a")
activate.network.attribute(nd,"test","b",onset=1,terminus=2,dynamic.only=TRUE)
if (!"test"%in%list.network.attributes(nd)){
  stop("same-named non-active attribute was wrongly replaced by activate.network.attribute when dynamic.only=TRUE")
}

activate.network.attribute(network.initialize(0),"foo","bar")

# ---- get.network.attribute.active --------------
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=2)



# expected structure?
if(!get.network.attribute.active(nd,"test",onset=1,terminus=1)=="a"){
  stop("get.network.attribute.active did not return expected attribute value")
}

activate.network.attribute(nd,"test","b",onset=2,terminus=3)
if(!get.network.attribute.active(nd,"test",onset=2,terminus=3)=="b"){
  stop("get.network.attribute.active did not return expected attribute value")
}


#store list
activate.network.attribute(nd,"test",list("c","d"),onset=3,terminus=4)
if(!all(unlist(get.network.attribute.active(nd,"test",onset=3,terminus=4))==c("c","d"))){
  stop("get.network.attribute.active did not return expected attribute value")
}

# return multiple values with warning
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=2)
activate.network.attribute(nd,"test","b",onset=2,terminus=3)
activate.network.attribute(nd,"test","c",onset=3,terminus=4)
expect_that(
if(!get.network.attribute.active(nd,"test",onset=2,terminus=4)=="b"){
  stop("get.network.attribute.active did not return appropriate value when multiple attributes matched query spell")
}
, gives_warning("Multiple attribute values matched query spell"))


# return appropriate value for return.tea = T
returned <-get.network.attribute.active(nd,"test",onset=2,terminus=4,return.tea=TRUE)
if(!all(returned[[1]][[1]]=="b",returned[[1]][[2]]=="c",returned[[2]][1,]==c(2,3),returned[[2]][2,]==c(3,4))){
  stop("get.network.attribute.active did not return appropriate value when multiple attributes matched query spell")
}


# test dynamic only fall through
nd <-network.initialize(5)
set.network.attribute(nd,"test","a")
if (!get.network.attribute.active(nd,"test",onset=2,terminus=4)=="a"){
  stop("get.network.attribute.active did not return non-dynamic attribute when TEA not found")
}

# test dynamic only not fall through
if (!is.null(get.network.attribute.active(nd,"test",onset=2,terminus=4,dynamic.only=TRUE))){
  stop("get.network.attribute.active did not return NULL instead non-dynamic attribute when TEA not found and dynamic.only=TRUE")
}

# test unlist
nd <-network.initialize(5)
activate.network.attribute(nd,"test",list("a","b"),onset=1,terminus=2)
if(!all(get.network.attribute.active(nd,"test",onset=1,terminus=2)==c("a","b"))){
  stop("get.network.attribute.active did not unlist returned attribute correctly")
}
                           
if(!all(is.list(get.network.attribute.active(nd,"test",onset=1,terminus=2,unlist=FALSE)),get.network.attribute.active(nd,"test",onset=1,terminus=2,unlist=FALSE)[[1]]=="a",get.network.attribute.active(nd,"test",onset=1,terminus=2,unlist=FALSE)[[2]]=="b")){
  stop("get.network.attribute.active did not return attribute correctly in list when unlist=FALSE")
}      

# test at
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=2)
activate.network.attribute(nd,"test","b",onset=2,terminus=3)
activate.network.attribute(nd,"test","c",onset=5,terminus=6)

if(get.network.attribute.active(nd,"test",at=2)!="b"){
  stop("get.network.attribute.active did not return expected value when using 'at' parameter")
}

# test length
if(get.network.attribute.active(nd,"test",onset=0,length=1.5)!="a"){
  stop("get.network.attribute.active did not return expected value when using 'length' parameter")
}

# test rule

if(!is.na(get.network.attribute.active(nd,"test",onset=2,terminus=4,rule="all"))){
  stop("get.network.attribute.active did not return expected value when using rule='all' parameter")
}
if(get.network.attribute.active(nd,"test",onset=2,terminus=4,rule="any")!="b"){
  stop("get.network.attribute.active did not return expected value when using rule='any' parameter")
}

# test out of range
nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=2)
if(!is.na(get.network.attribute.active(nd,"test",onset=3,terminus=4))){
  stop("get.network.attribute.active did not return NA when query spell did not match any attributes")
}

##########################################################################
# ------list.vertex.attributes.active ----
######################################################################################
nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=3)
activate.vertex.attribute(nd,"letters","b",onset=4,terminus=5)
activate.vertex.attribute(nd,"letters","a",onset=5,terminus=7)
activate.vertex.attribute(nd,"numbers","1",onset=2,terminus=3)
activate.vertex.attribute(nd,"numbers","2",onset=4,terminus=8)
activate.vertex.attribute(nd,"numbers","3",onset=8,terminus=10)
if(!all(list.vertex.attributes.active(nd,onset=-Inf,terminus=Inf)==c("na","vertex.names","letters.active","numbers.active"))){
  stop("list.vertex.attributes.active did not return expected values")
}

if(!all(list.vertex.attributes.active(nd,onset=-Inf,terminus=Inf,dynamic.only=TRUE)==c("letters.active","numbers.active"))){
  stop("list.vertex.attributes.active did not return expected values when dynamic.only=TRUE")
}

# give error if not called with nD object

expect_error(list.vertex.attributes.active(list()),"requires that the first argument be a network")

net<-network.initialize(3)
activate.vertices(net,onset=1,terminus=2)
# if no dynamic attributes, should just return static ones
expect_equal(list.vertex.attributes.active(net,onset=-Inf, terminus=Inf),list.vertex.attributes(net))

expect_true(is.null(list.vertex.attributes.active(network.initialize(0))))


##########################################################################
##########################################################################
#----- list.edge.attriubtes.active----
######################################################################################



nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=3)
activate.edge.attribute(nd,"letters","b",onset=4,terminus=5)
activate.edge.attribute(nd,"letters","a",onset=5,terminus=7)
activate.edge.attribute(nd,"numbers","1",onset=2,terminus=3)
activate.edge.attribute(nd,"numbers","2",onset=4,terminus=8)
activate.edge.attribute(nd,"numbers","3",onset=8,terminus=10)

if(!all(list.edge.attributes.active(nd,onset=-Inf,terminus=Inf)==c('na','letters.active','numbers.active'))){
  stop("list.edge.attributes.active returned unexpected values")
}

# test dynamic only
if(!all(list.edge.attributes.active(nd,onset=-Inf,terminus=Inf,dynamic.only=TRUE)==c('letters.active','numbers.active'))){
  stop("list.edge.attributes.active returned unexpected values when dynamic.only=TRUE")
}

# test time range
if(!all(list.edge.attributes.active(nd,onset=8,terminus=10)==c('na','numbers.active'))){
  stop("list.edge.attributes.active returned unexpected values")
}

# check if called on network with no edges
# this hits a bug in network
# https://statnet.csde.washington.edu/trac/ticket/181
net <- network.initialize(2)
list.edge.attributes.active(net,onset=-Inf,terminus=Inf)

# check if called on network with no active attributes
add.edges.active(net,tail=1,head=2,onset=1,terminus=2)
expect_equal(list.edge.attributes.active(net,onset=-Inf,terminus=Inf),list.edge.attributes(net))

expect_equal(list.edge.attributes.active(network.initialize(0),at=1),character(0))


##########################################################################
##########################################################################
# ------list.network.attributes.active-------
######################################################################################

nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=4)
if(!all(list.network.attributes.active(nd,onset=-Inf,terminus=Inf) ==c("bipartite","directed","hyper"     ,"loops","mnext","multiple","n","test.active"))){
  stop("list.network.attributes.active did not return expected results")
}

# check at param (was giving error)
list.network.attributes.active(net,at=2)

# outside of range
if(!all(list.network.attributes.active(nd,onset=-Inf,terminus=0) ==c("bipartite","directed","hyper"     ,"loops","mnext","multiple","n"))){
  stop("list.network.attributes.active did not return expected results for query that should miss attributes")
}

# dynamic only
if(!all(list.network.attributes.active(nd,onset=-Inf,terminus=Inf,dynamic.only=TRUE) =="test.active")){
  stop("list.network.attributes.active did not return expected results for dynamic.only=TRUE")
}

# also add a more complex attribute
nd <-network.initialize(5)
activate.network.attribute(nd,"test",c("a","b"),onset=1,terminus=4)
if(list.network.attributes.active(nd,onset=-Inf,terminus=Inf,dynamic.only=TRUE)!="test.active"){
  stop("list.network.attributes.active did not return expect results for vector attributes")
}

# check its ok if called with network 
net <-network.initialize(2)
expect_equal(list.network.attributes(net),list.network.attributes.active(net,onset=-Inf,terminus=Inf))

# should return regular 7 network attributes
expect_equal(length(list.network.attributes.active(network.initialize(0),at=0)),7)

#deactivate.vertex.attribute
####################################################################################################################################################
#testing if deactivating a spell with one value, leaving rest spell active
##########################################################################
nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","c",onset=2,terminus=3)
deactivate.vertex.attribute(nd,prefix="letters",onset=1,terminus=2)

# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
        nd$val[[1]]$letters.active[[1]][[2]] == "c",
        all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1, 2,3),ncol=2,byrow=TRUE)))){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}




nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","c",onset=2,terminus=3)
deactivate.vertex.attribute(nd,prefix="letters",onset=-Inf,terminus=Inf)

# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]]=="NA",
        nd$val[[1]]$letters.active[[2]]==matrix(c(Inf,Inf),ncol=2)
)){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}





##########################################################################
#testing if the deactivating period across two spells
##########################################################################

nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=2)
activate.vertex.attribute(nd,"letters","b",onset=3,terminus=5)
activate.vertex.attribute(nd,"letters","c",onset=5,terminus=7)
deactivate.vertex.attribute(nd,prefix="letters",onset=1,terminus=4)

# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
        nd$val[[1]]$letters.active[[1]][[2]] == "b",
        nd$val[[1]]$letters.active[[1]][[3]] == "c",
        all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1, 4,5, 5,7),ncol=2,byrow=TRUE)))){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}

##########################################################################
#testing if the deactivating period within one spell, and keep the spell time order
##########################################################################

nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=2,terminus=5)
activate.vertex.attribute(nd,"letters","c",onset=5,terminus=7)
deactivate.vertex.attribute(nd,prefix="letters",onset=3,terminus=4)

# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
        nd$val[[1]]$letters.active[[1]][[2]] == "b",
        nd$val[[1]]$letters.active[[1]][[3]] == "b",
        nd$val[[1]]$letters.active[[1]][[4]] == "c",
        all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1,2,3,4,5,5,7),ncol=2,byrow=TRUE)))){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}

##########################################################################
#testing if the deactivating the non-activate period
##########################################################################

nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=4,terminus=5)
activate.vertex.attribute(nd,"letters","c",onset=5,terminus=7)
deactivate.vertex.attribute(nd,prefix="letters",onset=2,terminus=3)

# was the expected structure created?
if(!all(nd$val[[1]]$letters.active[[1]][[1]] == "a",
        nd$val[[1]]$letters.active[[1]][[2]] == "b",
        nd$val[[1]]$letters.active[[1]][[3]] == "c",
        all(nd$val[[1]]$letters.active[[2]] == matrix(c(0,1,4,5,5,7),ncol=2,byrow=TRUE)))){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}

deactivate.vertex.attribute(network.initialize(0),'foo')


##########################################################################
#04/01, testing if the deactivating the non-activate vertex
##########################################################################

#initialize network
test<-network.initialize(5)
#activate vertex attribute
test<-activate.vertex.attribute(test,"letter","a",onset=0,terminus=3,v=1:4)

# #deactive vertex attribute
# expect_warning(deactivate.vertex.attribute(test, "letter", onset=0, terminus=3),"intend to deactivate attribute on inactivate vertex")# need to fix this
# 
test <- deactivate.vertex.attribute(test, "letter", onset=0, terminus=3)

if(length(list.vertex.attributes.active(test, onset=0,terminus=3,dynamic.only=T))!=0)
  stop("error with deactivating the non-activate vertex")


##########################################################################
#04/04, testing if the deactivating single/two vertex attributes
##########################################################################


nd <- network.initialize(5)
activate.vertex.attribute(nd,"letters","a",onset=0,terminus=1)
activate.vertex.attribute(nd,"letters","b",onset=1,terminus=2)
activate.vertex.attribute(nd,"letters","c",onset=2,terminus=3)
deactivate.vertex.attribute(nd,prefix="letters",onset=-Inf,terminus=Inf,v=c(5,2))

# get.vertex.attribute.active(nd,"letters",onset=0,terminus=3)
# Warning message:
#   In get.vertex.attribute.active(nd, "letters", onset = 0, terminus = 3) :
#   Multiple attribute values matched query spell for attribute letters.active on some vertices. Only earliest value used

# was the expected structure created?
if(!all(nd$val[[2]]$letters.active[[1]][[1]]=="NA",
        nd$val[[2]]$letters.active[[2]]==matrix(c(Inf,Inf),ncol=2)
)){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}


if(!all(nd$val[[5]]$letters.active[[1]][[1]]=="NA",
        nd$val[[5]]$letters.active[[2]]==matrix(c(Inf,Inf),ncol=2)
)){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}





##########################################################################
##########################################################################
# ------ deactivate.edge.attribute
##########################################################################
#testing if deactivating a spell with one value, leaving rest spell active
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=2)
activate.edge.attribute(nd,"letters","c",onset=2,terminus=3)

deactivate.edge.attribute(x=nd, prefix="letters", onset=1, terminus=2)

if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[1]]$atl$letters.active[[1]][[2]] == "c",
        all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1,2,3),ncol=2,byrow=TRUE)))){
  stop("deactivate.vertex.attribute did not deactivate attribute with expected structure")
}


##########################################################################
#testing if deactivating all spells. 
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=2)
activate.edge.attribute(nd,"letters","c",onset=2,terminus=3)

deactivate.edge.attribute(x=nd, prefix="letters", onset=-Inf, terminus=Inf)

if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]]=="NA",
        nd$mel[[1]]$atl$letters.active[[2]]==matrix(c(Inf,Inf),ncol=2)
        
)){
  stop("deactivate.edge.attribute did not deactivate attribute with expected structure")
}


##########################################################################
#testing if the deactivating period across two spells
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=2)
activate.edge.attribute(nd,"letters","b",onset=2,terminus=4)
activate.edge.attribute(nd,"letters","c",onset=5,terminus=6)

deactivate.edge.attribute(x=nd, prefix="letters", onset=1, terminus=3)

if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[1]]$atl$letters.active[[1]][[2]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[3]] == "c",
        all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1,3,4,5,6),ncol=2,byrow=TRUE)))){
  stop("deactivate.edge.attribute did not deactivate attribute with expected structure")
}
##########################################################################


##########################################################################
#testing if the deactivating period within one spell
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=4)
activate.edge.attribute(nd,"letters","c",onset=5,terminus=6)

deactivate.edge.attribute(x=nd, prefix="letters", onset=2, terminus=3)

if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[1]]$atl$letters.active[[1]][[2]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[3]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[4]] == "c",
        all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1,1,2,3,4,5,6),ncol=2,byrow=TRUE)))){
  stop("deactivate.edge.attribute did not deactivate attribute with expected structure")
}
##########################################################################



##########################################################################
#4/4 testing if the deactivating one or two edges
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1)
activate.edge.attribute(nd,"letters","b",onset=1,terminus=4)
activate.edge.attribute(nd,"letters","c",onset=5,terminus=6)

deactivate.edge.attribute(x=nd, prefix="letters", onset=2, terminus=3, e=c(2,1))

if(!all(nd$mel[[1]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[1]]$atl$letters.active[[1]][[2]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[3]] == "b",
        nd$mel[[1]]$atl$letters.active[[1]][[4]] == "c",
        all(nd$mel[[1]]$atl$letters.active[[2]] == matrix(c(0,1,1,2,3,4,5,6),ncol=2,byrow=TRUE)))){
  stop("deactivate.edge.attribute did not deactivate attribute with expected structure")
}


if(!all(nd$mel[[3]]$atl$letters.active[[1]][[1]] == "a",
        nd$mel[[3]]$atl$letters.active[[1]][[2]] == "b",
        nd$mel[[3]]$atl$letters.active[[1]][[3]] == "c",
        all(nd$mel[[3]]$atl$letters.active[[2]] == matrix(c(0,1,1,4,5,6),ncol=2,byrow=TRUE)))){
  stop("deactivate.edge.attribute did not deactivate attribute with expected structure")
}

##########################################################################


expect_warning(deactivate.edge.attribute(network.initialize(0),'foo'), 'does not contain any edges')


##########################################################################
#04/01, testing if the deactivating inacitivate edge attribute
##########################################################################
nd <- network.initialize(5)
add.edge(nd,1,2)
add.edge(nd,2,3)
add.edge(nd,3,4)
activate.edge.attribute(nd,"letters","a",onset=0,terminus=1,e=1:2)

# expect_warning(deactivate.edge.attribute(nd,"letters", onset=0,terminus=1),"intend to deactivate attribute on inactivate edge")
test <- deactivate.edge.attribute(nd,"letters", onset=0,terminus=1)
if(!length(list.edge.attributes.active(test, onset=0,terminus=3,dynamic.only=T))==0)
  stop("error in deactivating inacitivate edge attribute")


##########################################################################
##########################################################################
# ----------------- deactivate.network.attribute
##########################################################################

nd <-network.initialize(5)
activate.network.attribute(nd,"test","a",onset=1,terminus=3)
activate.network.attribute(nd,"test","b",onset=4,terminus=5)
activate.network.attribute(nd,"test","c",onset=6,terminus=10)

deactivate.network.attribute(nd,"test",onset=2,terminus=7)

if(!all(nd$gal$test.active[[1]][[1]] == "a",
        nd$gal$test.active[[1]][[2]] == "c",
        all(nd$gal$test.active[[2]] == matrix(c(1,2,7,10),ncol=2,byrow=TRUE)))){
  stop("deactivate.network.attribute did not deactivate activity attribute with expected structure")
}


# ---- test 'earliest' and 'latest' attribute aggregation rules ----
test<-network.initialize(1)
activate.vertex.attribute(test,'letter',"a",onset=0,terminus=1)
activate.vertex.attribute(test,'letter',"b",onset=1,terminus=2)
activate.vertex.attribute(test,'letter',"c",onset=2,terminus=3)
expect_equal(get.vertex.attribute.active(test,'letter',onset=0,terminus=4,rule='earliest'),'a')
expect_equal(get.vertex.attribute.active(test,'letter',onset=0,terminus=4,rule='latest'),'c')

test<-network.initialize(2)
test[1,2]<-1
activate.edge.attribute(test,'letter',"a",onset=0,terminus=1)
activate.edge.attribute(test,'letter',"b",onset=1,terminus=2)
activate.edge.attribute(test,'letter',"c",onset=2,terminus=3)
expect_equal(get.edge.attribute.active(test,'letter',onset=0,terminus=4,rule='earliest'),'a')
expect_equal(get.edge.attribute.active(test,'letter',onset=0,terminus=4,rule='latest'),'c')


test<-network.initialize(1)
activate.network.attribute(test,'letter',"a",onset=0,terminus=1)
activate.network.attribute(test,'letter',"b",onset=1,terminus=2)
activate.network.attribute(test,'letter',"c",onset=2,terminus=3)
expect_equal(get.network.attribute.active(test,'letter',onset=0,terminus=4,rule='earliest'),'a')
expect_equal(get.network.attribute.active(test,'letter',onset=0,terminus=4,rule='latest'),'c')

Try the networkDynamic package in your browser

Any scripts or data that you put into this service are public.

networkDynamic documentation built on Feb. 16, 2023, 10:08 p.m.