Nothing
context("project method")
params <- newMultispeciesParams(NS_species_params_gears, inter)
# time dimension ----
test_that("time dimension is dealt with properly", {
# Effort is a single numeric
t_max <- 5
t_save <- 1
dt <- 0.1
sim <- project(params, t_max = t_max, t_save = t_save, dt = dt, effort = 1)
expect_identical(names(dimnames(sim@effort)), c("time", "gear"))
expect_equal(dim(sim@effort)[1],
length(seq(from = 0, to = t_max, by = t_save)))
expect_equal(dim(sim@n)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
dt <- 0.5
t_save <- 2
sim <- project(params, t_max = t_max, t_save = t_save, dt = dt, effort = 1)
expect_equal(dim(sim@effort)[1],
length(seq(from = 0, to = t_max, by = t_save)))
expect_equal(dim(sim@n)[1],
length(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
t_save <- 0.5
dt <- 0.5
sim <- project(params, t_max = t_max, t_save = t_save, dt = dt, effort = 1)
expect_equal(dim(sim@effort)[1], t_max / t_save + 1)
expect_equal(dim(sim@n)[1], t_max / t_save + 1)
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
# append
sim <- project(sim, t_max = t_max, t_save = t_save, dt = dt, effort = 1)
expect_equal(dim(sim@effort)[1], 2 * t_max/t_save + 1)
expect_equal(dim(sim@n)[1], 2 * t_max/t_save + 1)
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = 2 * t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = 2 * t_max, by = t_save)))
# Effort is an effort vector
effort <- c(Industrial = 1, Pelagic = 0.5, Beam = 0.3, Otter = 0)
t_max <- 5
t_save <- 2
sim <- project(params, t_max = t_max, t_save = t_save, effort = effort)
expect_identical(names(dimnames(sim@effort)), c("time", "gear"))
expect_equal(dim(sim@effort)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_equal(dim(sim@n)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
dt <- 0.5
sim <- project(params, t_max = t_max, t_save = t_save, effort = effort)
expect_equal(dim(sim@effort)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_equal(dim(sim@n)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
t_save <- 0.5
sim <- project(params, t_max = t_max, t_save = t_save, effort = effort)
expect_equal(dim(sim@effort)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_equal(dim(sim@n)[1], length(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@effort)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
expect_identical(dimnames(sim@n)[[1]],
as.character(seq(from = 0, to = t_max, by = t_save)))
## No effort argument but t_start
sim <- project(params, t_start = 2019, t_max = 2, dt = 1)
expect_equal(dimnames(sim@n)$time, c("2019", "2020", "2021"))
})
# pass in initial species ----
test_that("Can pass in initial species", {
no_gear <- dim(params@catchability)[1]
no_sp <- dim(params@catchability)[2]
max_t_effort <- 10
effort <- array(abs(rnorm(max_t_effort * no_gear)),
dim = c(max_t_effort, no_gear))
# No time dimnames - fail
t_max <- 5
start_year <- 1980
time_step <- 0.5
end_year <- start_year + t_max - 1
time <- seq(from = start_year, to = end_year, by = time_step)
effort <- array(NA, dim = c(length(time), 4),
dimnames = list(NULL, gear = c("industrial", "pelagic",
"otter_trawl", "beam_trawl")
)
)
effort[,1] <- seq(from = 0, to = 1, length = nrow(effort))
effort[,2] <- 0.5
effort[,3] <- seq(from = 1, to = 0.5, length = nrow(effort))
effort[,4] <- 0
expect_that(project(params, effort = effort), throws_error())
})
# w_min array reference ----
test_that("w_min array reference is working OK", {
NS_species_params_gears$w_min <- 0.001
NS_species_params_gears$w_min[1] <- 1
params2 <- newMultispeciesParams(NS_species_params_gears, inter)
sim <- project(params2, effort = 1, t_max = 5)
expect_equivalent(sim@n[6, 1, 1:(sim@params@w_min_idx[1] - 1)],
rep(0, sim@params@w_min_idx[1] - 1))
})
# Gear checking and sorting ----
test_that("Gear checking and sorting is OK", {
# Set up trait based model for easy testing ground
no_sp <- 10
min_w_max <- 10
max_w_max <- 1e5
w_max <- 10^seq(from = log10(min_w_max), to = log10(max_w_max),
length = no_sp)
knife_edges <- w_max * 0.05
industrial_gears <- w_max <= 500
other_gears <- w_max > 500
gear_names <- rep("Industrial", no_sp)
gear_names[other_gears] <- "Other"
params_gear <- newTraitParams(no_sp = no_sp,
min_w_max = min_w_max,
max_w_max = max_w_max,
knife_edge_size = knife_edges,
gear_names = gear_names)
gear_names <- dimnames(params_gear@catchability)[[1]]
# Single vector of effort
sim <- project(params_gear, effort = 0.3, t_max = 10)
expect_true(all(sim@effort == 0.3))
# Also check that order of gear names in resulting effort matches catchability
expect_true(all(dimnames(sim@effort)$gear == gear_names))
# Effort vector
# Should give same result
effort_vec <- c(Other = 1, Industrial = 0)
effort_vec2 <- c(Industrial = 0, Other = 1)
sim <- project(params_gear, effort = effort_vec, t_max = 10)
sim2 <- project(params_gear, effort = effort_vec2, t_max = 10)
expect_true(all(sim@effort[, "Industrial"] == 0))
expect_true(all(sim@effort[, "Other"] == 1))
expect_true(all(sim2@effort[, "Industrial"] == 0))
expect_true(all(sim2@effort[, "Other"] == 1))
expect_true(all(dimnames(sim@effort)$gear == gear_names))
expect_true(all(dimnames(sim2@effort)$gear == gear_names))
# Should fail - number of gears wrong
effort_vec3 <- c(Industrial = 0, Other = 1, Dummy = 0.5)
expect_error(project(params_gear, effort = effort_vec3, t_max = 10))
effort_vec4 <- c(Industrial = 0) # Is OK because that gear exists
expect_error(project(params_gear, effort = effort_vec4, t_max = 10), NA)
# Should fail - names of gears wrong
effort_vec5 <- c(Industrial = 0, Dummy = 1)
expect_error(project(params_gear, effort = effort_vec5, t_max = 10))
# Array effort
t_steps <- 10
effort1 <- array(1, dim = c(t_steps, 2))
expect_error(project(params_gear, effort = effort1))
# Different order - should give same result
effort2 <- array(
rep(c(1, 0), each = t_steps),
dim = c(t_steps, 2),
dimnames = list(
time = 1:t_steps,
gear = c("Other", "Industrial")
)
)
effort3 <- array(
rep(c(0, 1), each = t_steps),
dim = c(t_steps, 2),
dimnames = list(
time = 1:t_steps,
gear = c("Industrial", "Other")
)
)
sim2 <- project(params_gear, effort = effort2)
sim3 <- project(params_gear, effort = effort3)
expect_identical(sim2, sim3)
# These should all fail - gears incorrectly specified
effort4 <-
array(
rep(c(0, 1, 0.5), each = t_steps),
dim = c(t_steps, 3),
dimnames = list(
time = 1:t_steps,
gear = c("Industrial", "Other", "Dummy")
)
)
effort5 <- array(
rep(c(0, 1), each = t_steps),
dim = c(t_steps, 2),
dimnames = list(
time = 1:t_steps,
gear = c("Industrial", "Dummy")
)
)
effort6 <- array(
rep(c(1), each = t_steps),
dim = c(t_steps, 1),
dimnames = list(time = 1:t_steps, gear = c("Industrial"))
)
expect_error(project(params_gear, effort = effort4))
expect_error(project(params_gear, effort = effort5))
expect_error(project(params_gear, effort = effort6))
})
# same numerical results as previously ----
test_that("Simulation gives same numerical results as previously",{
params <- newMultispeciesParams(NS_species_params_gears, inter,
n = 2/3, p = 0.7, lambda = 2.8 - 2/3)
sim <- project(params, t_max = 1)
expect_known_value(sim@n[2, 3, ], "values/projectn")
expect_known_value(sim@n_pp[2, ], "values/projectp")
})
test_that("Final result the same when called with sim or params", {
params <- NS_params
sim <- project(params, t_max = 1)
params@initial_n[] <- sim@n[2, , ]
params@initial_n_pp[] <- sim@n_pp[2, ]
params@initial_n_other <- sim@n_other[2, ]
sim1 <- project(params, t_max = 1)
sim2 <- project(sim, t_max = 1)
expect_identical(sim1@n[2, 3, ], sim2@n[3, 3, ])
})
# dimnames ----
# This test is motivated by the bug in
# https://github.com/sizespectrum/mizer/issues/173
test_that("Dimnames on effort have correct names", {
gear_names <- as.character(unique(gear_params(NS_params)$gear))
effort <- array(1, dim = c(3, length(gear_names)),
dimnames = list(1:3,
gear_names))
sim <- project(NS_params, effort, t_max = 0.1)
expect_identical(names(dimnames(sim@effort)), c("time", "gear"))
})
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.