R Under development (unstable) (2025-04-26 r88181 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests for the path distance functions > > require(tsna) Loading required package: tsna Loading required package: network 'network' 1.19.0 (2024-12-08), part of the Statnet Project * 'news(package="network")' for changes since last version * 'citation("network")' for citation information * 'https://statnet.org' for help, support, and other information Loading required package: networkDynamic 'networkDynamic' 0.11.5 (2024-11-21), part of the Statnet Project * 'news(package="networkDynamic")' for changes since last version * 'citation("networkDynamic")' for citation information * 'https://statnet.org' for help, support, and other information > require(testthat) Loading required package: testthat > require(networkDynamicData) Loading required package: networkDynamicData > linegraph<-network.initialize(10) > add.edges(linegraph,tail=1:9,head=2:10) > > data(concurrencyComparisonNets) > > > > # ----- tests for tPath ---- > > > > test_that('tPath basic tests',{ + line<-network.initialize(4) + add.edges.active(line,tail=1:3,head=2:4,onset=0:2,terminus=1:3) + # check return format + expect_equal(names(tPath(line,v=1)),c('tdist','previous','gsteps','start','end','direction','type')) + expect_is(tPath(line,v=1),class = 'tPath') + + # check args + expect_error(tPath(line,v=1,type='foo')) + expect_error(tPath(line,v=1,direction='foo')) + + # check unimplemented + expect_error(tPath(line,v=1,type='latest.depart'),regexp='method is not yet implemented') + + # check basic line with default earliest arriving fwd + expect_equal(tPath(line,v=1)$tdist,c(0, 0, 1, 2)) + expect_equal(tPath(line,v=2)$tdist,c(Inf,0,1,2)) + + # test starting and ending flags + expect_equal(tPath(line,v=1,start=0.5)$tdist, c(0,0,0.5,1.5)) + expect_equal(tPath(line,v=1,start=2)$tdist, c(0,Inf,Inf,Inf)) + expect_equal(tPath(line,v=1,end=2)$tdist, c(0,0,1,Inf)) + + line<-network.initialize(4) + add.edges.active(line,tail=1:3,head=2:4,onset=c(2,1,3),terminus=c(3,2,4)) + expect_equal(tPath(line,v=1)$tdist,c(0,1,Inf,Inf)) + + # test active default + test<-as.networkDynamic(network.initialize(4)) + add.edges(test,1:3,2:4) + expect_equal(tPath(test,v=1,start=0)$tdist,c(0,0,0,0)) + expect_equal(tPath(test,v=1,active.default=FALSE,start=0)$tdist,c(0,Inf,Inf,Inf)) + + test<-network.initialize(4) + add.edges(test,1:3,3:4) + activate.edges(test,e=1,at=2) + + # test start message + test<-as.networkDynamic(network.initialize(4)) + expect_message(tPath(test,v=1),regexp="'start' time parameter for paths was not specified") + + # test wrong object + expect_error(tPath(network.initialize(3)),regexp='first argument must be a networkDynamic object') + + # test no v specified + expect_error(tPath(as.networkDynamic(network.initialize(2)),regexp='argument with valid vertex ids was not given')) + + # test on network size 0 + expect_equal(tPath(as.networkDynamic(network.initialize(0)),start=0,v=numeric(0))$tdist,numeric(0)) + }) Test passed πŸ˜€ > > > # ----- tests for forward earliest paths ---- > > test_that("path in large base network matches",{ + fwdDFS<-tPath(base,v=24) + expect_equal(sum(fwdDFS$tdist0) + pathset<-which(tPath(base,v=24,graph.step.time=1)$tdist > data(moodyContactSim) > > > # tests with moody's example network > test_that("test of moody's example network",{ + + paths<-tPath(moodyContactSim,v=10) + + expect_equal(paths$tdist,c(543, 454, 594, 0, 672, 661, 184, 679, 634, 0, 709, 581, 413, 625, 669, 535)) + expect_equal(paths$previous,c(16,13,13,10,13,16,10,13,1,0,8,1,4,4,2,2)) + expect_equal(paths$gsteps,c(5, 3, 3, 1, 3, 5, 1, 3, 6, 0, 4, 6, 2, 2, 4, 4)) + + # render a pdf for visual inspection of correctness + # tree<-create_tree(paths) + # pdf(file="MoodyTestNetTree.pdf",width=10,height=5) + # par(mfcol=c(1,2)) + # plot(moodyContactSim,displaylabels=TRUE, + # edge.label=lapply(get.edge.activity(moodyContactSim), + # function(spl){ + # paste("(",spl[,1],"-",spl[,2],")",sep= + # '' + # ) + # }), + # edge.label.col='blue', + # edge.label.cex=0.6, + # main="moody example net") + # + # plot(tree, + # coord=layout.normalize(network.layout.animate.Graphviz(tree,layout.par=list(gv.engine='dot')),keep.aspect.ratio=FALSE), + # displaylabels=TRUE, + # jitter=FALSE, + # label.pos=2, + # main='earliest paths from v10', + # edge.label=lapply(get.edge.activity(tree), + # function(spl){ + # paste("(",spl[,1],")",sep= + # '' + # ) + # }), + # edge.label.col='blue', + # edge.label.cex=0.6) + # par(mfcol=c(1,1)) + # dev.off() + }) Test passed 🌈 > > > > test_that("test on network with two components",{ + test<-network.initialize(10) + activate.vertices(test) + test[1:5,5:1]<-1 + test[6:10,10:6]<-1 + expect_equal(which(tPath(test,v=1)$tdist!=Inf),1:5) + expect_equal(which(tPath(test,v=6)$tdist!=Inf),6:10) + }) Test passed πŸŽ‰ > > > > # test path distance > test_that("graph step time param works",{ + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0:2,terminus=1:3) + # count each geodesic step as instantaneous + expect_equal(tPath(test,v=1,graph.step.time=0)$tdist,c(0, 0, 1, 2)) + # count each geodesic step as something less than 1 + expect_equal(tPath(test,v=1,graph.step.time=0.5)$tdist,c(0, 0.5, 1.5, 2.5)) + # count each geodesic step as 1 + expect_equal(tPath(test,v=1,graph.step.time=1)$tdist,c(0, 1, 2, 3)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=1,graph.step.time=2)$tdist,c(0, Inf, Inf, Inf)) + + # test with always active edges + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0,terminus=10) + # count each geodesic step as 1 + expect_equal(tPath(test,v=1,graph.step.time=1)$tdist,c(0, 1, 2, 3)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=1,graph.step.time=2)$tdist,c(0, 2, 4, 6)) + # count each geodesic step as 0 + expect_equal(tPath(test,v=1,graph.step.time=0)$tdist,c(0, 0, 0, 0)) + + test<-as.networkDynamic(network.initialize(4)) + add.edges(test,tail=1:3,head=2:4) + # count each geodesic step as 1 + expect_equal(tPath(test,v=1,graph.step.time=1)$tdist,c(0, 1, 2, 3)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=1,graph.step.time=2)$tdist,c(0, 2, 4, 6)) + + # test with an edge with multiple activity spells, some later + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0:2,terminus=1:3) + activate.edges(test,e=1,onset=5,terminus=10) + expect_equal(tPath(test,v=1,graph.step.time=2)$tdist,c(0, 7, Inf, Inf)) + + # test with combination of start and end values + test<-network.initialize(10) + add.edges.active(test,tail=1:9,head=2:10,onset=0:9,terminus=10) + tPath(test,v=1,start=5,graph.step.time=2)$tdist + + }) Test passed 🎊 > > # ----- tests for shortest geo fwd path ---- > # construct a network in which distinguishes paths ( > # > # tel<-matrix(c(2,3,1,2, > # 3,4,2,5, > # 4,5,5,3, > # 0,1,1,3, > # 5,6,1,4, > # 7,8,4,3),byrow=TRUE,ncol=4) > # # shortest path from 1 to 3 is the direct route, arriving at time > # test<-networkDynamic(edge.spells=tel) > # plot(test,displaylabels=TRUE,edge.label=paste(get.edge.attribute(test,'active',unlist=FALSE)),label.col='blue',edge.label.cex=0.7) > # > # #path starting at time 0 > # > # path0<-tPath(test,v=1,type='fewest.steps') > # expect_equal(path0$tdist,c(0, 2, 0, 5, 3)) > # expect_equal(path0$previous,c(0, 1, 1, 1, 2)) > # expect_equal(path0$gsteps,c(0, 1, 1, 1, 2)) > # > # # path starting at v1 time 1 > # # (direct path to v3 eliminated because it is too early) > # # shortest geodesic path to v3 is 1-3 > # # earliest temporal path to v3 is 1-2-5-3 > # # shortest geodesic temporal path to v3 is 1-4-3 > # path1<-tPath(test,v=1,start=1,type='fewest.steps') > # expect_equal(path1$tdist,c(0, 1, 6, 4, 2)) > # expect_equal(path1$previous,c(0, 1, 4, 1, 2)) > # expect_equal(path1$gsteps,c(0, 1, 2, 1, 2)) > # > # > # # test for a later-leaving path arriving earlier > > > # ----- tests for paths.bkwd.latest ----- > > > > # reverse-ordered edge spells > test<-network.initialize(10) > add.edges(test,tail=1:9,head=2:10) > activate.edges(test,onset=10:0,terminus=11:1) > results<-tPath(test,v=5,direction='bkwd',type='latest.depart') > expect_equal(results$tdist,c(Inf, Inf, Inf, 3, 0, Inf, Inf, Inf, Inf, Inf)) > expect_equal(results$previous,c(0, 0, 0, 5, 0, 0, 0, 0, 0, 0)) > expect_equal(results$gsteps,c(Inf, Inf, Inf, 1, 0, Inf, Inf, Inf, Inf, Inf)) > > # forward-ordred edge spells > test<-network.initialize(10) > add.edges(test,tail=1:9,head=2:10) > activate.edges(test,onset=0:10,terminus=1:11) > results<-tPath(test,v=10,direction='bkwd',type='latest.depart') > expect_equal(results$tdist,c(8,7,6,5,4,3,2,1,0,0)) > expect_equal(results$previous,c(2,3,4,5,6,7,8,9,10,0)) > expect_equal(results$gsteps,c(9, 8, 7, 6, 5, 4, 3, 2, 1, 0)) > > # moody sim > results<-tPath(moodyContactSim,v=10,direction='bkwd',type='latest.depart') > expect_equal(results$tdist,c(Inf, Inf, Inf, 723, Inf, Inf, 539, Inf, Inf, 0, Inf, Inf, Inf, Inf, Inf, Inf)) > expect_equal(results$previous,c(0, 0, 0, 10, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0)) > > results<-tPath(moodyContactSim,v=16,direction='bkwd',type='latest.depart') > expect_equal(results$tdist,c(180, 196, Inf, 13, Inf, 62, Inf, Inf, Inf, 723, 548, Inf, 271, 103, Inf, 0)) > expect_equal(results$previous,c(16, 16, 0, 16, 0, 16, 0, 0, 0, 4, 1, 0, 2, 4, 0, 0)) > > test_that("graph step time param works for bakward path",{ + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0:2,terminus=1:3) + # count each geodesic step as instantaneous + expect_equal(tPath(test,v=4,graph.step.time=0,direction='bkwd',type='latest.depart')$tdist,c(2, 1, 0, 0)) + # count each geodesic step as something less than 1 + expect_equal(tPath(test,v=4,graph.step.time=0.5,direction='bkwd',type='latest.depart')$tdist,c(2.5, 1.5, 0.5, 0.0)) + # count each geodesic step as 1 + expect_equal(tPath(test,v=4,graph.step.time=1,direction='bkwd',type='latest.depart')$tdist,c(3, 2, 1, 0)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=4,graph.step.time=2,direction='bkwd',type='latest.depart')$tdist,c( Inf, Inf, Inf,0)) + + # test with always active edges + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0,terminus=10) + # count each geodesic step as 1 + expect_equal(tPath(test,v=4,graph.step.time=1,direction='bkwd',type='latest.depart')$tdist,c(3, 2, 1, 0)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=4,graph.step.time=2,direction='bkwd',type='latest.depart')$tdist,c(6, 4, 2, 0)) + # count each geodesic step as 0 + expect_equal(tPath(test,v=4,graph.step.time=0,direction='bkwd',type='latest.depart')$tdist,c(0, 0, 0, 0)) + + test<-as.networkDynamic(network.initialize(4)) + add.edges(test,tail=1:3,head=2:4) + # count each geodesic step as 1 + expect_equal(tPath(test,v=4,graph.step.time=1,direction='bkwd',type='latest.depart')$tdist,c(3, 2, 1, 0)) + # count each geodesic step as 2 + expect_equal(tPath(test,v=4,graph.step.time=2,direction='bkwd',type='latest.depart')$tdist,c(6, 4, 2, 0)) + + # test with an edge with multiple activity spells, some later + test<-network.initialize(4) + add.edges.active(test,tail=1:3,head=2:4,onset=0:2,terminus=1:3) + activate.edges(test,e=1,onset=5,terminus=10) + expect_equal(tPath(test,v=4,graph.step.time=2,direction='bkwd',type='latest.depart')$tdist,c(Inf, Inf, 9, 0)) + + }) ── Warning: graph step time param works for bakward path ─────────────────────── 'end' time parameter for paths was not specified, no network changes found, using 'end' value of 4 Backtrace: β–† 1. β”œβ”€testthat::expect_equal(...) 2. β”‚ └─testthat::quasi_label(enquo(object), label, arg = "object") 3. β”‚ └─rlang::eval_bare(expr, quo_get_env(quo)) 4. └─tsna::tPath(...) 5. └─tsna:::paths.bkwd.latest(...) ── Warning: graph step time param works for bakward path ─────────────────────── 'end' time parameter for paths was not specified, no network changes found, using 'end' value of 8 Backtrace: β–† 1. β”œβ”€testthat::expect_equal(...) 2. β”‚ └─testthat::quasi_label(enquo(object), label, arg = "object") 3. β”‚ └─rlang::eval_bare(expr, quo_get_env(quo)) 4. └─tsna::tPath(...) 5. └─tsna:::paths.bkwd.latest(...) > > > # --------- tests for tsna:::paths.fwd.latest --------- > # two paths, does it > test<-network.initialize(2) > add.edges.active(test,tail=1,head=2,onset=0,terminus=1) > activate.edges(test,onset=2,terminus=3) > tPath(test,v=2,start=0,end=3) $tdist [1] Inf 0 $previous [1] 0 0 $gsteps [1] Inf 0 $start [1] 0 $end [1] 3 $direction [1] "fwd" $type [1] "earliest.arrive" attr(,"class") [1] "tPath" "list" > tsna:::paths.fwd.latest(test,v=2,start=0,end=3) $tdist [1] Inf 3 $previous $previous[[1]] [1] 0 $previous[[2]] [1] 2 0 Warning message: In tsna:::paths.fwd.latest(test, v = 2, start = 0, end = 3) : paths.fwd.latest has not be fully tested and may not be correct > > > # create a network in which the latest-starting path and > # the latest ending path are not the same > test<-network.initialize(5,direct=FALSE) > add.edges(test,tail=c(1,1,2,4),head=c(3,2,4,3)) > activate.edges(test,at=c(1,2,3,4)) > plot(test,displaylabels=TRUE,edge.label=get.edge.activity(test)) > # latest starting path v1 to v4 should be at time 2 (via edge 2) > # latest ending path v1 to v4 should be at time 4 (via edge 3) > tsna:::paths.fwd.latest(test,v=1,start=0,end=4) $tdist [1] 4 2 1 2 Inf $previous $previous[[1]] [1] 0 1 1 0 0 $previous[[2]] [1] 2 0 1 2 0 $previous[[3]] [1] 3 0 0 0 0 $previous[[4]] [1] 2 4 1 0 0 $previous[[5]] [1] 0 Warning message: In tsna:::paths.fwd.latest(test, v = 1, start = 0, end = 4) : paths.fwd.latest has not be fully tested and may not be correct > > > # create a network in which the latest-starting path and > # the latest ending path are not the same > test<-network.initialize(5,direct=FALSE) > add.edges(test,tail=c(1,1,2,4),head=c(3,2,4,3)) > activate.edges(test,at=c(1,2,3,4)) > plot(test,displaylabels=TRUE,edge.label=get.edge.activity(test)) > tPath(test,v=1,start=0) $tdist [1] 0 2 1 3 Inf $previous [1] 0 1 1 2 0 $gsteps [1] 0 1 1 2 Inf $start [1] 0 $end [1] Inf $direction [1] "fwd" $type [1] "earliest.arrive" attr(,"class") [1] "tPath" "list" > tsna:::paths.fwd.latest(test,v=1,start=0) $tdist [1] 4 2 1 2 Inf $previous $previous[[1]] [1] 0 1 1 0 0 $previous[[2]] [1] 2 0 1 2 0 $previous[[3]] [1] 3 0 0 0 0 $previous[[4]] [1] 2 4 1 0 0 $previous[[5]] [1] 0 Warning message: In tsna:::paths.fwd.latest(test, v = 1, start = 0) : paths.fwd.latest has not be fully tested and may not be correct > > # create a network in which an early-leaving path arrives latest > # the latest path from v1 to v3 should arrive at t4 via v4 > test<-network.initialize(4,directed=FALSE) > add.edges(test,tail=c(1,1,2,4),head=c(3,2,4,3)) > activate.edges(test,at=c(2,1,3,4)) > plot(test,displaylabels=TRUE,edge.label=get.edge.activity(test)) > > > > # test network illustrating problems with implementation of graph.step.time > test<-network.initialize(4) > add.edges.active(test,1:3,2:4,at=1) > tPath(test,v=1,start=0)$tdist # all vertices rechable at t=1 [1] 0 1 1 1 > tPath(test,v=1,start=0,graph.step.time = 1)$tdist # no vertices are reachable because no path is open long enough for transmission to occur [1] 0 Inf Inf Inf > > > > # the network below illustrates the various possible paths > # tests ability to distinguish paths > # howver, it is not a great complex test case since there are no > # indirect paths > paths5<-network.initialize(7) > network.vertex.names(paths5)<-LETTERS[1:7] > add.edges.active(paths5,tail=c(1,2),head=c(2,7),onset=c(1,4),terminus=c(2,5)) > add.edges.active(paths5,tail=c(1,3),head=c(3,7),onset=c(0,6),terminus=c(2,7)) > add.edges.active(paths5,tail=c(1,4),head=c(4,7),onset=c(4,5),terminus=c(5,6)) > add.edges.active(paths5,tail=c(1,5),head=c(5,7),onset=c(6,9),terminus=c(7,10)) > add.edges.active(paths5,tail=c(1,6),head=c(6,7),onset=c(4,10),terminus=c(5,11)) > plot(paths5, mode='circle',displaylabels=TRUE,edge.label=get.edge.activity(paths5),edge.label.col='blue',edge.label.cex=0.6) > as.data.frame(paths5) onset terminus tail head onset.censored terminus.censored duration edge.id 1 1 2 1 2 FALSE FALSE 1 1 2 4 5 2 7 FALSE FALSE 1 2 3 0 2 1 3 FALSE FALSE 2 3 4 6 7 3 7 FALSE FALSE 1 4 5 4 5 1 4 FALSE FALSE 1 5 6 5 6 4 7 FALSE FALSE 1 6 7 6 7 1 5 FALSE FALSE 1 7 8 9 10 5 7 FALSE FALSE 1 8 9 4 5 1 6 FALSE FALSE 1 9 10 10 11 6 7 FALSE FALSE 1 10 > # FORWARDS > # earliest leaving ACG @ 6 > # earliest arriving ABG @ 4 > res2<-tPath(paths5,v=1) > expect_equal(res2$tdist[7],4) > # latest leaving AEG @ 10 > > > # quickest ADG @ 5 > # latest ariving AFG @ 11 > > #BACKWARDS > > > # ----- tests for paths.fwd.approx --- > # data(moodyContactSim) > # # hard to test because random algorithm > # > # split<-network.initialize(2) > # add.edges.active(split,tail=1,head=2,onset=0,terminus=1) > # arrivePercent<-paths.fwd.approx(split,v=1,tries=1000) > # # would expect 1/2,1/2 > # > # split<-network.initialize(2,directed=FALSE) > # add.edges.active(split,tail=1,head=2,onset=0,terminus=1) > # arrivePercent<-paths.fwd.approx(split,v=1,tries=1000) > # # would expect 1/2,1/2 > # > # split<-network.initialize(3) > # add.edges.active(split,tail=c(1,1),head=2:3,onset=0,terminus=1) > # arrivePercent<-paths.fwd.approx(split,v=1,tries=1000) > # # would expect 1/3,1/3,1/3 > # > # split<-network.initialize(5) > # add.edges.active(split,tail=c(1,1),head=2:3,onset=c(0,0.5),terminus=c(1,1)) > # add.edges.active(split,tail=3,head=4,onset=0.5,terminus=1) > # # > # plot(split,displaylabels=TRUE,edge.label=get.edge.activity(split)) > # # 1/4 paths should remain on v1 > # # 1/2 paths remain v2 > # # 1/8 paths remain v3 > # # 1/8 paths remain v4 > # # 0 paths reach v5 > # paths.fwd.approx(split,v=1,tries=100) > > # for these values, set a rng seed > #set.seed(123) > #fwdProbs<-paths.fwd.approx(moodyContactSim,v=1) > #expect_equal(fwdProbs,c(0.858750, 0.000000, 0.000000, 0.000625, 0.000000, 0.001250, 0.000000, 0.001875, 0.036250, 0.000000, 0.023125, 0.038750, 0.000000, 0.000000, 0.000000, 0.039375)) > #fwdProbs<-paths.fwd.approx(moodyContactSim,v=10,tries=100) > #expect_equal(fwdProbs,c(0, 0, 0, 0.01, 0, 0, 0.01, 0, 0, 0.98)) > > > proc.time() user system elapsed 3.28 0.42 3.71