R Under development (unstable) (2024-07-01 r86857 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 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. > # part of the Statnet suite > # of packages for network analysis, http://statnet.org . > # > # This software is distributed under the GPL-3 license. It is free, > # open source, and has the attribution requirements (GPL Section 7) at > # http://statnet.org/attribution > # > # Copyright 2012-2014 Statnet Commons > ####################################################################### > > # tests for the network animation layout functions > require(ndtv) Loading required package: ndtv Loading required package: network 'network' 1.18.2 (2023-12-04), 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.4 (2023-12-10?), 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 Loading required package: animation Loading required package: sna Loading required package: statnet.common Attaching package: 'statnet.common' The following objects are masked from 'package:base': attr, order sna: Tools for Social Network Analysis Version 2.7-2 created on 2023-12-05. copyright (c) 2005, Carter T. Butts, University of California-Irvine For citation information, type citation("sna"). Type help(package="sna") to get started. 'ndtv' 0.13.4 (2023-06-30), part of the Statnet Project * 'news(package="ndtv")' for changes since last version * 'citation("ndtv")' for citation information * 'https://statnet.org' for help, support, and other information > require(testthat) Loading required package: testthat > # ---- test using a dynamic attribute for layout positions ---- > > # check what happens if coords not defined > nd <-as.networkDynamic(network.initialize(3)) > expect_error(compute.animation(nd,animation.mode='useAttribute'), 'unable to find vertex attribute x containing x') No slice.par found, using slice parameters: start:0 end:0 interval:1 aggregate.dur:1 rule:latest Calculating layout for network slice from time 0 to 1 Warning message: In guessSlicePar(net) : network does not appear to have any dynamic information. Using start=0 end=1 > > #check when coordinates specified > nd <-network.initialize(3) > activate.vertex.attribute(nd,'x',c(1,2,3),at=0) > activate.vertex.attribute(nd,'y',c(0,0,0),at=0) > activate.vertex.attribute(nd,'x',c(2,3,4),at=1) > activate.vertex.attribute(nd,'y',c(1,1,1),at=1) > activate.vertex.attribute(nd,'x',c(3,4,5),at=2) > activate.vertex.attribute(nd,'y',c(2,2,2),at=2) > > compute.animation(nd,animation.mode='useAttribute',layout.par=list(x='x',y='y')) No slice.par found, using slice parameters: start:0 end:2 interval:1 aggregate.dur:1 rule:latest Calculating layout for network slice from time 0 to 1 Calculating layout for network slice from time 1 to 2 Calculating layout for network slice from time 2 to 3 > expect_equal(unlist(get.vertex.attribute(nd,'x.active',unlist=FALSE)[[1]][[1]]),1:3) > > > # check what happens if coords missing for time period > nd <-network.initialize(3) > activate.vertex.attribute(nd,'x',c(1,2,3),at=0) > activate.vertex.attribute(nd,'y',c(0,0,0),at=0) > activate.vertex.attribute(nd,'x',c(2,3,4),at=3) > activate.vertex.attribute(nd,'y',c(1,1,1),at=3) > activate.vertex.attribute(nd,'x',c(3,4,5),at=4) > activate.vertex.attribute(nd,'y',c(2,2,2),at=4) > expect_error(compute.animation(nd,animation.mode='useAttribute',layout.par=list(x='x',y='y')),'coordinates must be numeric') No slice.par found, using slice parameters: start:0 end:4 interval:1 aggregate.dur:1 rule:latest Calculating layout for network slice from time 0 to 1 Calculating layout for network slice from time 1 to 2 > > # ------ test layout.distance function ---- > test<-network.initialize(4) > add.edges(test,tail=1:2,head=2:3) > expect_equal(layout.distance(test),matrix(c(0,1,2,2,1,0,1,2,2,1,0,2,2,2,2,0),ncol=4,byrow=TRUE), info='test layout distance') > expect_equal(layout.distance(test,.5),matrix(c(0,1,2,.5, 1,0,1,.5, 2,1,0,.5, .5,.5,.5,0),ncol=4,byrow=TRUE),info='test inf replace value for layout distance') > > set.edge.attribute(test,'weight',c(3,6)) > expect_equal(layout.distance(test,weight.attr='weight'),matrix(c(0, 6, 9, 2, 6, 0, 3, 2, 9, 3, 0, 2, 2, 2, 2, 0),ncol=4,byro=TRUE),info='test layout distance with weights') > > expect_equal(layout.distance(test,weight.attr='weight',weight.dist=TRUE),matrix(c(0, 3, 9, 2, 3, 0, 6, 2, 9, 6, 0, 2, 2, 2, 2, 0),ncol=4,byro=TRUE),info='test layout distance with weights with weights as distance') > > # test symetrization > test_that("symetrization of directed network according to weight.dist",{ + test<-network.initialize(2,directed=TRUE) + test[1,2]<-1 + test[2,1]<-1 + set.edge.attribute(test,'count',value=c(1,2)) + expect_equal(as.vector(layout.distance(test,weight.attr='count',weight.dist=TRUE)),c(0,1,1,0)) + expect_equal(as.vector(layout.distance(test,weight.attr='count',weight.dist=FALSE)),c(0,2,2,0)) + }) Test passed 🎊 > > # ----- test layout centering ---- > > pos<-matrix(c(1:5,1:5),ncol=2,byrow=FALSE) > > # center on 0,0 > expect_equal(layout.center(pos,xlim=c(0,0),ylim=c(0,0)),pos-3) > > # center in 100 px square > expect_equal(layout.center(pos,xlim=c(0,100),ylim=c(0,100)),matrix(c(48, 49, 50, 51, 52, 48, 49, 50, 51, 52),ncol=2)) > > > # ----- test layout zooming ------ > > pos<-matrix(c(1:5,1:5),ncol=2,byrow=FALSE) > > # factor 0 does nothing > expect_equal(ndtv:::layout.zoomfactor(pos,0),pos) > > # factor 10 (scale at origin) > expect_equal(ndtv:::layout.zoomfactor(pos,10),pos*10) > > # factor 10, scale at 1,1 > expect_equal(ndtv:::layout.zoomfactor(pos,10,center=c(1,1)),(pos*10)-9) > > # zoom on set of vertices > expect_equal(ndtv:::layout.zoomfactor(pos,2,v=2:3),matrix(c(-0.5, 1.5, 3.5, 5.5, 7.5, -0.5, 1.5, 3.5, 5.5, 7.5),ncol=2)) > > # ----- graphviz tests ----- > > # graphviz layout test > # set up a basic tree structure > tree<-network.initialize(21) > add.edges.active(tree,head=1,tail=2,onset=0,terminus=5) > add.edges.active(tree,head=c(2,2),tail=c(3,4),onset=1,terminus=5) > add.edges.active(tree,head=c(3,3,3,4,4),tail=5:9,onset=2,terminus=5) > add.edges.active(tree,head=c(6,6,8,9,9),tail=10:14,onset=3,terminus=5) > add.edges.active(tree,head=c(10,10,12,12,12,14,14),tail=15:21,onset=4,terminus=5) > > # the tests below are contional on graphviz being installed on the system > if (ndtv:::check.graphviz()){ + #plot.network(tree,coord=network.layout.animate.Graphviz(tree)) + coords<-network.layout.animate.Graphviz(tree) + expect_equal(nrow(coords),21) + expect_equal(ncol(coords),2) + + # check verbose + network.layout.animate.Graphviz(tree,verbose=FALSE) + + # check using layout par to set differnet engines + network.layout.animate.Graphviz(tree,layout.par=list(gv.engine='dot')) + + # check passing in gv.args + network.layout.animate.Graphviz(tree,layout.par=list(gv.engine='dot',gv.args='-Grankdir=LR')) + + # check passing bad gv.args + expect_error(network.layout.animate.Graphviz(tree,layout.par=list(gv.args='-Xhelloworld'),verbose=FALSE),regexp = 'Unable to parse coordinates') + + # test passing a weighted network into neato + wtest<-network.initialize(5) + add.edges.active(wtest,tail = 1,head=2,onset=0,terminus=10) + add.edges.active(wtest,tail = 2,head=3,onset=1,terminus=10) + add.edges.active(wtest,tail = 3,head=4,onset=2,terminus=10) + activate.edge.attribute(wtest,'len',0.5,onset=0,terminus=5,e = 1) + activate.edge.attribute(wtest,'len',2.5,onset=5,terminus=10,e=1) + activate.edge.attribute(wtest,'len',2,onset=1,terminus=5,e = 2) + activate.edge.attribute(wtest,'len',1,onset=5,terminus=10,e=2) + activate.edge.attribute(wtest,'len',5,onset=2,terminus=5,e = 3) + activate.edge.attribute(wtest,'len',0.1,onset=5,terminus=10,e=3) + + # test rendering using the gv 'len' attrigute + compute.animation(wtest,animation.mode = 'Graphviz',layout.par=list(gv.len.mode='gv.edge.len',gv.edge.attrs='len')) + #render.animation(wtest,edge.lwd='len') + + # test passing in matrix of distances + compute.animation(wtest,animation.mode = 'Graphviz',weight.attr='len',layout.par=list(gv.engine='neato',gv.len.mode='ndtv.distance.matrix')) + + # test using default dist to generate a matrix + compute.animation(wtest,animation.mode = 'Graphviz',default.dist=5) + + # test bad weight mode + expect_error(compute.animation(wtest,animation.mode = 'Graphviz',layout.par=list(gv.len.mode='bla'))) + + } else { + # graphivz not installed, so check fallback to kk + warning("graphviz layout tests skipped because graphviz not installed on system") + expect_warning(coords<-network.layout.animate.Graphviz(tree),'KamadaKawai') + expect_equal(nrow(coords),21) + expect_equal(ncol(coords),2) + + } Warning messages: 1: In ndtv:::check.graphviz() : The Graphviz neato utility does not appear to be installed on this system. See ?install.graphviz for more information 2: graphviz layout tests skipped because graphviz not installed on system > > # ------------- MDSJ tests ------- > # COMMENTING BECAUSE SKIP_ON_CRAN_STOPPED_WORKING > # test_that("MDSJ algorithms",{ > # these need to be optionally enabled because they won't run if java and mdsj library not installed > # skip_on_cran() > # if (!is.null(ndtv:::check.mdsj()) ){ > # wtest<-network.initialize(5) > # add.edges.active(wtest,tail = 1,head=2,onset=0,terminus=10) > # add.edges.active(wtest,tail = 2,head=3,onset=1,terminus=10) > # add.edges.active(wtest,tail = 3,head=4,onset=2,terminus=10) > # activate.edge.attribute(wtest,'len',0.5,onset=0,terminus=5,e = 1) > # activate.edge.attribute(wtest,'len',2.5,onset=5,terminus=10,e=1) > # activate.edge.attribute(wtest,'len',2,onset=1,terminus=5,e = 2) > # activate.edge.attribute(wtest,'len',1,onset=5,terminus=10,e=2) > # activate.edge.attribute(wtest,'len',5,onset=2,terminus=5,e = 3) > # activate.edge.attribute(wtest,'len',0.1,onset=5,terminus=10,e=3) > # > # compute.animation(wtest,animation.mode = 'MDSJ',weight.attr='len') > # > # # dests for changing dimensions of MDSJ layout > # test<-network.initialize(10) > # dim2mat<-network.layout.animate.MDSJ(test,layout.par=list(dimensions=2)) > # expect_equal(dim(dim2mat),c(10,2)) > # dim1mat<-network.layout.animate.MDSJ(test,layout.par=list(dimensions=1)) > # expect_equal(dim(dim1mat),c(10,1)) > # } > # }) > > > > > > > proc.time() user system elapsed 2.68 0.40 3.07