## 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 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 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 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 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 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 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 stopifnot(identical(ns, df))