# Copyright (C) 2018-2024 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("a data source name conflicts with a generator name", { expect_warning( simmer(verbose = env_verbose) %>% add_generator("asdf", trajectory(), at(0)) %>% add_dataframe("asdf", trajectory(), data.frame(time=0)) ) expect_warning( simmer(verbose = env_verbose) %>% add_dataframe("asdf", trajectory(), data.frame(time=0)) %>% add_generator("asdf", trajectory(), at(0)) ) }) test_that("a data source without a trajectory fails", { DF <- data.frame(time=1) expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", 4, DF)) }) test_that("a non-data.frame data argument fails", { expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), 1)) }) test_that("non-existent column names fail", { DF <- data.frame(time=1) expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF, col_time="asdf")) }) test_that("a data source with non-numeric values fails", { DF <- data.frame(time=NA) expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF)) DF <- data.frame(time="asdf") expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF)) }) test_that("unsorted absolute time fails", { expect_error( simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), data.frame(time=3:1), time="absolute")) }) test_that("absolute time works as expected", { time <- c(0, 1, 3, 9) arr <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), data.frame(time=time), time="absolute") %>% run() %>% get_mon_arrivals() expect_equal(arr$start_time, time) }) test_that("generates the expected amount", { t <- trajectory() %>% timeout(0) env <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", t, data.frame(time=rep(1, 3))) %>% run() arr <- get_mon_arrivals(env) expect_equal(env %>% get_sources(), "dummy") expect_error(env %>% get_n_generated("asdf")) expect_equal(env %>% get_n_generated("dummy"), 3) expect_error(env %>% get_trajectory("asdf")) expect_equal((env %>% get_trajectory("dummy"))[[1]], t) expect_equal(arr$start_time, 1:3) expect_equal(arr$end_time, 1:3) expect_equal(arr$activity_time, rep(0, 3)) }) test_that("data sources are reset", { expect_equal(3, simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), data.frame(time=rep(1, 3))) %>% run() %>% reset() %>% run() %>% get_mon_arrivals() %>% nrow() ) t <- trajectory() %>% set_source("dummy", data.frame(time=10)) %>% set_trajectory("dummy", trajectory() %>% timeout(1)) env <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", t, data.frame(time=0)) df1 <- env %>% run() %>% get_mon_arrivals() df2 <- env %>% reset() %>% run() %>% get_mon_arrivals() expect_equal(df1, df2) }) test_that("priorities are set", { t <- trajectory() %>% log_(function() paste(get_prioritization(env), collapse=",")) DF <- data.frame(time=rep(1, 3), priority=1:3, preemptible=2:4, restart=c(0, 1, 0)) env <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", t, DF, col_preemptible="preemptible") expect_output(run(env), "dummy0: 1,2,0.*dummy1: 2,3,1.*dummy2: 3,4,0") }) test_that("preemptible < priority shows a warning", { DF <- data.frame(time=0, priority=3, preemptible=1) expect_warning(simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF, col_preemptible="preemptible") %>% stepn() ) }) test_that("attributes are set", { DF <- data.frame(time=rep(1, 3), attr1=1:3, attr2=3:1) attr <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF, mon=2, col_attributes="attr1") %>% run() %>% get_mon_attributes() expect_equal(attr$time, rep(0, 3)) expect_equal(attr$name, paste0("dummy", 0:2)) expect_equal(attr$key, rep("attr1", 3)) expect_equal(attr$value, 1:3) attr <- simmer(verbose = env_verbose) %>% add_dataframe("dummy", trajectory(), DF, mon=2) %>% run() %>% get_mon_attributes() expect_equal(attr$time, rep(0, 6)) expect_equal(attr$name, rep(paste0("dummy", 0:2), each=2)) expect_equal(attr$key, rep(paste0("attr", 1:2), 3)) expect_equal(attr$value, c(1, 3, 2, 2, 3, 1)) }) test_that("arrival names and start times are correctly retrieved", { t <- trajectory() %>% log_(function() paste(get_name(env), get_start_time(env))) DF <- data.frame(time=1) env <- simmer() %>% add_dataframe("dummy", t, DF) expect_output(run(env), "1: dummy0: dummy0 1") expect_error(get_name(env)) expect_error(get_start_time(env)) }) test_that("arrivals are correctly monitored", { a <- trajectory() %>% seize("res2", 1) %>% batch(1) %>% seize("res1", 1) %>% timeout(5) %>% release("res1", 1) %>% separate() %>% release("res2", 1) b <- trajectory() %>% seize("res1", 1) %>% timeout(6) %>% release("res1", 1) c <- trajectory() %>% seize("res1", 1) %>% timeout(1) %>% rollback(1, times = Inf) DFa <- DFb <- DFc <- data.frame(time=0) DFd <- data.frame(time=1) env <- simmer(verbose = env_verbose) %>% add_resource("res1", 1) %>% add_resource("res2") %>% add_dataframe("a", a, DFa) %>% add_dataframe("b", b, DFb) %>% add_dataframe("c", c, DFc) %>% add_dataframe("d", c, DFd, mon = FALSE) %>% run(until = 4) arr1 <- get_mon_arrivals(env, per_resource = FALSE, ongoing = TRUE) arr1 <- arr1[order(arr1$name), ] arr2 <- get_mon_arrivals(env, per_resource = TRUE, ongoing = TRUE) arr2 <- arr2[order(arr2$name, arr2$resource), ] expect_equal(arr1$name, c("a0", "b0", "c0")) expect_equal(arr1$start_time, c(0, 0, 0)) expect_equal(arr1$end_time, c(NA_real_, NA, NA)) expect_equal(arr1$activity_time, c(NA_real_, NA, NA)) expect_equal(arr1$finished, rep(FALSE, 3)) expect_equal(arr2$name, c("a0", "a0", "b0", "c0")) expect_equal(arr2$start_time, c(0, 0, 0, 0)) expect_equal(arr2$end_time, c(NA_real_, NA, NA, NA)) expect_equal(arr2$activity_time, c(NA_real_, NA, NA, NA)) expect_equal(arr2$resource, c("res1", "res2", "res1", "res1")) env %>% reset() %>% run(until = 10) arr1 <- get_mon_arrivals(env, per_resource = FALSE, ongoing = TRUE) arr1 <- arr1[order(arr1$name), ] arr2 <- get_mon_arrivals(env, per_resource = TRUE, ongoing = TRUE) arr2 <- arr2[order(arr2$name, arr2$resource), ] expect_equal(arr1$name, c("a0", "b0", "c0")) expect_equal(arr1$start_time, c(0, 0, 0)) expect_equal(arr1$end_time, c(5, NA, NA)) expect_equal(arr1$activity_time, c(5, NA, NA)) expect_equal(arr1$finished, c(TRUE, FALSE, FALSE)) expect_equal(arr2$name, c("a0", "a0", "b0", "c0")) expect_equal(arr2$start_time, c(0, 0, 0, 0)) expect_equal(arr2$end_time, c(5, 5, NA, NA)) expect_equal(arr2$activity_time, c(5, 5, NA, NA)) expect_equal(arr2$resource, c("res1", "res2", "res1", "res1")) env %>% reset() %>% run(until = 12) arr1 <- get_mon_arrivals(env, per_resource = FALSE, ongoing = TRUE) arr1 <- arr1[order(arr1$name), ] arr2 <- get_mon_arrivals(env, per_resource = TRUE, ongoing = TRUE) arr2 <- arr2[order(arr2$name, arr2$resource), ] expect_equal(arr1$name, c("a0", "b0", "c0")) expect_equal(arr1$start_time, c(0, 0, 0)) expect_equal(arr1$end_time, c(5, 11, NA)) expect_equal(arr1$activity_time, c(5, 6, NA)) expect_equal(arr1$finished, c(TRUE, TRUE, FALSE)) expect_equal(arr2$name, c("a0", "a0", "b0", "c0")) expect_equal(arr2$start_time, c(0, 0, 0, 0)) expect_equal(arr2$end_time, c(5, 5, 11, NA)) expect_equal(arr2$activity_time, c(5, 5, 6, NA)) expect_equal(arr2$resource, c("res1", "res2", "res1", "res1")) })