## This file is part of SimInf, a framework for stochastic
## disease spread simulations.
##
## Copyright (C) 2022 Ivana Rodriguez Ewerlöf
## Copyright (C) 2015 -- 2024 Stefan Widgren
##
## SimInf is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 3 of the License, or
## (at your option) any later version.
##
## SimInf is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program.  If not, see <https://www.gnu.org/licenses/>.

library(SimInf)
library(tools)
source("util/check.R")

## Specify the number of threads to use.
set_num_threads(1)

## For debugging
sessionInfo()

## Check to pass vectors of different lengths.
res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    integer(0),
    c(0L, 3L),
    c(1L, 2L),
    c(1L, 1L),
    c(0L, 2L)))
check_error(res, "'event' must be an integer vector with length 0.")

res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    c(1L, 1L),
    c(0L),
    c(1L, 2L),
    c(1L, 1L),
    c(0L, 2L)))
check_error(res, "'event' must be an integer vector with length 2.")

res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    c(1L, 1L),
    c(0L, 3L),
    c(1L),
    c(1L, 1L),
    c(0L, 2L)))
check_error(res, "'time' must be an integer vector with length 2.")

res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    c(1L, 1L),
    c(0L, 3L),
    c(1L, 2L),
    c(1L),
    c(0L, 2L)))
check_error(res, "'node' must be an integer vector with length 2.")

res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    c(1L, 1L),
    c(0L, 3L),
    c(1L, 2L),
    c(1L, 1L),
    c(0L)))
check_error(res, "'dest' must be an integer vector with length 2.")

res <- assertError(.Call(
    SimInf:::SimInf_clean_indiv_events,
    c(1L, 1L),
    c(0L, 2L),
    c(1L, 2L),
    c(1L, 1L),
    c(0L, 2L)))
check_error(res, "'event[2]' is invalid.")

## Check various errors in event data.
res <- assertError(individual_events(1L))
check_error(res, "Missing columns in 'events'.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, NA_integer_, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'event' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1, 3.1, 3, 0),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'event' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 4L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'event' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c("enter", "unknown", "extTrans", "exit"),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'event' type must be 'enter', 'exit', or 'extTrans'.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(TRUE, TRUE, TRUE, TRUE),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'event' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, NA_integer_, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'time' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1, 2.1, 3, 4),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'time' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(TRUE, TRUE, TRUE, TRUE),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'time' must be an integer or character vector with non-NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(NA_integer_, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'node' or 'dest' contain NA values.")

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, NA_integer_, 2L, 1L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'node' or 'dest' contain NA values.")

## Check individual events.
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 1L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 2L, 4L),
    node  = c(1L, 1L, 2L),
    dest  = c(NA_integer_, 2L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c("1", "1", "2", "2"),
    dest  = c("0", "2", "2", "1"))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 2L, 4L),
    node  = c("1", "1", "2"),
    dest  = c(NA_character_, "2", NA_character_))

stopifnot(identical(events_obs, events_exp))

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 2L, 4L),
    node  = c(1L, 1L, 2L),
    dest  = c(NA_integer_, 2L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c("A", "A", "B", "B"),
    dest  = c("0", "B", "B", "0"))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 2L, 4L),
    node  = c("A", "A", "B"),
    dest  = c(NA_character_, "B", NA_character_))

stopifnot(identical(events_obs, events_exp))

events <- data.frame(
    id    = c("A", "A", "A", "A"),
    event = c("enter", "extTrans", "extTrans", "exit"),
    time  = c("2019-02-02", "2020-03-07", "2021-04-14", "2022-05-11"),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id = c("A", "A", "A"),
    event = c("enter", "extTrans", "exit"),
    time  = as.Date(c("2019-02-02", "2020-03-07", "2022-05-11")),
    node = c(1L, 1L, 2L),
    dest = c(NA_integer_, 2L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

events$id[2] <- NA_integer_
res <- assertError(individual_events(events))
check_error(
    res,
    "'id' must be an integer or character vector with non-NA values.")
events$id[2] <- 1L

events$node[2] <- 1.1
res <- assertError(individual_events(events))
check_error(
    res,
    "'node' and 'dest' must both be integer or character.")
events$node <- c(1L, 1L, 2L, 2L)

events$dest <- as.Date(events$dest, origin = "1970-01-01")
res <- assertError(individual_events(events))
check_error(
    res,
    "'node' and 'dest' must both be integer or character.")
events$dest <- c(0L, 2L, 2L, 0L)

events <- data.frame(
    id    = c("A", "A", "A", "A"),
    event = c("enter", "extTrans", "extTrans", "exit"),
    time  = c("2001-02-01", 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 2L, 0L))
res <- assertError(individual_events(events))
check_error(
    res,
    "'time' must be an integer or character vector with non-NA values.")

## Testing animal with only one enter event, keep
events <- data.frame(
    id    = 1L,
    event = 1L,
    time  = 1L,
    node  = 1L,
    dest  = 0L)

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = 1L,
    event = 1L,
    time  = 1L,
    node  = 1L,
    dest  = NA_integer_)

stopifnot(identical(events_obs, events_exp))

## Testing animal with only one exit event, keep
events <- data.frame(
    id    = 1L,
    event = 0L,
    time  = 1L,
    node  = 1L,
    dest  = 0L)

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = 1L,
    event = 0L,
    time  = 1L,
    node  = 1L,
    dest  = NA_integer_)

stopifnot(identical(events_obs, events_exp))

## Testing animal with only one external transfer event, keep
events <- data.frame(
    id    = 1L,
    event = 3L,
    time  = 1L,
    node  = 1L,
    dest  = 2L)

stopifnot(identical(events, as.data.frame(individual_events(events))))

## Testing animal with two enter events, keep first
events <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 1L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = 1L,
    event = 1L,
    time  = 1L,
    node  = 1L,
    dest  = NA_integer_)

stopifnot(identical(events_obs, events_exp))

## Testing animal with two exit events, keep first
events <- data.frame(
    id    = c(1L, 1L),
    event = c(0L, 0L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = 1L,
    event = 0L,
    time  = 1L,
    node  = 1L,
    dest  = NA_integer_)

stopifnot(identical(events_obs, events_exp))

## Testing animal with two enter events and exit, keep path
events <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 1L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 2L, 2L),
    dest  = c(0L, 0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(2L, 3L),
    node  = c(2L, 2L),
    dest  = c(NA_integer_, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with two enter events, a movement and an exit, keep
## path
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 1L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 2L, 1L, 3L),
    dest  = c(0L, 0L, 3L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 3L, 4L),
    node  = c(1L, 1L, 3L),
    dest  = c(NA_integer_, 3L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with one enter event and two exit events, keep path
events <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 0L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 2L, 1L),
    dest  = c(0L, 0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(1L, 3L),
    node  = c(1L, 1L),
    dest  = c(NA_integer_, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with one enter event and two exit events, keep path
events <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 0L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 1L, 2L),
    dest  = c(0L, 0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(NA_integer_, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with another event after exit event, exit event
## should be last
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 0L, 3L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 2L, 2L),
    dest  = c(0L, 2L, 0L, 3L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 1L, 2L),
    dest  = c(NA_integer_, 2L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with another event after exit event,
## no path to exit, don't keep
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(1L, 3L, 0L, 3L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 3L, 2L),
    dest  = c(0L, 2L, 0L, 3L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = integer(0),
    event = integer(0),
    time  = integer(0),
    node  = integer(0),
    dest  = integer(0))

stopifnot(identical(events_obs, events_exp))

## Testing animal with another event before enter event, enter event
## should be first
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(3L, 1L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 1L, 1L, 2L),
    dest  = c(2L, 0L, 2L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(1L, 3L, 0L),
    time  = c(2L, 3L, 4L),
    node  = c(1L, 1L, 2L),
    dest  = c(NA_integer_, 2L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

pdf_file <- tempfile(fileext = ".pdf")
pdf(pdf_file)
plot(individual_events(events))
dev.off()
stopifnot(file.exists(pdf_file))
unlink(pdf_file)

## Testing animal with another event before enter event, keep path if
## starting on enter event and ending with exit
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(3L, 1L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 2L, 1L, 2L),
    dest  = c(2L, 0L, 2L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(2L, 4L),
    node  = c(2L, 2L),
    dest  = c(NA_integer_, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with no path from enter to exit event, don't keep
events <- data.frame(
    id    = c(1L, 1L, 1L, 1L),
    event = c(3L, 1L, 3L, 0L),
    time  = c(1L, 2L, 3L, 4L),
    node  = c(1L, 2L, 2L, 3L),
    dest  = c(2L, 0L, 1L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = integer(0),
    event = integer(0),
    time  = integer(0),
    node  = integer(0),
    dest  = integer(0))

stopifnot(identical(events_obs, events_exp))

## Testing animal with no enter event, keep path
events <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(3L, 3L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 2L, 1L),
    dest  = c(2L, 1L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L, 1L),
    event = c(3L, 3L, 0L),
    time  = c(1L, 2L, 3L),
    node  = c(1L, 2L, 1L),
    dest  = c(2L, 1L, NA_integer_))

stopifnot(identical(events_obs, events_exp))

## Testing animal with no enter or exit event, keep path
events <- data.frame(
    id    = c(1L, 1L),
    event = c(3L, 3L),
    time  = c(1L, 2L),
    node  = c(1L, 2L),
    dest  = c(2L, 3L))

events_obs <- as.data.frame(individual_events(events))

stopifnot(identical(events_obs, events))

## Testing animal with no exit event, keep path
events <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 3L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(0L, 2L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 3L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(NA_integer_, 2L))

stopifnot(identical(events_obs, events_exp))

## Testing animal with only enter and exit event, keep path
events <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = c(1L, 1L),
    event = c(1L, 0L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(NA_integer_, NA_integer_))

stopifnot(identical(events_obs, events_obs))

## Testing animal with enter and exit event in wrong order, don't keep
events <- data.frame(
    id    = c(1L, 1L),
    event = c(0L, 1L),
    time  = c(1L, 2L),
    node  = c(1L, 1L),
    dest  = c(0L, 0L))

events_obs <- as.data.frame(individual_events(events))

events_exp <- data.frame(
    id    = integer(0),
    event = integer(0),
    time  = integer(0),
    node  = integer(0),
    dest  = integer(0))

stopifnot(identical(events_obs, events_exp))

## Check converting individual events to u0
events <- data.frame(
    id    = c(1, 1, 1, 1,
              2, 2, 2, 2),
    event = c(1, 3, 3, 0,
              1, 3, 3, 0),
    time  = c(1, 2, 3, 4,
              2, 3, 4, 5),
    node  = c(10, 10, 20, 20,
              10, 10, 20, 20),
    dest  = c(NA, 20, 20, NA,
              NA, 20, 20, NA))

stopifnot(identical(
    u0(individual_events(events), time = 0),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 1),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(1L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(1L, 1L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, target = "SIS"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S = c(1L, 1L),
               I = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, target = "SISe"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S = c(1L, 1L),
               I = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, target = "SISe_sp"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S = c(1L, 1L),
               I = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, target = "SIR"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S = c(1L, 1L),
               I = c(0L, 0L),
               R = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, target = "SEIR"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S = c(1L, 1L),
               E = c(0L, 0L),
               I = c(0L, 0L),
               R = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, age = c(1, 2), target = "SISe3"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(1L, 0L),
               S_2 = c(0L, 1L),
               S_3 = c(0L, 0L),
               I_1 = c(0L, 0L),
               I_2 = c(0L, 0L),
               I_3 = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 2, age = c(1, 2), target = "SISe3_sp"),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(1L, 0L),
               S_2 = c(0L, 1L),
               S_3 = c(0L, 0L),
               I_1 = c(0L, 0L),
               I_2 = c(0L, 0L),
               I_3 = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 3),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 2L))))

stopifnot(identical(
    u0(individual_events(events), time = 4),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 1L))))

stopifnot(identical(
    u0(individual_events(events), time = 5),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 3, age = 2),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 1L),
               S_2 = c(0L, 1L))))

stopifnot(identical(
    u0(individual_events(events), time = 3, age = 5),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 2L),
               S_2 = c(0L, 0L))))

stopifnot(identical(
    u0(individual_events(events), time = 3, age = 1),
    data.frame(key = c(10, 20),
               node = c(1L, 2L),
               S_1 = c(0L, 0L),
               S_2 = c(0L, 2L))))

res <- assertError(u0(individual_events(events),
                      time = 3,
                      age = 1,
                      target = "SIR"))
check_error(
    res,
    "Invalid 'age' for 'target' model.")

res <- assertError(u0(individual_events(events), time = 4.3))
check_error(
    res,
    "'time' must be an integer or date.")

res <- assertError(u0(individual_events(events),
                      time = c("2021-01-01", "2022-01-01")))
check_error(
    res,
    "'time' must be an integer or date.")

res <- assertError(u0(individual_events(events), time = "2021-01-01"))
check_error(
    res,
    "'time' must be an integer.")

res <- assertError(u0(individual_events(events), time = list()))
check_error(
    res,
    "'time' must be an integer or date.")

res <- assertError(u0(individual_events(events), time = 3, age = -1))
check_error(
    res,
    "'age' must be an integer vector with values > 0.")

res <- assertError(SimInf:::u0_target(u0(individual_events(events),
                                         time = 2),
                                      target = "Unknown"))
check_error(
    res,
    "Invalid 'target' for 'u0'.")

events <- data.frame(
    id    = c("individual-1", "individual-1", "individual-1", "individual-1",
              "individual-2", "individual-2", "individual-2", "individual-2"),
    event = c("enter", "extTrans", "extTrans", "exit",
              "enter", "extTrans", "extTrans", "exit"),
    time  = c("2019-02-02", "2020-03-07", "2021-04-14", "2022-05-11",
              "2019-02-02", "2020-03-07", "2021-04-14", "2022-05-11"),
    node  = c("node-1", "node-1", "node-2", "node-2",
              "node-1", "node-1", "node-2", "node-2"),
    dest  = c(NA, "node-2", "node-2", NA,
              NA, "node-2", "node-2", NA))

u0_obs <- u0(individual_events(events))

u0_exp <- data.frame(
    key = c("node-1", "node-2"),
    node = c(1L, 2L),
    S_1 = c(2L, 0L))

stopifnot(identical(u0_obs, u0_exp))

u0_obs <- u0(individual_events(events[rev(seq_len(nrow(events))), ]))

stopifnot(identical(u0_obs, u0_exp))

stopifnot(identical(
    get_individuals(individual_events(events), "2019-02-02"),
    data.frame(
        id = c("individual-1", "individual-2"),
        node = c("node-1", "node-1"),
        age = c(0L, 0L))))

stopifnot(identical(
    get_individuals(individual_events(events), "2019-02-04"),
    data.frame(
        id = c("individual-1", "individual-2"),
        node = c("node-1", "node-1"),
        age = c(2L, 2L))))

stopifnot(identical(
    get_individuals(individual_events(events), "2019-02-01"),
    data.frame(
        id = character(0),
        node = logical(0),
        age = integer(0))))

show_expected <- c(
    "Number of individuals: 2",
    "Number of events: 6")
show_observed <- capture.output(show(individual_events(events)))
stopifnot(identical(show_observed, show_expected))

summary_expected <- c(
    "Number of individuals: 2",
    "Number of events: 6",
    " - Exit: 2",
    " - Enter: 2",
    " - Internal transfer: 0",
    " - External transfer: 2")
summary_observed <- capture.output(summary(individual_events(events)))
stopifnot(identical(summary_observed, summary_expected))

events <- data.frame(
    id    = c(1, 1),
    event = c("extTrans", "exit"),
    time  = c(2, 3),
    node  = c(1, 2),
    dest  = c(2, 0))
res <- assertError(get_individuals(individual_events(events)))
check_error(
    res,
    "All individuals must have an 'enter' event.")

res <- assertError(node_events(individual_events(events)))
check_error(
    res,
    "All individuals must have an 'enter' event.")

res <- assertError(SimInf:::check_indiv_events_id(3.2))
check_error(
    res,
    "'id' must be an integer or character vector with non-NA values.")

res <- assertError(SimInf:::check_indiv_events_id(NULL))
check_error(
    res,
    "'id' must be an integer or character vector with non-NA values.")

## Test to generate events and u0
events <- data.frame(
    id = c("animal-06", "animal-03", "animal-03", "animal-03",
           "animal-08", "animal-03", "animal-03", "animal-06",
           "animal-08", "animal-08", "animal-06", "animal-08",
           "animal-08", "animal-06", "animal-06", "animal-05",
           "animal-07", "animal-05", "animal-05", "animal-05",
           "animal-05", "animal-10", "animal-01", "animal-04",
           "animal-04", "animal-04", "animal-01", "animal-01",
           "animal-05", "animal-05", "animal-08", "animal-08",
           "animal-01", "animal-01", "animal-09", "animal-10",
           "animal-09", "animal-09", "animal-02", "animal-11",
           "animal-11", "animal-11", "animal-11", "animal-11",
           "animal-11", "animal-11"),
    event = c("enter", "enter", "extTrans", "extTrans", "enter",
              "exit", "exit", "extTrans", "extTrans", "extTrans",
              "extTrans", "extTrans", "extTrans", "exit", "exit",
              "enter", "enter", "extTrans", "extTrans", "extTrans",
              "extTrans", "enter", "enter", "enter", "exit", "exit",
              "extTrans", "extTrans", "exit", "exit", "exit", "exit",
              "exit", "exit", "enter", "exit", "extTrans", "extTrans",
              "enter", "enter", "extTrans", "extTrans", "extTrans",
              "extTrans", "exit", "exit"),
    time = c("2015-01-31", "2015-04-01", "2015-05-27", "2015-05-27",
             "2015-10-14", "2015-12-25", "2015-12-26", "2016-05-23",
             "2016-06-01", "2016-10-12", "2016-10-28", "2017-03-01",
             "2017-03-01", "2017-03-09", "2017-03-09", "2017-04-25",
             "2017-08-30", "2017-12-21", "2017-12-21", "2017-12-22",
             "2017-12-22", "2018-03-30", "2019-05-30", "2019-07-06",
             "2019-07-16", "2019-07-17", "2019-08-14", "2019-08-14",
             "2020-03-31", "2020-04-01", "2020-07-13", "2020-07-14",
             "2021-02-09", "2021-02-09", "2022-02-01", "2022-04-10",
             "2022-07-25", "2022-07-25", "2022-12-09", "2017-04-25",
             "2017-12-21", "2017-12-21", "2017-12-22", "2017-12-22",
             "2020-03-31", "2020-04-01"),
    node = c("node-08", "node-03", "node-03", "node-03", "node-12",
             "node-05", "node-05", "node-08", "node-12", "node-13",
             "node-07", "node-12", "node-12", "node-08", "node-08",
             "node-06", "node-11", "node-06", "node-06", "node-09",
             "node-09", "node-17", "node-01", "node-04", "node-04",
             "node-04", "node-01", "node-01", "node-16", "node-16",
             "node-18", "node-18", "node-10", "node-10", "node-14",
             "node-17", "node-14", "node-14", "node-02", "node-06",
             "node-06", "node-06", "node-09", "node-09", "node-16",
             "node-16"),
    dest = c(NA, NA, "node-05", "node-05", NA, NA, NA, "node-07",
             "node-13", "node-12", "node-08", "node-18", "node-18",
             NA, NA, NA, NA, "node-09", "node-09", "node-16",
             "node-16", NA, NA, NA, NA, NA, "node-10", "node-10", NA,
             NA, NA, NA, NA, NA, NA, NA, "node-15", "node-15", NA,
             NA, "node-09", "node-09", "node-16", "node-16", NA, NA))

events_expected <- data.frame(
    event = c("enter", "extTrans", "enter", "exit", "extTrans",
              "extTrans", "extTrans", "extTrans", "extTrans", "exit",
              "enter", "enter", "extTrans", "extTrans", "enter",
              "enter", "enter", "exit", "extTrans", "exit", "exit",
              "exit", "enter", "exit", "extTrans", "enter"),
    time = c("2015-04-01", "2015-05-27", "2015-10-14", "2015-12-25",
             "2016-05-23", "2016-06-01", "2016-10-12", "2016-10-28",
             "2017-03-01", "2017-03-09", "2017-04-25", "2017-08-30",
             "2017-12-21", "2017-12-22", "2018-03-30", "2019-05-30",
             "2019-07-06", "2019-07-16", "2019-08-14", "2020-03-31",
             "2020-07-13", "2021-02-09", "2022-02-01", "2022-04-10",
             "2022-07-25", "2022-12-09"),
    node = c(3L, 3L, 12L, 5L, 8L, 12L, 13L, 7L, 12L, 8L, 6L, 11L, 6L,
             9L, 17L, 1L, 4L, 4L, 1L, 16L, 18L, 10L, 14L, 17L, 14L,
             2L),
    dest = c(0L, 5L, 0L, 0L, 7L, 13L, 12L, 8L, 18L, 0L, 0L, 0L, 9L,
             16L, 0L, 0L, 0L, 0L, 10L, 0L, 0L, 0L, 0L, 0L, 15L, 0L),
    n = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L,
          1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L),
    proportion = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                   0, 0, 0, 0, 0, 0, 0, 0, 0),
    select = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
               1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
    shift = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
              0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L))

events_observed <- node_events(individual_events(events))

stopifnot(identical(events_observed, events_expected))

## Check that an intTrans event is added.
events <- data.frame(
    id    = c(1, 1, 1, 1, 2, 2),
    event = c("enter", "extTrans", "extTrans", "exit", "enter", "exit"),
    time  = c(1, 3, 5, 7, 1, 3),
    node  = c(1, 1, 2, 3, 1, 1),
    dest  = c(NA, 2, 3, NA, NA, NA))

events_expected <- data.frame(
    event = c("enter", "exit", "extTrans", "extTrans", "intTrans", "exit"),
    time = c(1, 3, 3, 5, 6, 7),
    node = c(1L, 1L, 1L, 2L, 3L, 3L),
    dest = c(0L, 0L, 2L, 3L, 0L, 0L),
    n = c(2L, 1L, 1L, 1L, 1L, 1L),
    proportion = c(0, 0, 0, 0, 0, 0),
    select = c(1L, 3L, 3L, 3L, 3L, 4L),
    shift = c(0L, 0L, 0L, 0L, 1L, 0L))

events_observed <- node_events(individual_events(events), time = 0, age = 5)

stopifnot(identical(events_observed, events_expected))

## Check that target works for 'SEIR', 'SIS', 'SISe', and
## 'SISe_sp'.
events <- data.frame(
    id    = c(1, 1, 1, 1, 2, 2),
    event = c("enter", "extTrans", "extTrans", "exit", "enter", "exit"),
    time  = c(1, 3, 5, 7, 1, 3),
    node  = c(1, 1, 2, 3, 1, 1),
    dest  = c(NA, 2, 3, NA, NA, NA))

events_expected <- data.frame(
    event = c("enter", "exit", "extTrans", "extTrans", "exit"),
    time = c(1, 3, 3, 5, 7),
    node = c(1L, 1L, 1L, 2L, 3L),
    dest = c(0L, 0L, 2L, 3L, 0L),
    n = c(2L, 1L, 1L, 1L, 1L),
    proportion = c(0, 0, 0, 0, 0),
    select = c(1L, 2L, 2L, 2L, 2L),
    shift = c(0L, 0L, 0L, 0L, 0L))

events_observed <- node_events(individual_events(events),
                               time = 0, target = "SEIR")
stopifnot(identical(events_observed, events_expected))

events_observed <- node_events(individual_events(events),
                               time = 0, target = "SIS")
stopifnot(identical(events_observed, events_expected))

events_observed <- node_events(individual_events(events),
                               time = 0, target = "SISe")
stopifnot(identical(events_observed, events_expected))

events_observed <- node_events(individual_events(events),
                               time = 0, target = "SISe_sp")
stopifnot(identical(events_observed, events_expected))

## Check that target works for 'SIR'.
events <- data.frame(
    id    = c(1, 1, 1, 1, 2, 2),
    event = c("enter", "extTrans", "extTrans", "exit", "enter", "exit"),
    time  = c(1, 3, 5, 7, 1, 3),
    node  = c(1, 1, 2, 3, 1, 1),
    dest  = c(NA, 2, 3, NA, NA, NA))

events_expected <- data.frame(
    event = c("enter", "exit", "extTrans", "extTrans", "exit"),
    time = c(1, 3, 3, 5, 7),
    node = c(1L, 1L, 1L, 2L, 3L),
    dest = c(0L, 0L, 2L, 3L, 0L),
    n = c(2L, 1L, 1L, 1L, 1L),
    proportion = c(0, 0, 0, 0, 0),
    select = c(1L, 4L, 4L, 4L, 4L),
    shift = c(0L, 0L, 0L, 0L, 0L))

events_observed <- node_events(individual_events(events),
                               time = 0, target = "SIR")
stopifnot(identical(events_observed, events_expected))

## Check that target works for 'NULL', 'SISe3', and 'SISe3_sp'.
events <- data.frame(
    id    = c(1, 1, 1, 1, 2, 2),
    event = c("enter", "extTrans", "extTrans", "exit", "enter", "exit"),
    time  = c(1, 3, 5, 7, 1, 3),
    node  = c(1, 1, 2, 3, 1, 1),
    dest  = c(NA, 2, 3, NA, NA, NA))

events_expected <- data.frame(
    event = c("enter", "exit", "extTrans", "intTrans", "extTrans",
              "intTrans", "exit"),
    time = c(1, 3, 3, 4, 5, 6, 7),
    node = c(1L, 1L, 1L, 2L, 2L, 3L, 3L),
    dest = c(0L, 0L, 2L, 0L, 3L, 0L, 0L),
    n = c(2L, 1L, 1L, 1L, 1L, 1L, 1L),
    proportion = c(0, 0, 0, 0, 0, 0, 0),
    select = c(1L, 4L, 4L, 4L, 5L, 5L, 6L),
    shift = c(0L, 0L, 0L, 1L, 0L, 2L, 0L))

events_observed <- node_events(individual_events(events),
                               time = 0, age = c(3, 5), target = NULL)

stopifnot(identical(events_observed, events_expected))
events_observed <- node_events(individual_events(events),
                               time = 0, age = c(3L, 5L), target = "SISe3")

stopifnot(identical(events_observed, events_expected))

events_observed <- node_events(individual_events(events),
                               time = 0, age = c(3, 5), target = "SISe3_sp")
stopifnot(identical(events_observed, events_expected))

## Check generating tex-code from events
events <- data.frame(
    id    = c(1, 1, 1, 1, 1, 1, 1, 1),
    event = c(1, 1, 3, 3, 3, 0, 0, 3),
    time  = c(1, 1, 2, 2, 3, 4, 4, 5),
    node  = c(1, 2, 1, 1, 2, 2, 1, 3),
    dest  = c(0, 0, 2, 3, 2, 0, 0, 2))

tex_expected <- c(
    "\\documentclass[tikz]{standalone}",
    "\\usepackage{tikz}",
    "\\begin{document}",
    "\\begin{tikzpicture}",
    "  \\sffamily",
    "",
    "  \\draw[>=stealth,->] (0,0.5) -- (6,0.5);",
    "  \\node at (3,0) {\\tiny Time};",
    "",
    "  \\draw[>=stealth, gray!40] (0.5,1) -- (5.5,1);",
    "  \\node at (0,1) {\\tiny Node 1};",
    "",
    "  \\draw[>=stealth, gray!40] (0.5,2) -- (5.5,2);",
    "  \\node at (0,2) {\\tiny Node 2};",
    "",
    "  \\draw[>=stealth, gray!40] (0.5,3) -- (5.5,3);",
    "  \\node at (0,3) {\\tiny Node 3};",
    "",
    "  \\node at (1,0.3) {\\tiny $t_{1}$};",
    "  \\draw (1,0.55) -- (1,0.45);",
    "  \\node at (2,0.3) {\\tiny $t_{2}$};",
    "  \\draw (2,0.55) -- (2,0.45);",
    "  \\node at (3,0.3) {\\tiny $t_{3}$};",
    "  \\draw (3,0.55) -- (3,0.45);",
    "  \\node at (4,0.3) {\\tiny $t_{4}$};",
    "  \\draw (4,0.55) -- (4,0.45);",
    "  \\node at (5,0.3) {\\tiny $t_{5}$};",
    "  \\draw (5,0.55) -- (5,0.45);",
    "",
    "  \\node at (1,1.1) {\\textborn};",
    "  \\node at (1,2.1) {\\textcolor{gray!60}\\textborn};",
    "  \\path[>=stealth,->] (2,1) edge [out=135, in=225] (2,2);",
    "  \\path[>=stealth,gray!60,->] (2,1) edge [out=135, in=225] (2,3);",
    "  \\path[>=stealth,gray!60,->] (3,2) edge [out=135, in=45, loop] (3,2);",
    "  \\node at (4,2.2) {\\textdagger};",
    "  \\node at (4,1.2) {\\textcolor{gray!60}\\textdagger};",
    "  \\path[>=stealth,gray!60,->] (5,3) edge [out=315, in=45] (5,2);",
    "",
    "\\end{tikzpicture}",
    "\\end{document}")

tex_observed <- SimInf:::events_to_tex(events)
stopifnot(identical(tex_observed, tex_expected))

events <- data.frame(
    id    = c(1, 1, 1, 1, 1, 1, 1, 1),
    event = c(1, 1, 3, 3, 3, 0, 0, 3),
    time  = c(1, 1, 2, 2, 3, 4, 4, 5),
    node  = c(1, 2, 1, 1, 3, 2, 1, 2),
    dest  = c(0, 0, 2, 3, 2, 0, 0, 2))

events_expected <- data.frame(
    id = c(1, 1, 1, 1),
    event = c(1L, 3L, 3L, 0L),
    time = c(1L, 2L, 3L, 4L),
    node = c(1, 1, 3, 2),
    dest = c(NA, 3, 2, NA))

events_observed <- as.data.frame(individual_events(events))

stopifnot(identical(events_observed, events_expected))

events <- data.frame(
    id    = c(1, 1, 1, 1, 1, 1),
    event = c(1, 3, 3, 3, 3, 0),
    time  = c(1, 2, 2, 3, 3, 4),
    node  = c(1, 1, 1, 3, 3, 2),
    dest  = c(0, 2, 3, 1, 2, 0))

events_expected <- data.frame(
    id = c(1, 1, 1, 1),
    event = c(1L, 3L, 3L, 0L),
    time = c(1L, 2L, 3L, 4L),
    node = c(1, 1, 3, 2),
    dest = c(NA, 3, 2, NA))

events_observed <- as.data.frame(individual_events(events))

stopifnot(identical(events_observed, events_expected))