* using log directory 'd:/Rcompile/CRANpkg/local/4.4/EpiContactTrace.Rcheck' * using R Under development (unstable) (2024-03-22 r86169 ucrt) * using platform: x86_64-w64-mingw32 * R was compiled by gcc.exe (GCC) 13.2.0 GNU Fortran (GCC) 13.2.0 * running under: Windows Server 2022 x64 (build 20348) * using session charset: UTF-8 * checking for file 'EpiContactTrace/DESCRIPTION' ... OK * checking extension type ... Package * this is package 'EpiContactTrace' version '0.17.0' * package encoding: UTF-8 * checking package namespace information ... OK * checking package dependencies ... OK * checking if this is a source package ... OK * checking if there is a namespace ... OK * checking for hidden files and directories ... OK * checking for portable file names ... OK * checking whether package 'EpiContactTrace' can be installed ... OK * used C++ compiler: 'g++.exe (GCC) 13.2.0' * checking installed package size ... OK * checking package directory ... OK * checking DESCRIPTION meta-information ... OK * checking top-level files ... OK * checking for left-over files ... OK * checking index information ... OK * checking package subdirectories ... OK * checking code files for non-ASCII characters ... OK * checking R files for syntax errors ... OK * checking whether the package can be loaded ... [0s] OK * checking whether the package can be loaded with stated dependencies ... [0s] OK * checking whether the package can be unloaded cleanly ... [0s] OK * checking whether the namespace can be loaded with stated dependencies ... [0s] OK * checking whether the namespace can be unloaded cleanly ... [0s] OK * checking loading without being on the library search path ... [0s] OK * checking use of S3 registration ... OK * checking dependencies in R code ... OK * checking S3 generic/method consistency ... OK * checking replacement functions ... OK * checking foreign function calls ... OK * checking R code for possible problems ... [4s] OK * checking Rd files ... [1s] OK * checking Rd metadata ... OK * checking Rd cross-references ... OK * checking for missing documentation entries ... OK * checking for code/documentation mismatches ... OK * checking Rd \usage sections ... OK * checking Rd contents ... OK * checking for unstated dependencies in examples ... OK * checking contents of 'data' directory ... OK * checking data for non-ASCII characters ... [0s] OK * checking LazyData ... OK * checking data for ASCII and uncompressed saves ... OK * checking line endings in C/C++/Fortran sources/headers ... OK * checking pragmas in C/C++ headers and code ... OK * checking compiled code ... OK * checking examples ... [15s] OK * checking for unstated dependencies in 'tests' ... OK * checking tests ... [17m] ERROR Running 'arguments.R' [169s] Running 'contact-chain.R' [165s] Running 'degree.R' [163s] Running 'misc.R' [168s] Running 'network-summary.R' [162s] Running 'shortest-paths.R' [5s] Running 'tree.R' [164s] Running the tests in 'tests/arguments.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > > ## > ## Argument checking > ## > ## Check that the functions stop if not the expected arguments are > ## given > ## > > ## > ## Missing parameters in call to IngoingContactChain > ## > tools::assertError(IngoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + tEnd = "2005-10-31", + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(IngoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to IngoingContactChain > ## > tools::assertError(IngoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + tEnd = "2005-10-31")) > > ## > ## Missing parameters in call to OutgoingContactChain > ## > tools::assertError(OutgoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + tEnd = "2005-10-31", + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(OutgoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(OutgoingContactChain(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + tEnd = "2005-10-31")) > > ## > ## Missing parameters in call to InDegree > ## > tools::assertError(InDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + tEnd = "2005-10-31", + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(InDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(InDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + tEnd = "2005-10-31")) > > ## > ## Missing parameters in call to OutDegree > ## > tools::assertError(OutDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + tEnd = "2005-10-31", + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(OutDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to NetworkSummary > ## > tools::assertError(OutDegree(data.frame(source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + tEnd = "2005-10-31")) > > ## > ## Missing parameters in call to Trace > ## > tools::assertError(Trace()) > > ## > ## Missing parameters in call to Trace > ## > tools::assertError(Trace(movement = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + tEnd = "2005-10-31", + days = 90)) > > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to Trace > ## > tools::assertError(Trace(movement = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + days = 90)) > ## > ## Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in > ## call to Trace > ## > tools::assertError(Trace(movement = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1, + tEnd = "2005-10-31")) > > ## > ## movements must be a data.frame > ## > tools::assertError(Trace(movements = 1:3, + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## movements must contain the columns source, destination and t > ## > tools::assertError(Trace(movements = data.frame(destination = 1, t = 1), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## movements must contain the columns source, destination and t > ## > tools::assertError(Trace(movements = data.frame(source = 1, t = 1), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## movements must contain the columns source, destination and t > ## > tools::assertError(Trace(movements = data.frame(source = 1, destination = 1), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## invalid class of column t in movements > ## > tools::assertError(Trace(movements = data.frame(source = 1L, + destination = 2L, + t = 1), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## source in movements contains NA > ## > tools::assertError(Trace(movements = data.frame( + source = c(1L, NA), + destination = c(2L, 3L), + t = c("2011-08-10", "2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## destination in movements contains NA > ## > tools::assertError(Trace(movements = data.frame( + source = c(1L, 2L), + destination = c(2L, NA), + t = c("2011-08-10", "2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## t in movements contains NA > ## > tools::assertError(Trace(movements = data.frame( + source = c(1L, 2L), + destination = c(2L, 3L), + t = c("2011-08-10", NA)), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## t in movements contains NA > ## > tools::assertError(Trace(movements = data.frame( + source = c(1L, 2L), + destination = c(2L, 3L), + t = c("2011-08-10", NA)), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## invalid class of column n in movements > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10"), + n = "3"), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## invalid class of column id in movements > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10"), + n = 3L, + id = 4), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## invalid class of column category in movements > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10"), + n = 3L, + id = 4L, + category = 3), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## 'root' must be an integer or character > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1.1, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## 'inBegin' must be a Date vector > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = 2011, + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## 'inEnd' must be a Date vector > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = 2011, + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## 'outBegin' must be a Date vector > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = 2011, + outEnd = as.Date("2011-08-10"))) > > ## > ## 'outEnd' must be a Date vector > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = 2011)) > > ## > ## inEnd less than inBegin > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-07-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-08-10"))) > > ## > ## outEnd less than outBegin > ## > tools::assertError(Trace(movements = data.frame( + source = 1L, + destination = 2L, + t = as.Date("2011-08-10")), + root = 1L, + inBegin = as.Date("2011-08-10"), + inEnd = as.Date("2011-08-10"), + outBegin = as.Date("2011-08-10"), + outEnd = as.Date("2011-07-10"))) > > proc.time() user system elapsed 0.35 0.09 0.43 Running the tests in 'tests/contact-chain.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > > ## > ## Check in- and outgoing contact chain methods > ## > > ## > ## Case 1 > ## > > movements <- data.frame( + source = 1:7, + destination = c(4L, 5L, 5L, 6L, 8L, 8L, 8L), + t = structure(c(14849, 14846, 14847, 14850, 14848, 14851, 14852), + class = "Date")) > ct <- Trace(movements, + root = 8L, + inBegin = as.Date("2010-08-22"), + inEnd = as.Date("2010-10-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > ct Root: 8 <<< In contacts <<< In begin date: 2010-08-22 In end date: 2010-10-01 In days: 40 In degree: 3 Ingoing contact chain: 7 8 <-- 5 5 <-- 2 5 <-- 3 8 <-- 6 6 <-- 4 4 <-- 1 8 <-- 7 >>> Out contacts >>> Out begin date: 2010-08-01 Out end date: 2010-08-31 Out days: 30 Out degree: 0 Outgoing contact chain: 0 No outgoing contacts during the search period. > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 7L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 0L)) > > ## > ## Case 2 > ## > > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > ct <- Trace(movements, + root = 4L, + inBegin = as.Date("2010-07-22"), + inEnd = as.Date("2010-08-21"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > ct Root: 4 <<< In contacts <<< In begin date: 2010-07-22 In end date: 2010-08-21 In days: 30 In degree: 1 Ingoing contact chain: 3 4 <-- 3 3 <-- 1 3 <-- 2 >>> Out contacts >>> Out begin date: 2010-08-01 Out end date: 2010-08-31 Out days: 30 Out degree: 0 Outgoing contact chain: 0 No outgoing contacts during the search period. > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 3L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 0L)) > > ## > ## Case 3 > ## > > movements <- data.frame( + source = 1:2, + destination = c(2L, 1L), + t = structure(c(14834, 14834), class = "Date"), + individual = c(NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_)) > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-09-01"), + outEnd = as.Date("2010-10-01")) > ct Root: 1 <<< In contacts <<< In begin date: 2010-08-02 In end date: 2010-09-01 In days: 30 In degree: 1 Ingoing contact chain: 1 1 <-- 2 >>> Out contacts >>> Out begin date: 2010-09-01 Out end date: 2010-10-01 Out days: 30 Out degree: 0 Outgoing contact chain: 0 No outgoing contacts during the search period. > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 1L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 0L)) > > ## > ## Case 4 > ## > > movements <- data.frame( + source = c(1L, 2L, 2L, 1L, 3L, 7L, 1L), + destination = c(2L, 5L, 6L, 3L, 7L, 8L, 4L), + t = structure(c(14834, 14838, 14836, 14857, 14860, 14862, 14884), + class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, + NA_character_, NA_character_, NA_character_, + NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_, + NA_integer_, NA_integer_, NA_integer_)) > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-11-09")) > ct Root: 1 <<< In contacts <<< In begin date: 2010-08-02 In end date: 2010-09-01 In days: 30 In degree: 0 Ingoing contact chain: 0 No ingoing contacts during the search period. >>> Out contacts >>> Out begin date: 2010-08-01 Out end date: 2010-11-09 Out days: 100 Out degree: 3 Outgoing contact chain: 7 1 --> 2 2 --> 5 2 --> 6 1 --> 3 3 --> 7 7 --> 8 1 --> 4 > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 0L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 7L)) > > ## > ## Case 5 > ## > > movements <- data.frame( + source = 1:2, + destination = c(2L, 1L), + t = structure(c(14834, 14834), class = "Date"), + individual = c(NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_)) > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-07-02"), + inEnd = as.Date("2010-08-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > ct Root: 1 <<< In contacts <<< In begin date: 2010-07-02 In end date: 2010-08-01 In days: 30 In degree: 0 Ingoing contact chain: 0 No ingoing contacts during the search period. >>> Out contacts >>> Out begin date: 2010-08-01 Out end date: 2010-08-31 Out days: 30 Out degree: 1 Outgoing contact chain: 1 1 --> 2 > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 0L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 1L)) > > ## > ## Case 6 > ## > > movements <- data.frame( + source = c(1L, 2L, 1L, 2L, 1L, 3L, 1L), + destination = c(2L, 3L, 2L, 3L, 2L, 4L, 2L), + t = structure(c(1L, 2L, 3L, 4L, 7L, 6L, 5L), + .Label = c("2010-10-01", "2010-10-05", "2010-10-10", + "2010-10-15", "2010-10-20", "2010-10-25", + "2010-10-30"), + class = "factor")) > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-10-10"), + inEnd = as.Date("2010-10-20"), + outBegin = as.Date("2010-10-10"), + outEnd = as.Date("2010-10-20")) > ct Root: 1 <<< In contacts <<< In begin date: 2010-10-10 In end date: 2010-10-20 In days: 10 In degree: 0 Ingoing contact chain: 0 No ingoing contacts during the search period. >>> Out contacts >>> Out begin date: 2010-10-10 Out end date: 2010-10-20 Out days: 10 Out degree: 1 Outgoing contact chain: 2 1 --> 2 2 --> 3 > stopifnot(identical(IngoingContactChain(ct)$ingoingContactChain, 0L)) > stopifnot(identical(OutgoingContactChain(ct)$outgoingContactChain, 2L)) > > ## > ## Case 7 > ## > > movements <- data.frame( + source = c(1L, 2L, 1L, 2L, 1L, 3L, 1L), + destination = c(2L, 3L, 2L, 3L, 2L, 4L, 2L), + t = structure(c(1L, 2L, 3L, 4L, 7L, 6L, 5L), + .Label = c("2010-10-01", "2010-10-05", "2010-10-10", + "2010-10-15", "2010-10-20", "2010-10-25", + "2010-10-30"), + class = "factor")) > > ns <- NetworkSummary(movements, root = 1, tEnd = "2010-10-20", days = 10) > > df <- data.frame(root = "1", + inBegin = structure(14892, class = "Date"), + inEnd = structure(14902, class = "Date"), + inDays = 10L, + outBegin = structure(14892, class = "Date"), + outEnd = structure(14902, class = "Date"), + outDays = 10L, + inDegree = 0L, + outDegree = 1L, + ingoingContactChain = 0L, + outgoingContactChain = 2L, + stringsAsFactors = FALSE) > ns root inBegin inEnd inDays outBegin outEnd outDays inDegree 1 1 2010-10-10 2010-10-20 10 2010-10-10 2010-10-20 10 0 outDegree ingoingContactChain outgoingContactChain 1 1 0 2 > stopifnot(identical(ns, df)) > > proc.time() user system elapsed 0.43 0.01 0.43 Running the tests in 'tests/degree.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > > ## > ## Check in- and outgoing degree methods > ## > > ## > ## Case 1 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 4L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(InDegree(ct)$inDegree, 1L)) > stopifnot(identical(OutDegree(ct)$outDegree, 0L)) > > ## > ## Case 2 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 4, tEnd = "2010-09-01", days = 30) > stopifnot(identical(ns$inDegree, 1L)) > > ## > ## Case 3 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 4, tEnd = "2010-08-31", days = 30) > stopifnot(identical(ns$outDegree, 0L)) > > ## > ## Case 4 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 4L, + inBegin = as.Date("2010-08-27"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(InDegree(ct)$inDegree, 0L)) > stopifnot(identical(OutDegree(ct)$outDegree, 0L)) > > ## > ## Case 5 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 4, tEnd = "2010-09-01", days = 5) > stopifnot(identical(ns$inDegree, 0L)) > > ## > ## Case 6 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 4, tEnd = "2010-08-31", days = 30) > stopifnot(identical(ns$outDegree, 0L)) > > ## > ## Case 7 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(InDegree(ct)$inDegree, 0L)) > stopifnot(identical(OutDegree(ct)$outDegree, 3L)) > > ## > ## Case 8 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 1, tEnd = "2010-09-01", days = 30) > stopifnot(identical(ns$inDegree, 0L)) > > ## > ## Case 9 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 1, tEnd = "2010-08-31", days = 30) > stopifnot(identical(ns$outDegree, 3L)) > > ## > ## Case 10 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-16")) > > stopifnot(identical(InDegree(ct)$inDegree, 0L)) > stopifnot(identical(OutDegree(ct)$outDegree, 2L)) > > ## > ## Case 11 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 1, tEnd = "2010-09-01", days = 30) > stopifnot(identical(ns$inDegree, 0L)) > > ## > ## Case 12 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 1, tEnd = "2010-08-16", days = 15) > stopifnot(identical(ns$outDegree, 2L)) > > proc.time() user system elapsed 0.45 0.04 0.50 Running the tests in 'tests/misc.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > > ## > ## Some misc checking > ## > > ## > ## Loops: Case 1 > ## > movements <- data.frame(source = c(2L, 2L), + destination = c(1L, 2L), + t = as.Date(c("2010-10-03", "2010-10-02"))) > > ct <- Trace(movements, + root = 1L, + inBegin = as.Date("2010-09-30"), + inEnd = as.Date("2010-10-05"), + outBegin = as.Date("2010-10-05"), + outEnd = as.Date("2010-10-10")) > > stopifnot(identical(ct@ingoingContacts@source, "2")) > stopifnot(identical(ct@ingoingContacts@destination, "1")) > > ## > ## Loops: Case 2 > ## > movements <- data.frame(source = c(2L, 2L), + destination = c(1L, 2L), + t = as.Date(c("2010-10-03", "2010-10-02"))) > > ct <- Trace(movements, + root = 2L, + inBegin = as.Date("2010-09-30"), + inEnd = as.Date("2010-10-05"), + outBegin = as.Date("2010-09-30"), + outEnd = as.Date("2010-10-10")) > > stopifnot(identical(ct@outgoingContacts@source, "2")) > stopifnot(identical(ct@outgoingContacts@destination, "1")) > > ## > ## Direction: Case 1 > ## > movements <- data.frame( + source = 1:7, + destination = c(4L, 5L, 5L, 6L, 8L, 8L, 8L), + t = structure(c(14849, 14846, 14847, 14850, 14848, 14851, 14852), + class = "Date")) > > ct <- Trace(movements, + root = 4L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(ct@ingoingContacts@direction, "in")) > stopifnot(identical(ct@outgoingContacts@direction, "out")) > > ## > ## Direction: Case 2 > ## > movements <- data.frame( + source = c(1L, 2L, 3L, 3L), + destination = c(3L, 3L, 4L, 4L), + t = structure(c(14834, 14838, 14836, 14841), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 4L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(ct@ingoingContacts@direction, "in")) > stopifnot(identical(ct@outgoingContacts@direction, "out")) > > ## > ## Root not in movements: Case 1 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ct <- Trace(movements, + root = 15L, + inBegin = as.Date("2010-08-02"), + inEnd = as.Date("2010-09-01"), + outBegin = as.Date("2010-08-01"), + outEnd = as.Date("2010-08-31")) > > stopifnot(identical(InDegree(ct)$inDegree, 0L)) > stopifnot(identical(OutDegree(ct)$outDegree, 0L)) > > ## > ## Root not in movements: Case 2 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 15, tEnd = "2010-09-01", days = 30) > stopifnot(identical(ns$inDegree, 0L)) > > ## > ## Root not in movements: Case 3 > ## > movements <- data.frame( + source = c("1", "1", "1"), + destination = c("2", "3", "4"), + t = structure(c(14834, 14838, 14836), class = "Date"), + individual = c(NA_character_, NA_character_, NA_character_), + n = c(NA_integer_, NA_integer_, NA_integer_)) > > ns <- NetworkSummary(movements, root = 15, tEnd = "2010-08-31", days = 30) > stopifnot(identical(ns$outDegree, 0L)) > > ## > ## Duplicate movements: Case 1 > ## > movements <- data.frame( + source = c("2019", "2019", "2019", "2019", "2019", "2019", "2019", + "2019", "2019", "2019", "2036", "2036", "2036", "2036", + "2036", "2036", "2036", "2036", "2036", "2036", "2036", + "2036", "2036", "2036", "2036", "2357", "2357", "2846", + "2846", "2846", "2846", "2847", "2852", "2825", "2823", + "2839", "1375", "2357", "2357", "2357", "5615", "5615", + "5615", "5615", "5615", "5615", "5615", "5615", "5615", + "2890", "2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645", "2821", + "2821", "2645", "2825", "2825", "444", "4422", "4422", + "4422", "4422", "4422", "4422", "4422", "4422", "4422", + "4422", "1323", "1323", "1323", "1323", "1323", "1323", + "1323", "1323", "1323", "1323", "1323", "1323", "1323", + "1323", "1323", "1323", "1323", "1323", "1323", "1323", + "1323", "1323", "1323", "1323", "1323", "1323", "1323", + "1323", "1323", "1323", "1323", "1323", "1323", "1323", + "1323", "1323", "1323", "1323", "1323", "1323", "1323", + "4422", "4422", "4422", "4422", "4422", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "585", "585", + "585", "585", "585", "585", "585", "585", "585", "585", + "585", "585", "585", "585", "264", "264", "264", "264", + "264", "264", "264", "264", "264", "264", "264", "264", + "264", "264", "264", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645"), + destination = c("2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2645", "2645", "2645", + "2645", "2645", "2645", "2852", "2825", "2825", + "2839", "2839", "2839", "2839", "2839", "2839", + "2839", "2839", "2839", "2839", "2839", "2839", + "2839", "2825", "10644", "10644", "10644", + "10644", "10644", "10697", "2821", "2821", "2821", + "2821", "2821", "2821", "2820", "2880", "2825", + "2823", "444", "4422", "10071", "10071", "10071", + "10072", "10072", "10072", "10072", "10072", + "1323", "1323", "10071", "10071", "10071", + "10071", "10071", "10195", "10195", "10195", + "10195", "10195", "10196", "3354", "3354", "3354", + "3354", "3354", "3354", "3354", "3354", "3354", + "3354", "3354", "3354", "8750", "8750", "8750", + "8750", "8750", "8750", "8750", "8750", "8750", + "8750", "8750", "8750", "8750", "8750", "8750", + "8750", "8750", "8750", "3362", "3362", "3362", + "3362", "3362", "2839", "585", "585", "585", + "585", "585", "585", "264", "264", "264", "264", + "264", "264", "264", "264", "264", "264", "264", + "264", "264", "264", "584", "584", "584", "584", + "584", "584", "584", "584", "584", "584", "584", + "584", "584", "584", "584", "9789", "9789", + "9789", "9789", "9789", "9789", "9789", "9789", + "9789", "9966"), + t = structure(c(13071, 13071, 13071, 13071, 13071, 13071, 13071, + 13071, 13071, 13071, 13080, 13080, 13080, 13080, + 13080, 13080, 13080, 13080, 13080, 13080, 13080, + 13080, 13080, 13080, 13080, 13054, 13078, 13045, + 13045, 13045, 13045, 13078, 13078, 13078, 13078, + 13078, 13078, 13070, 13070, 13070, 13070, 13070, + 13070, 13070, 13070, 13070, 13070, 13070, 13070, + 13078, 13069, 13069, 13069, 13069, 13069, 13078, + 13011, 13011, 13011, 13011, 13011, 13011, 13034, + 13034, 13078, 13078, 13078, 13078, 13081, 13081, + 13081, 13085, 13085, 13085, 13085, 13085, 13080, + 13080, 13083, 13083, 13083, 13083, 13083, 13081, + 13081, 13081, 13083, 13081, 13082, 13081, 13081, + 13081, 13081, 13081, 13081, 13081, 13081, 13081, + 13081, 13081, 13081, 13087, 13087, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13087, + 13085, 13085, 13085, 13085, 13085, 13078, 13083, + 13083, 13083, 13083, 13083, 13083, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13087, + 13087, 13087, 13087, 13087, 13087, 13087, 13049, + 13049, 13049, 13049, 13049, 13049, 13049, 13049, + 13049, 13043), class = "Date"), + id = c("034A8", "034A9", "034AA", "034AB", "034AC", "034AD", + "034AE", "034AF", "034B0", "034B1", "0355B", "04EBB", "05697", + "061B0", "06518", "09193", "0A9B3", "0A9B4", "0A9B5", "0A9B6", + "0A9B7", "0A9B8", "0A9B9", "0A9BA", "0A9BB", "05D5F", "0A9BF", + "0944D", "0A9A1", "0A9A2", "0A9BC", "0A9BD", "0A9BE", "06551", + "06414", "06552", "0A34A", "0A354", "0A355", "0A356", "0A34B", + "0A34C", "0A34D", "0A34E", "0A34F", "0A350", "0A351", "0A352", + "0A353", "06554", "0A5E0", "0A5E1", "0A5E2", "0A5E3", "0A5E4", + "0A9A9", "044F8", "04A07", "04A09", "04A0A", "04A0B", "04A0C", + "049E3", "04A4F", "06553", "06416", "06550", "075C9", "075BB", + "075BF", "075C4", "075C1", "075C5", "075C6", "075C7", "075C8", + "075B9", "075BE", "0A9E9", "0A9EC", "0A9ED", "0A9EE", "0A9F2", + "07F27", "07F28", "07F29", "07F2A", "07F2B", "07F2D", "0554F", + "05550", "0556D", "0556E", "0556F", "05570", "05571", "05572", + "05573", "05574", "05575", "05576", "0210D", "0210E", "0210F", + "02110", "02111", "02112", "02113", "02114", "02115", "02116", + "02117", "02118", "02119", "0211A", "0211B", "0211C", "0211D", + "0211E", "075BA", "075BC", "075BD", "075C0", "075C2", "0A349", + "0A9A8", "0A9AA", "0A9AB", "0A9AC", "0A9AD", "0A9AE", "00EF8", + "00EF9", "00EFA", "00EFB", "00EFC", "00EFD", "00EFE", "00EFF", + "00F00", "00F01", "00F02", "00F03", "00F04", "00F05", "00EF2", + "00EF3", "00EF5", "00EF6", "00EF7", "00F06", "00F07", "00F09", + "00F0A", "00F0B", "00F0D", "00F0E", "00F10", "00F12", "00F13", + "0A9A3", "0A9A4", "0A9A5", "0A9A6", "0A9A7", "0A9AF", "0A9B0", + "0A9B1", "0A9B2", "06E4F"), + n = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), + category = c("Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle", + "Cattle", "Cattle", "Cattle", "Cattle", "Cattle")) > > ct.1 <- Trace(movements, 2645, "2005-10-31", 90) > ct.1.df <- as(ct.1, "data.frame") > > ct.2 <- Trace(ct.1.df, 2645, "2005-10-31", 90) > ct.2.df <- as(ct.2, "data.frame") > > ct.1.df <- ct.1.df[, c("source", + "destination", + "t", + "id", + "n", + "category")] > > ct.2.df <- ct.2.df[, c("source", + "destination", + "t", + "id", + "n", + "category")] > > ct.1.df <- ct.1.df[order(ct.1.df$source, + ct.1.df$destination, + ct.1.df$t, + ct.1.df$id, + ct.1.df$n, + ct.1.df$category), ] > > ct.2.df <- ct.2.df[order(ct.2.df$source, + ct.2.df$destination, + ct.2.df$t, + ct.2.df$id, + ct.2.df$n, + ct.2.df$category), ] > > rownames(ct.1.df) <- NULL > rownames(ct.2.df) <- NULL > > stopifnot(identical(ct.2.df, ct.1.df)) > > proc.time() user system elapsed 0.60 0.07 0.62 Running the tests in 'tests/network-summary.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > data(transfers) > > ## > ## Check NetworkSummary > ## > > ## > ## Case 1 > ## > load(file = system.file("extdata", "ns.rda", package = "EpiContactTrace")) > root <- sort(unique(c(transfers$source, transfers$destination))) > result <- NetworkSummary(transfers, root = root, tEnd = "2005-10-31", days = 90) > stopifnot(identical(result, ns)) > > ## > ## Case 2 > ## > ns <- NetworkSummary(transfers, root = 584, tEnd = "2005-10-31", days = 91) > ns.trace <- NetworkSummary(Trace(transfers, + root = 584, + tEnd = "2005-10-31", + days = 91)) > stopifnot(identical(ns, ns.trace)) > > ## > ## Case 3 > ## > root <- c(2645, 2838) > tEnd <- "2005-10-31" > days <- 90 > contactTrace <- Trace(transfers, root, tEnd, days) > NetworkSummary(contactTrace) root inBegin inEnd inDays outBegin outEnd outDays inDegree 2645 2645 2005-08-02 2005-10-31 90 2005-08-02 2005-10-31 90 6 2838 2838 2005-08-02 2005-10-31 90 2005-08-02 2005-10-31 90 1 outDegree ingoingContactChain outgoingContactChain 2645 8 12 24 2838 1 1 3 > NetworkStructure(contactTrace) root inBegin inEnd outBegin outEnd direction source 1 2645 2005-08-02 2005-10-31 in 2019 2 2645 2005-08-02 2005-10-31 in 2036 3 2645 2005-08-02 2005-10-31 in 2357 4 2645 2005-08-02 2005-10-31 in 2846 5 2645 2005-08-02 2005-10-31 in 2847 6 2645 2005-08-02 2005-10-31 in 2852 7 2645 2005-08-02 2005-10-31 in 2825 8 2645 2005-08-02 2005-10-31 in 2823 9 2645 2005-08-02 2005-10-31 in 2839 10 2645 2005-08-02 2005-10-31 in 1375 11 2645 2005-08-02 2005-10-31 in 2357 12 2645 2005-08-02 2005-10-31 in 5615 13 2645 2005-08-02 2005-10-31 in 2890 14 2645 2005-08-02 2005-10-31 out 2645 15 2645 2005-08-02 2005-10-31 out 2645 16 2645 2005-08-02 2005-10-31 out 2645 17 2645 2005-08-02 2005-10-31 out 2821 18 2645 2005-08-02 2005-10-31 out 2821 19 2645 2005-08-02 2005-10-31 out 2645 20 2645 2005-08-02 2005-10-31 out 2825 21 2645 2005-08-02 2005-10-31 out 2825 22 2645 2005-08-02 2005-10-31 out 2825 23 2645 2005-08-02 2005-10-31 out 444 24 2645 2005-08-02 2005-10-31 out 4422 25 2645 2005-08-02 2005-10-31 out 4422 26 2645 2005-08-02 2005-10-31 out 4422 27 2645 2005-08-02 2005-10-31 out 1323 28 2645 2005-08-02 2005-10-31 out 1323 29 2645 2005-08-02 2005-10-31 out 1323 30 2645 2005-08-02 2005-10-31 out 1323 31 2645 2005-08-02 2005-10-31 out 1323 32 2645 2005-08-02 2005-10-31 out 4422 33 2645 2005-08-02 2005-10-31 out 2645 34 2645 2005-08-02 2005-10-31 out 2839 35 2645 2005-08-02 2005-10-31 out 2825 36 2645 2005-08-02 2005-10-31 out 2825 37 2645 2005-08-02 2005-10-31 out 2825 38 2645 2005-08-02 2005-10-31 out 444 39 2645 2005-08-02 2005-10-31 out 4422 40 2645 2005-08-02 2005-10-31 out 4422 41 2645 2005-08-02 2005-10-31 out 4422 42 2645 2005-08-02 2005-10-31 out 1323 43 2645 2005-08-02 2005-10-31 out 1323 44 2645 2005-08-02 2005-10-31 out 1323 45 2645 2005-08-02 2005-10-31 out 1323 46 2645 2005-08-02 2005-10-31 out 1323 47 2645 2005-08-02 2005-10-31 out 4422 48 2645 2005-08-02 2005-10-31 out 2645 49 2645 2005-08-02 2005-10-31 out 585 50 2645 2005-08-02 2005-10-31 out 264 51 2645 2005-08-02 2005-10-31 out 2645 52 2645 2005-08-02 2005-10-31 out 2645 53 2838 2005-08-02 2005-10-31 in 446 54 2838 2005-08-02 2005-10-31 out 2838 55 2838 2005-08-02 2005-10-31 out 2821 56 2838 2005-08-02 2005-10-31 out 2821 destination distance 1 2645 1 2 2645 1 3 2645 1 4 2645 1 5 2645 1 6 2645 1 7 2852 2 8 2825 3 9 2825 3 10 2839 4 11 2839 4 12 2839 4 13 2825 3 14 10644 1 15 10697 1 16 2821 1 17 2820 2 18 2880 2 19 2825 1 20 2823 2 21 2852 2 22 444 2 23 4422 3 24 10071 4 25 10072 4 26 1323 4 27 10071 5 28 10195 5 29 10196 5 30 3354 5 31 8750 5 32 3362 4 33 2839 1 34 2825 2 35 2823 3 36 2852 3 37 444 3 38 4422 4 39 10071 5 40 10072 5 41 1323 5 42 10071 6 43 10195 6 44 10196 6 45 3354 6 46 8750 6 47 3362 5 48 585 1 49 264 2 50 584 3 51 9789 1 52 9966 1 53 2838 1 54 2821 1 55 2820 2 56 2880 2 > > proc.time() user system elapsed 4.75 0.18 4.90 Running the tests in 'tests/tree.R' failed. Complete output: > ## Copyright 2013-2020 Stefan Widgren and Maria Noremark, > ## National Veterinary Institute, Sweden > ## > ## Licensed under the EUPL, Version 1.1 or - as soon they > ## will be approved by the European Commission - subsequent > ## versions of the EUPL (the "Licence"); > ## You may not use this work except in compliance with the > ## Licence. > ## You may obtain a copy of the Licence at: > ## > ## http://ec.europa.eu/idabc/eupl > ## > ## Unless required by applicable law or agreed to in > ## writing, software distributed under the Licence is > ## distributed on an "AS IS" basis, > ## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either > ## express or implied. > ## See the Licence for the specific language governing > ## permissions and limitations under the Licence. > > library(EpiContactTrace) > > ## > ## Node position checking > ## > > ## > ## Case 1 > ## > tree <- data.frame( + node = c("O", "E", "F", "N", "A", "D", "G", "M", + "B", "C", "H", "I", "J", "K", "L"), + parent = c(NA, "O", "O", "O", "E", "E", "N", "N", + "D", "D", "M", "M", "M", "M", "M"), + level = c(0, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3), + stringsAsFactors = FALSE) > > tree_exp <- data.frame( + node = c("O", "E", "F", "N", "A", "D", "G", "M", + "B", "C", "H", "I", "J", "K", "L"), + parent = c(NA, "O", "O", "O", "E", "E", "N", "N", + "D", "D", "M", "M", "M", "M", "M"), + level = c(0, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3), + x = c(0, -10.5, 0, 10.5, -13.5, -7.5, 7.5, 13.5, -10.5, + -4.5, 1.5, 7.5, 13.5, 19.5, 25.5), + y = c(0, -1, -1, -1, -2, -2, -2, -2, -3, -3, -3, -3, -3, + -3, -3), + stringsAsFactors = FALSE) > > tree_obs <- EpiContactTrace:::position_tree(tree) > tree_obs$level <- as.numeric(tree_obs$level) > str(tree_obs) 'data.frame': 15 obs. of 5 variables: $ node : chr "O" "E" "F" "N" ... $ parent: chr NA "O" "O" "O" ... $ level : num 0 1 1 1 2 2 2 2 3 3 ... $ x : num 0 -10.5 0 10.5 -13.5 -7.5 7.5 13.5 -10.5 -4.5 ... $ y : num 0 -1 -1 -1 -2 -2 -2 -2 -3 -3 ... > stopifnot(identical(tree_obs, tree_exp)) > > proc.time() user system elapsed 0.28 0.06 0.32 * checking PDF version of manual ... [28s] OK * checking HTML version of manual ... [4s] OK * DONE Status: 1 ERROR