# Copyright (C) 2016-2023 IƱaki Ucar # # This file is part of simmer. # # simmer 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 2 of the License, or # (at your option) any later version. # # simmer 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 simmer. If not, see . test_that("an arrival leaves", { t0 <- trajectory() %>% seize("dummy", 1) %>% timeout(1) %>% leave(1) %>% timeout(1) %>% release("dummy", 1) t1 <- trajectory() %>% seize("dummy", 1) %>% timeout(1) %>% leave(function() 1) %>% timeout(1) %>% release("dummy", 1) env0 <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t0, at(0)) env1 <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t1, at(0)) expect_warning(run(env0)) expect_warning(run(env1)) arrivals0 <- get_mon_arrivals(env0) arrivals1 <- get_mon_arrivals(env1) expect_false(arrivals0$finished) expect_false(arrivals1$finished) expect_equal(arrivals0$activity_time, 1) expect_equal(arrivals1$activity_time, 1) }) test_that("an arrival leaves immediately!", { t <- trajectory() %>% leave(1) %>% seize("dummy", 1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t, at(0)) expect_silent(capture.output(run(env))) }) test_that("an arrival continues", { t0 <- trajectory() %>% seize("dummy", 1) %>% timeout(1) %>% leave(0) %>% timeout(1) %>% release("dummy", 1) t1 <- trajectory() %>% seize("dummy", 1) %>% timeout(1) %>% leave(function() 0) %>% timeout(1) %>% release("dummy", 1) arrivals0 <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t0, at(0)) %>% run() %>% get_mon_arrivals() arrivals1 <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t1, at(0)) %>% run() %>% get_mon_arrivals() expect_true(arrivals0$finished) expect_true(arrivals1$finished) expect_equal(arrivals0$activity_time, 2) expect_equal(arrivals1$activity_time, 2) }) test_that("an arrival in a timeout reneges (1)", { t <- trajectory() %>% renege_in(1) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_false(arr$finished) }) test_that("an arrival in a timeout reneges (2)", { t <- trajectory() %>% send("sig", 1) %>% renege_if("sig") %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_false(arr$finished) }) test_that("a leaving arrival can follow a secondary sub-trajectory", { t <- trajectory() %>% leave(1, out = trajectory() %>% timeout(1)) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_true(arr$finished) }) test_that("a reneging arrival can follow a secondary sub-trajectory (1)", { t <- trajectory() %>% renege_in(1, out = trajectory() %>% timeout(1)) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 2) expect_equal(arr$activity_time, 2) expect_true(arr$finished) }) test_that("a reneging arrival can follow a secondary sub-trajectory (2)", { t <- trajectory() %>% send("sig", 1) %>% renege_if("sig", out = trajectory() %>% timeout(1)) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 2) expect_equal(arr$activity_time, 2) expect_true(arr$finished) }) test_that("an empty subtrajectory is equivalent to NULL (1)", { t <- trajectory() %>% leave(1, out = trajectory()) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 0) expect_equal(arr$activity_time, 0) expect_false(arr$finished) }) test_that("an empty subtrajectory is equivalent to NULL (2)", { t <- trajectory() %>% renege_in(1, out = trajectory()) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_false(arr$finished) }) test_that("an empty subtrajectory is equivalent to NULL (3)", { t <- trajectory() %>% send("sig", 1) %>% renege_if("sig", out = trajectory()) %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_false(arr$finished) }) test_that("a second renege_in resets the timeout", { t <- trajectory() %>% renege_in(2) %>% timeout(1) %>% renege_in(4) %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 5) expect_equal(arr$activity_time, 5) expect_false(arr$finished) }) test_that("a second renege_if resets the timeout", { t <- trajectory() %>% send("sig", 5) %>% renege_in(2) %>% timeout(1) %>% renege_if("sig") %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 5) expect_equal(arr$activity_time, 5) expect_false(arr$finished) }) test_that("a second renege_in resets the signal", { t <- trajectory() %>% send("sig", 2) %>% renege_if("sig") %>% timeout(1) %>% renege_in(4) %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 5) expect_equal(arr$activity_time, 5) expect_false(arr$finished) }) test_that("a second renege_if resets the signal", { t <- trajectory() %>% send("sig", 2) %>% renege_if("sig") %>% timeout(1) %>% renege_if("asdf") %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 10) expect_equal(arr$activity_time, 10) expect_true(arr$finished) }) test_that("reneging can be aborted (1)", { t <- trajectory() %>% renege_in(2) %>% timeout(1) %>% renege_abort() %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 10) expect_equal(arr$activity_time, 10) expect_true(arr$finished) }) test_that("reneging can be aborted (2)", { t <- trajectory() %>% send("sig", 2) %>% renege_if("sig") %>% timeout(1) %>% renege_abort() %>% timeout(9) env <- simmer(verbose = env_verbose) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env, per_resource = FALSE) expect_equal(arr$end_time, 10) expect_equal(arr$activity_time, 10) expect_true(arr$finished) }) test_that("an arrival being served reneges (1)", { t <- trajectory() %>% renege_in(1) %>% seize("dummy", 1) %>% timeout(2) %>% release("dummy", 1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1) %>% add_generator("arrival", t, at(0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, 1) expect_equal(arr_res$activity_time, 1) expect_equal(arr_glb$end_time, 1) expect_equal(arr_glb$activity_time, 1) expect_false(arr_glb$finished) expect_equal(res$time, c(0, 1)) expect_equal(res$server, c(1, 0)) }) test_that("an arrival being served reneges (2)", { t <- trajectory() %>% renege_in(1) %>% seize("dummy", 1) %>% timeout(2) %>% release("dummy", 1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1, preemptive = TRUE) %>% add_generator("arrival", t, at(0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, 1) expect_equal(arr_res$activity_time, 1) expect_equal(arr_glb$end_time, 1) expect_equal(arr_glb$activity_time, 1) expect_false(arr_glb$finished) expect_equal(res$time, c(0, 1)) expect_equal(res$server, c(1, 0)) }) test_that("an enqueued arrival reneges", { t <- trajectory() %>% renege_in(1) %>% seize("dummy", 1) %>% renege_abort() %>% timeout(2) %>% release("dummy", 1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1) %>% add_generator("arrival", t, at(0, 0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$name, c("arrival1", "arrival0")) expect_equal(arr_res$end_time, c(1, 2)) expect_equal(arr_res$activity_time, c(0, 2)) expect_equal(arr_glb$name, c("arrival1", "arrival0")) expect_equal(arr_glb$end_time, c(1, 2)) expect_equal(arr_glb$activity_time, c(0, 2)) expect_equal(arr_glb$finished, c(FALSE, TRUE)) expect_equal(res$time, c(0, 0, 1, 2)) expect_equal(res$server, c(1, 1, 1, 0)) expect_equal(res$queue, c(0, 1, 0, 0)) }) test_that("a preempted arrival reneges (1)", { t1 <- trajectory() %>% seize("dummy", 1) %>% timeout(4) %>% release("dummy", 1) t0 <- trajectory() %>% renege_in(2) %>% join(t1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1, preemptive = TRUE) %>% add_generator("arrival0", t0, at(0), priority = 0) %>% add_generator("arrival1", t1, at(1), priority = 1) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$name, c("arrival00", "arrival10")) expect_equal(arr_res$end_time, c(2, 5)) expect_equal(arr_res$activity_time, c(1, 4)) expect_equal(arr_glb$name, c("arrival00", "arrival10")) expect_equal(arr_glb$end_time, c(2, 5)) expect_equal(arr_glb$activity_time, c(1, 4)) expect_equal(arr_glb$finished, c(FALSE, TRUE)) expect_equal(res$time, c(0, 1, 2, 5)) expect_equal(res$server, c(1, 1, 1, 0)) expect_equal(res$queue, c(0, 1, 0, 0)) }) test_that("a preempted arrival reneges (2)", { t1 <- trajectory() %>% seize("dummy", 1) %>% timeout(4) %>% release("dummy", 1) t0 <- trajectory() %>% renege_in(2) %>% join(t1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1, preemptive = TRUE, queue_size_strict = TRUE) %>% add_generator("arrival0", t0, at(0), priority = 0) %>% add_generator("arrival1", t1, at(1), priority = 1) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$name, c("arrival00", "arrival10")) expect_equal(arr_res$end_time, c(2, 5)) expect_equal(arr_res$activity_time, c(1, 4)) expect_equal(arr_glb$name, c("arrival00", "arrival10")) expect_equal(arr_glb$end_time, c(2, 5)) expect_equal(arr_glb$activity_time, c(1, 4)) expect_equal(arr_glb$finished, c(FALSE, TRUE)) expect_equal(res$time, c(0, 1, 2, 5)) expect_equal(res$server, c(1, 1, 1, 0)) expect_equal(res$queue, c(0, 1, 0, 0)) }) test_that("an arrival inside a batch reneges, but the batch continues", { t0 <- trajectory() %>% batch(2, name = "shared") %>% seize("dummy", 1) %>% timeout(10) %>% release("dummy", 1) t1 <- trajectory() %>% renege_in(5) %>% join(t0) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1) %>% add_generator("arrival0", t0, at(0)) %>% add_generator("arrival1", t1, at(0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, c(5, 10)) expect_equal(arr_res$activity_time, c(5, 10)) expect_equal(arr_glb$name, c("arrival10", "arrival00")) expect_equal(arr_glb$end_time, c(5, 10)) expect_equal(arr_glb$activity_time, c(5, 10)) expect_equal(arr_glb$finished, c(FALSE, TRUE)) expect_equal(res$time, c(0, 10)) expect_equal(res$server, c(1, 0)) expect_equal(res$queue, c(0, 0)) }) test_that("the only arrival inside a batch reneges, and the batch stops", { t0 <- trajectory() %>% batch(1) %>% batch(1) %>% seize("dummy", 1) %>% timeout(10) %>% release("dummy", 1) t1 <- trajectory() %>% renege_in(5) %>% join(t0) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1) %>% add_generator("arrival1", t1, at(0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, 5) expect_equal(arr_res$activity_time, 5) expect_equal(arr_glb$end_time, 5) expect_equal(arr_glb$activity_time, 5) expect_equal(arr_glb$finished, FALSE) expect_equal(res$time, c(0, 5)) expect_equal(res$server, c(1, 0)) expect_equal(res$queue, c(0, 0)) }) test_that("a permanent batch prevents reneging", { t0 <- trajectory() %>% batch(1, name = "shared", permanent = TRUE) %>% seize("dummy", 1) %>% timeout(10) %>% release("dummy", 1) t1 <- trajectory() %>% renege_in(5) %>% join(t0) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1) %>% add_generator("arrival1", t1, at(0)) %>% run() arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, 10) expect_equal(arr_res$activity_time, 10) expect_equal(arr_glb$end_time, 10) expect_equal(arr_glb$activity_time, 10) expect_equal(arr_glb$finished, TRUE) expect_equal(res$time, c(0, 10)) expect_equal(res$server, c(1, 0)) expect_equal(res$queue, c(0, 0)) }) test_that("a batch inside a batch reneges", { t <- trajectory() %>% batch(2, name = "two") %>% batch(1, name = "one") %>% seize("dummy", 1) %>% timeout(2) %>% release("dummy", 1) t0 <- trajectory() %>% batch(2) %>% renege_in(1) %>% join(t) t1 <- trajectory() %>% batch(2) %>% join(t) env <- simmer(verbose = env_verbose) %>% add_resource("dummy", 1, 0) %>% add_generator("arrival0", t0, at(0, 0)) %>% add_generator("arrival1", t1, at(0, 0)) %>% run() get_mon_arrivals(env, per_resource = FALSE) get_mon_arrivals(env, per_resource = TRUE) get_mon_resources(env) arr_res <- get_mon_arrivals(env, per_resource = TRUE) arr_glb <- get_mon_arrivals(env, per_resource = FALSE) res <- get_mon_resources(env) expect_equal(arr_res$end_time, c(1, 1, 2, 2)) expect_equal(arr_res$activity_time, c(1, 1, 2, 2)) expect_equal(arr_glb$name, c("arrival00", "arrival01", "arrival10", "arrival11")) expect_equal(arr_glb$end_time, c(1, 1, 2, 2)) expect_equal(arr_glb$activity_time, c(1, 1, 2, 2)) expect_equal(arr_glb$finished, c(FALSE, FALSE, TRUE, TRUE)) expect_equal(res$time, c(0, 2)) expect_equal(res$server, c(1, 0)) expect_equal(res$queue, c(0, 0)) }) test_that("seizes across nested batches are correctly reported", { t <- trajectory(verbose = TRUE) %>% renege_in(2) %>% seize("dummy0", 1) %>% batch(1) %>% seize("dummy1", 1) %>% batch(1) %>% seize("dummy2", 1) %>% timeout(10) %>% release("dummy2", 1) %>% separate() %>% release("dummy1", 1) %>% separate() %>% release("dummy0", 1) env <- simmer(verbose = env_verbose) %>% add_resource("dummy0", 1, 0) %>% add_resource("dummy1", 1, 0) %>% add_resource("dummy2", 1, 0) %>% add_generator("arrival", t, at(0)) %>% run() arr_glb <- get_mon_arrivals(env, per_resource = FALSE) arr_res <- get_mon_arrivals(env, per_resource = TRUE) expect_equal(arr_glb$start_time, 0) expect_equal(arr_glb$end_time, 2) expect_equal(arr_glb$activity_time, 2) expect_equal(arr_res$start_time, c(0, 0, 0)) expect_equal(arr_res$end_time, c(2, 2, 2)) expect_equal(arr_res$activity_time, c(2, 2, 2)) }) test_that("a leaving arrival releases seized resources", { t <- trajectory() %>% seize("dummy1") %>% seize("dummy2") %>% seize("dummy3") %>% timeout(1) %>% leave(1, keep_seized=FALSE) env <- simmer(verbose = env_verbose) %>% add_resource(paste0("dummy", 1:3)) %>% add_generator("arrival", t, at(0)) %>% run() arr <- get_mon_arrivals(env) res <- get_mon_resources(env) expect_equal(arr$end_time, 1) expect_equal(arr$activity_time, 1) expect_false(arr$finished) expect_equal(res$resource, paste0("dummy", c(1:3, 1:3))) expect_equal(res$time, c(rep(0, 3), rep(1, 3))) expect_equal(res$server, c(rep(1, 3), rep(0, 3))) }) test_that("a leaving arrival keeps seized resources", { out <- trajectory() %>% timeout(1) t <- trajectory() %>% seize("dummy") %>% timeout(1) %>% leave(1, out=out, keep_seized=TRUE) %>% timeout(3) env <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_generator("arrival", t, at(0)) expect_warning(run(env)) arr <- get_mon_arrivals(env) res <- get_mon_resources(env) expect_equal(arr$end_time, 2) expect_equal(arr$activity_time, 2) expect_true(arr$finished) expect_equal(res$time, 0) expect_equal(res$server, 1) }) test_that("a reneging arrival keeps seized resources (1)", { out <- trajectory() %>% timeout(1) t <- trajectory() %>% renege_in(1, out=out, keep_seized=TRUE) %>% seize("dummy") %>% seize("other") %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_resource("other", 0) %>% add_generator("arrival", t, at(0)) expect_warning(run(env)) arr <- get_mon_arrivals(env) res <- get_mon_resources(env) expect_equal(arr$end_time, 2) expect_equal(arr$activity_time, 1) expect_true(arr$finished) expect_equal(res$resource, c("dummy", "other", "other")) expect_equal(res$time, c(0, 0, 1)) expect_equal(res$server, c(1, 0, 0)) expect_equal(res$queue, c(0, 1, 0)) }) test_that("a reneging arrival keeps seized resources (2)", { out <- trajectory() %>% timeout(1) t <- trajectory() %>% send("sig", 1) %>% renege_if("sig", out=out, keep_seized=TRUE) %>% seize("dummy") %>% batch(1) %>% seize("other") %>% timeout(4) env <- simmer(verbose = env_verbose) %>% add_resource("dummy") %>% add_resource("other", 0) %>% add_generator("arrival", t, at(0)) expect_warning(run(env)) arr <- get_mon_arrivals(env) res <- get_mon_resources(env) expect_equal(arr$end_time, 2) expect_equal(arr$activity_time, 1) expect_true(arr$finished) expect_equal(res$resource, c("dummy", "other", "other")) expect_equal(res$time, c(0, 0, 1)) expect_equal(res$server, c(1, 0, 0)) expect_equal(res$queue, c(0, 1, 0)) }) test_that("a reneging arrival is able to seize a resource again", { t <- trajectory() %>% renege_in( t = 5, out = trajectory() %>% rollback(2)) %>% seize("resource") %>% renege_abort() %>% timeout(10) %>% release("resource") env <- simmer(verbose = env_verbose) %>% add_resource("resource") %>% add_generator("dummy", t, at(0, 3)) %>% run() arr <- get_mon_arrivals(env) res <- get_mon_resources(env) expect_equal(arr$end_time, c(10, 20)) expect_equal(arr$activity_time, c(10, 10)) expect_true(all(arr$finished)) expect_equal(res$time, c(0, 3, 8, 8, 10, 20)) expect_equal(res$server, c(1, 1, 1, 1, 1, 0)) expect_equal(res$queue, c(0, 1, 0, 1, 0, 0)) })