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")) })