Nothing
# Copyright (C) 2018-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 <http://www.gnu.org/licenses/>.
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", {
DF <- data.frame(time=rep(1, 3))
expect_equal(3, simmer(verbose = env_verbose) %>%
add_dataframe("dummy", trajectory(), DF) %>%
run() %>% reset() %>% run() %>%
get_mon_arrivals() %>% nrow()
)
})
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 are correctly retrieved", {
t <- trajectory() %>%
log_(function() get_name(env))
DF <- data.frame(time=0)
env <- simmer() %>%
add_dataframe("dummy", t, DF)
expect_output(run(env), "0: dummy0: dummy0")
expect_error(get_name(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"))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.